vclZip控件的使用

aaie_ 2013-04-30

展开全文

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;
   //压缩,解压缩文件<