Delphi学习心得

来源:互联网 发布:java公司客户管理系统 编辑:程序博客网 时间:2024/05/19 03:27
 

Delphi的公共单元

unit QmZwh;
interface
uses
  SysUtils, Windows, Messages, Classes;
///////////// zip操作命令 ///////////////////////
//压缩文件
function CompressFile(str_parzipExe :string;str_parS :string;str_parD :string): boolean;
//解压文件
function UnCompressFile(str_parzipExe :string;str_parS :string;str_parD :string):boolean ;
//////////////////////////////////////////////////////////
///////////////// 字符串操作  ////////////////////////////
//取指定字符前面的字符串
function FrChar(Str_AllChar :String;Str_SpeChar:String):String;
//取制定字符后面的字符串
function BaChar(Str_AllChar :String;Str_SpeChar:String):String;
//从字符串后面开始取指定字符前面的字符
function RFrChar(Str_AllChar :String;Str_SpeChar:String):String;
//从字符串后面开始取指定字符后面的字符
function RBaChar(Str_AllChar :String;Str_SpeChar:String):String;
//去掉字符串中的所有空格
function DelBlank(Str_Char:String):String;
//////////////////////////////////////////////////////////
///////////////// 文件目录操作////////////////////////////
//目录列表
function FoList(Str_Path :String;FolderList:TStringList):TStringList;
//文件列表
function FiList(Str_Path :String;FileList:TStringList):TStringList;
//////////////////////////////////////////////////////////
implementation
////////////////////   压缩解压文件zip /////////////////////////
function CompressFile(str_parzipExe :string;str_parS :string;str_parD :string): boolean;
var
  str_para,str_test,str_frmCap :string;
  errh:THandle;
  i : integer;
begin
  try
    errh:=1;
    str_para:=Trim(str_parzipExe)+' -min -a -r -es "'+Trim(str_parD)+'" "'+Trim(str_parS)+'"';
    WinExec(pchar(str_para),SW_HIDE);    //SW_NORMAL      SW_HIDE
    //str_frmCap:='WinZip - '+str_filPacNam+'.zip';
    str_frmCap:='WinZip - '+Trim(ExtractFileName(str_parD));
    while errh <> 0 do  begin            //关闭正常打开的winzip.exe
      errh:=FindWindow(nil,PChar(str_frmCap));
     // sleep(1000);
    end;
    Result:=true;
  except
    Result:=false;
  end;
end;
function UnCompressFile(str_parzipExe :string;str_parS :string;str_parD :string):boolean ;
var
  str_para,str_zipRet,str_tmpgsmc,str_serIp,str_zipFileNam,str_frmCap :string;
  i_errRet,i_error : integer;
  errh:THandle;
  ziph:THandle;
begin
  i_error:=0;  
  //判断文件是否存在解压路径
  if not DirectoryExists(str_parD) then begin       //if ~
    str_para:=Trim(str_parzipExe)+' -e "'+Trim(str_parS)+'" "'+Trim(str_parD)+'"';  //right --winzip
    //得到路径中的文件名
    str_zipFileNam:=ExtractFileName(str_parS);
    try
      i_errRet:=WinExec(pchar(str_para),SW_HIDE);   //SW_HIDE  SW_NORMAL
      str_frmCap:='WinZip - '+str_zipFileNam;
      errh:=FindWindow(nil,PChar(str_frmCap));
      if errh <> 0 then  begin     //正常解压
        while errh <> 0 do  begin
          sleep(1000);
          errh:=FindWindow(nil,PChar(str_frmCap));
        end;
        Result:=true;
      end
      else begin                  //处理非法zip文件
        errh:=1;
        while errh <> 0 do  begin     //while ~
          i_error:=i_error+1;
          sleep(1000);
          errh:=FindWindow(nil,'WinZip');
          if errh <> 0 then  begin        //if~~
            if i_error=1 then                   //if~~~
              SendMessage(errh,WM_CLOSE,0,0)
            else begin                          //if~~~
              SendMessage(errh,WM_CLOSE,0,0);
              Result:=false;
            end;                                //if~~~
          end;                            //if~~
        end;                          //while ~
        Result:=false;
      end;                        //处理非法zip文件
    except
       Result:=false;
    end;
    end
    else                                             //if ~
      Result:=true;
end;
/////////////////////////////////////////////////////////////////////////////

////////////////////////字符串操作///////////////////////////////////////////
function FrChar(Str_AllChar :String;Str_SpeChar:String):String;
begin
  result := Copy(Str_AllChar,1,pos(Str_SpeChar,Str_AllChar)-1);
end;
function BaChar(Str_AllChar :String;Str_SpeChar:String):String;
begin
  result := Copy(Str_AllChar,pos(Str_SpeChar,Str_AllChar)+1,Length(Str_AllChar)-pos(Str_SpeChar,Str_AllChar));
end;
function RFrChar(Str_AllChar :String;Str_SpeChar:String):String;
var
  Str :String;
begin
  Str := StrRScan(pchar(Str_AllChar),Str_SpeChar[1]);
  result := Copy(Str_AllChar,1,Length(Str_AllChar)-Length(Str));
end;
function RBaChar(Str_AllChar :String;Str_SpeChar:String):String;
var
  Str :String;
begin
  Str := StrRScan(pchar(Str_AllChar),Str_SpeChar[1]);
  result := Copy(Str,2,Length(Str)-1);
end;

function DelBlank(Str_Char:String):String;
begin
  result :=StringReplace(Str_Char,' ','',[rfReplaceAll]);
end;
/////////////////////////////////////////////////////////////////////////////
////////////////////////文件目录操作/////////////////////////////////////////
function FoList(Str_Path :String;FolderList:TStringList):TStringList;
var
  SR : TSearchRec;
  Fr : Integer;
begin
  result := TStringList.Create;
  Fr := FindFirst(Str_Path+'/*.*',faAnyFile,SR);
  while Fr = 0 do
  begin
    if (SR.Attr = FaDirectory) and (SR.Name <> '.') and (SR.Name<> '..') then
    begin
      result.Add(SR.Name);
    end;
    Fr := FindNext(SR);
  end;
  SysUtils.FindClose(SR);
  FolderList.AddStrings(result);
  result.Free;
end;

function FiList(Str_Path :String;FileList:TStringList):TStringList;
var
  SR : TSearchRec;
  Fr : Integer;
begin
  result := TStringList.Create;
  Fr := FindFirst(Str_Path+'/*.*',faAnyFile,SR);
  while Fr = 0 do
  begin
    if Not(SR.Attr = FaDirectory) and (SR.Name <> '.') and (SR.Name<> '..') then
    begin
      result.Add(SR.Name);
    end;
    Fr := FindNext(SR);
  end;
  SysUtils.FindClose(SR);
  FileList.AddStrings(result);
  result.Free;
end;
/////////////////////////////////////////////////////////////////////////////
end.
原创粉丝点击