vclZip控件的使用

unit UDMPB;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdFTP, StdCtrls, idFTPList, ShellApi, RzPrgres, IniFiles,
  VCLUnZip, VCLZip;

//MsgBox
// 信息提示
function MsgBox(Text, Caption: string; Flags: Longint): Integer;
// 系统提示信息
function MsgBoxI(Text: string): Integer;
//警告提示信息
function MsgBoxW(Text: string): Integer;

//Ini
//读INI文件
function IniGetStr(FileName, JName, XName, DefaultValue: string): string;
//写INI文件
function IniSetStr(FileName, JName, XName, WirteValue: string): Boolean;

//File Dir
//拷贝文件
function CopyFileEx(sSou, sTar: string): Boolean;
//拷贝整个文件夹
function CopyDir(const Source, Dest: string): boolean;
//删除整个文年夹
function DeleteDir(const Source: string): boolean;

//zip  用的是 VCLUnZip, VCLZip 控件
//得到所有子目录列表
function GetAllSubDir(Directory: string; var RetList: TStringList): Boolean;
//得到所有子目录文件列表
function GetAllDirFile(Directory: string; var RetList: TStringList): Boolean;
//压缩一个目录
function ZipDir(sDir, sFile: string): Boolean;
//解压一个目录
function UnZipDir(sFile, sDir: string): Boolean;

 

//常数
const
  IniSTVer = 'STVER.INI'; //Stver.ini     程序版本号信息
  IniSTUpdate = 'STUpdate.ini'; // STUpdate.ini  连接服务器信息

//变量
var
  APATH: string; //程序路径

  FTP_Host: string;
  FTP_User: string;
  FTP_PWD: string;
  FTP_Port: Integer;
  FTP_SOFTPATH: string;

  STVer: string;
  STEXE: string;

implementation

//MsgBox>
// 信息提示

function MsgBox(Text, Caption: string; Flags: Longint): Integer;
begin
  result := Application.MessageBox(PChar(Text), PChar(Caption), Flags);
end;

// 系统提示信息

function MsgBoxI(Text: string): Integer;
begin
  result := Application.MessageBox(PChar(Text), '系统提示', MB_ICONINFORMATION + MB_OK);
end;

//警告提示信息

function MsgBoxW(Text: string): Integer;
begin
  result := Application.MessageBox(PChar(Text), '系统提示', MB_ICONWARNING + MB_OK);
end;

//Msgbox<

//ini>

function IniGetStr(FileName, JName, XName, DefaultValue: string): string; //读INI文件
var
  IniGetFile: Tinifile;
begin
  IniGetStr := '';
  IniGetFile := TInifile.Create(FileName);
  IniGetStr := IniGetFile.ReadString(JName, XName, DefaultValue);
  IniGetFile.Free;
end;

function IniSetStr(FileName, JName, XName, WirteValue: string): Boolean; //写INI文件
var
  IniSetFile: Tinifile;
begin
  IniSetStr := TRUE;
  IniSetFile := TInifile.Create(FileName);
  IniSetFile.WriteString(JName, XName, WirteValue);
  IniSetFile.Free;
end;
//ini<

//File Dir >

function CopyFileEx(sSou, sTar: string): Boolean;
begin
  Result := Copyfile(pchar(sSou), pchar(sTar), True);
end;

function CopyDir(const Source, Dest: string): boolean;
var
  fo: TSHFILEOPSTRUCT;
begin
  FillChar(fo, SizeOf(fo), 0);
  with fo do
  begin
    Wnd := 0;
    wFunc := FO_COPY;
    pFrom := PChar(source + #0);
    pTo := PChar(Dest + #0);
    fFlags := FOF_SILENT + FOF_NOCONFIRMATION + FOF_NOCONFIRMMKDIR;
    hNameMappings := nil;
    lpszProgressTitle := '正在复制文件夹';
  end;
  Result := (SHFileOperation(fo) = 0);
end;

//删除整个文年夹

function DeleteDir(const Source: string): boolean;
var
  fo: TSHFILEOPSTRUCT;
begin
  FillChar(fo, SizeOf(fo), 0);
  with fo do
  begin
    Wnd := 0;
    wFunc := FO_DELETE;
    pFrom := PChar(source + #0);
    pTo := nil;
    fFlags := FOF_SILENT + FOF_NOCONFIRMATION + FOF_NOERRORUI;
    // + FOF_ALLOWUNDO  删除到回收站
    hNameMappings := nil;
    lpszProgressTitle := '正在删除文件夹';
  end;
  Result := (SHFileOperation(fo) = 0);
end;

//File Dir<

//压缩,解压缩文件>

function GetAllSubDir(Directory: string; var RetList: TStringList): Boolean;
var
  SearchRec: TSearchRec;
  sTemp: string;
  function IsSubDir(SearchRec: TSearchRec): Boolean;
  begin
    if (SearchRec.Attr = faDirectory) and (SearchRec.Name <> '.') and
      (SearchRec.Name <> '..') then
      Result := True
    else
      Result := False;
  end;
begin
  if FindFirst(Directory + '*.*', faAnyFile, SearchRec) = 0 then
  begin
    repeat //循环直到Until为真
      if IsSubDir(SearchRec) then
      begin
        sTemp := Directory + SearchRec.Name + '/';
        RetList.Add(sTemp);
        GetAllSubDir(sTemp, RetList); //这是递归部分，查找各子目录。
      end;
    until (FindNext(SearchRec) <> 0);
  end;
  FindClose(SearchRec);
  Result := True;
end;

function GetAllDirFile(Directory: string; var RetList: TStringList): Boolean;
var
  i: Integer;
  DirList: TStringList;
  SearchRec: TSearchRec;
begin
  Result := False;
  DirList := TStringList.Create;
  DirList.Add(Directory + '/');
  if not GetAllSubDir(Directory + '/', DirList) then exit;

  for i := 0 to DirList.Count - 1 do
  begin
    if FindFirst(DirList.Strings[i] + '*.*', faAnyFile, SearchRec) = 0 then
    begin
      repeat //循环直到Until为真
        if SearchRec.Attr <> faDirectory then
          RetList.Add(DirList.Strings[i] + SearchRec.Name);
      until (FindNext(SearchRec) <> 0);
    end;
  end;
  if DirList.Count <= 0 then
    RetList.Add(Directory);
  DirList.Free;
  Result := True;
end;

function ZipDir(sDir, sFile: string): Boolean;
var
  VCLZip1: TVCLZip;
  RetList: TStringList;
begin
  Result := True;
  VCLZip1 := TVCLZip.Create(nil);
  RetList := TStringList.Create;
  GetAllDirFile(sDir, RetList);
  with VCLZip1 do
  begin
    FilesList := RetList;
    ZipName := sFile;
    RelativePaths := True; //相对目录
   //  StorePaths := True;   //存储目录
  end;
  VCLZIP1.RootDir := SDIR; //根目录
 // VCLZip1.Destdir := sDir; //目标目录
//  Screen.Cursor := crHourglass;

  try
    VCLZip1.Zip;
  except
    Result := False;
  end;
//  Screen.Cursor := crDefault;
  RetList.Free;
  VCLZip1.Free;
end;

function UnZipDir(sFile, sDir: string): Boolean;
var
  VCLUnZip1: TVCLUnZip;
begin
  Result := True;
  VCLUnZip1 := TVCLUnZip.Create(nil);
  with VCLUnZip1 do
  begin
    ZipName := sFile;
    ReadZip;
    Destdir := sDir;
    RecreateDirs := True;
    FilesList.Add('*.*');
    DoAll := True;
    OverwriteMode := Always;
  end;
 // Screen.Cursor := crHourglass;
  try
    VCLUnZip1.UnZip;
  except
    Result := False;
  end;
  //Screen.Cursor := crDefault;
  VCLUnZip1.Free;
end;
   //压缩,解压缩文件<

end.