之前写过 VCLZip + Multi-Thread 的简单 Demo,Now share it:
program ZipDemo;
Forms,
Unit1 in 'Unit1.pas' {frm_Main};
{$R *.res}
Application.Initialize;
Application.CreateForm(Tfrm_Main, frm_Main);
Application.Title:= '解压缩示例';
Application.Run;
end.
unit Unit1;
interface
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, VCLUnZip, VCLZip, StdCtrls, ComCtrls, Gauges, ExtCtrls;
WM_ZipDone = WM_USER + 111;
WM_ZipError = WM_USER + 112;
TZipThread = class(TThread)
_VCLZip: TVCLZip;
protected
procedure Execute; override;
end;
_VCLUnZip: TVCLUnZip;
protected
procedure Execute; override;
end;
VCLZip1: TVCLZip;
VCLUnZip1: TVCLUnZip;
Dlg_OpenDlg: TOpenDialog;
Dlg_SaveDlg: TSaveDialog;
btn_Zip: TButton;
btn_UnZip: TButton;
Memo1: TMemo;
Label1: TLabel;
Shp1: TShape;
Shp2: TShape;
Shp3: TShape;
Shp4: TShape;
Shp5: TShape;
Tmr_FlashTip: TTimer;
procedure btn_ZipClick(Sender: TObject);
procedure btn_UnZipClick(Sender: TObject);
procedure Label1Click(Sender: TObject);
procedure Tmr_FlashTipTimer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
FZipThread: TZipThread;
FUnZipThread: TUnZipThread;
public
{ Public declarations }
procedure SetTipShpsVisible(IsVisible: Boolean = True);
procedure WM_ZipDone(var Msg: TMessage); message WM_ZipDone;
procedure WM_ZipError(var Msg: TMessage); message WM_ZipError;
end;
frm_Main: Tfrm_Main;
implementation
QDialogs, ShellAPI;
ZipFlag = 1; //压缩
UnZipFlag = 2; //解压
ZipErrorInfo = '%s失败!失败原因:%s '; //压缩/解压、失败原因
{$R *.dfm}
var
SaveName: string;
i: Integer;
begin
Memo1.Lines.Clear;
begin
Update;
Memo1.Lines.Add(Dlg_OpenDlg.Files.Strings
end;
if Dlg_SaveDlg.Execute then
SaveName:= Dlg_SaveDlg.FileName
else
Exit;
begin
ZipName:= SaveName;
Password:= ''; //Here set your Password...
Recurse:= True;
Screen.Cursor:= crHourGlass;
for i:= 0 to Memo1.Lines.Count - 1 do
FilesList.Add(Memo1.Lines
end;
ZipBegin;
with FZipThread do
begin
FreeOnTerminate:= True;
Resume;
end;
end;
var
i: Integer;
OpenName: string;
DestPath: WideString;
begin
Memo1.Lines.Clear;
OpenName:= Dlg_OpenDlg.FileName
else
Exit;
begin
ZipName:= OpenName;
Password:= ''; //Here set your Password...
ReadZip;
for i:= 0 to Count - 1 do
Memo1.Lines.Add(Filename
Screen.Cursor:= crDefault;
Exit;
DoAll:= True;
RecreateDirs:= True;
RetainAttributes:= True;
end;
FUnZipThread:= TUnZipThread.Create(True);
with FUnZipThread do
begin
FreeOnTerminate:= True;
_VCLUnZip:= VCLUnZip1;
Resume;
end;
end;
begin
ShellExecute(
0,
'Open',
'http://user.qzone.qq.com/395588677/infocenter',
nil,
nil,
SW_SHOW
);
end;
begin
if Shp1.Brush.Color = clGreen then
begin
Shp1.Brush.Color:= clFuchsia;
Shp2.Brush.Color:= clGreen;
Shp3.Brush.Color:= clFuchsia;
Shp4.Brush.Color:= clFuchsia;
Shp5.Brush.Color:= clFuchsia;
end
else if Shp2.Brush.Color = clGreen then
begin
Shp1.Brush.Color:= clFuchsia;
Shp2.Brush.Color:= clFuchsia;
Shp3.Brush.Color:= clGreen;
Shp4.Brush.Color:= clFuchsia;
Shp5.Brush.Color:= clFuchsia;
end
else if Shp3.Brush.Color = clGreen then
begin
Shp1.Brush.Color:= clFuchsia;
Shp2.Brush.Color:= clFuchsia;
Shp3.Brush.Color:= clFuchsia;
Shp4.Brush.Color:= clGreen;
Shp5.Brush.Color:= clFuchsia;
end
else if Shp4.Brush.Color = clGreen then
begin
Shp1.Brush.Color:= clFuchsia;
Shp2.Brush.Color:= clFuchsia;
Shp3.Brush.Color:= clFuchsia;
Shp4.Brush.Color:= clFuchsia;
Shp5.Brush.Color:= clGreen;
end
else if Shp5.Brush.Color = clGreen then
begin
Shp1.Brush.Color:= clGreen;
Shp2.Brush.Color:= clFuchsia;
Shp3.Brush.Color:= clFuchsia;
Shp4.Brush.Color:= clFuchsia;
Shp5.Brush.Color:= clFuchsia;
end;
end;
begin
if FInProcess then
begin
if Assigned(FZipThread) then
begin
FZipThread.Suspend;
Handle,
'正在压缩文件,您确定要退出吗? ',
'退出确认',
MB_YESNO + MB_ICONQUESTION
) = IDYES then
begin
FZipThread.Resume;
SendMessage(frm_Main.Handle, WM_USER + 111, 0, 0);
end
else
begin
FZipThread.Resume;
Action:= caNone;
end;
end
else
begin
FUnZipThread.Suspend;
if MessageBox(
Handle,
'正在解压文件,您确定要退出吗? ',
'退出确认',
MB_YESNO + MB_ICONQUESTION
) = IDYES then
begin
FUnZipThread.Resume;
SendMessage(frm_Main.Handle, WM_USER + 111, 0, 0);
end
else
begin
FUnZipThread.Resume;
Action:= caNone;
end;
end;
end;
end;
begin
FInProcess:= True;
btn_Zip.Enabled:= False;
btn_UnZip.Enabled:= False;
SetTipShpsVisible(True);
Shp1.Brush.Color:= clGreen;
Tmr_FlashTip.Enabled:= True;
end;
begin
Tmr_FlashTip.Enabled:= False;
SetTipShpsVisible(False);
if Assigned(FZipThread) then
FZipThread:= nil
else if Assigned(FUnZipThread) then
FUnZipThread:= nil;
btn_Zip.Enabled:= True;
btn_UnZip.Enabled:= True;
FInProcess:= False;
Screen.Cursor:= crDefault;
if Msg.WParam = ZipFlag then
MessageBox(
Handle,
PChar(
'压缩完毕! ' + #13 + '共压缩了 ' +
IntToStr(Msg.LParam) + ' 个文件。 '
),
'提示',
MB_OK + MB_ICONINFORMATION
)
else if Msg.WParam = UnZipFlag then
MessageBox(
Handle,
PChar(
'解压完毕! ' + #13 + '共解压了 ' +
IntToStr(Msg.LParam) + ' 个文件。 '
),
'提示',
MB_OK + MB_ICONINFORMATION
);
end;
begin
Tmr_FlashTip.Enabled:= False;
SetTipShpsVisible(False);
FZipThread:= nil
else if Assigned(FUnZipThread) then
FUnZipThread:= nil;
btn_UnZip.Enabled:= True;
FInProcess:= False;
Screen.Cursor:= crDefault;
Handle,
PChar(Msg.LParam),
'错误',
MB_OK + MB_ICONERROR
);
end;
begin
if IsVisible then
begin
Shp1.Visible:= True;
Shp2.Visible:= True;
Shp3.Visible:= True;
Shp4.Visible:= True;
Shp5.Visible:= True;
end
else
begin
Shp1.Visible:= False;
Shp2.Visible:= False;
Shp3.Visible:= False;
Shp4.Visible:= False;
Shp5.Visible:= False;
end;
end;
var
ZippedCount: Integer;
begin
Screen.Cursor:= crHourGlass;
try
ZippedCount:= _VCLZip.Zip;
SendMessage(frm_Main.Handle, WM_ZipDone, ZipFlag, ZippedCount);
except
on E: Exception do
begin
SendMessage(
frm_Main.Handle,
WM_ZipError,
ZipFlag,
Integer(Format(ZipErrorInfo, ['压缩', E.Message]))
);
end;
end;
end;
var
UnZippedCount: Integer;
begin
Screen.Cursor:= crHourGlass;
try
UnZippedCount:= _VCLUnZip.UnZip;
SendMessage(frm_Main.Handle, WM_ZipDone, UnZipFlag, UnZippedCount);
except
on E: Exception do
begin
SendMessage(
frm_Main.Handle,
WM_ZipError,
UnZipFlag,
Integer(Format(ZipErrorInfo, ['解压', E.Message]))
);
end;
end;
end;

















