Delphi 中之 VCLZip 控件很不错的说，结合多线程，很容易搞出颇具特色的软件...
    之前写过 VCLZip + Multi-Thread 的简单 Demo，Now share it：

program ZipDemo;
    uses
      Forms,
      Unit1 in 'Unit1.pas' {frm_Main};
    {$R *.res}
    begin
      Application.Initialize;
      Application.CreateForm(Tfrm_Main, frm_Main);
      Application.Title:= '解压缩示例';
      Application.Run;
    end.

unit Unit1;

interface

uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, VCLUnZip, VCLZip, StdCtrls, ComCtrls, Gauges, ExtCtrls;

const
      WM_ZipDone = WM_USER + 111;
      WM_ZipError = WM_USER + 112;

type
      TZipThread = class(TThread)
        _VCLZip: TVCLZip;
      protected
        procedure Execute; override;  
      end;

TUnZipThread = class(TThread)
        _VCLUnZip: TVCLUnZip;
      protected
        procedure Execute; override;  
      end;

Tfrm_Main = class(TForm)
        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;
        FInProcess: Boolean;
      public
        { Public declarations }
        procedure SetTipShpsVisible(IsVisible: Boolean = True);
        procedure ZipBegin;
    
        procedure WM_ZipDone(var Msg: TMessage); message WM_ZipDone;
        procedure WM_ZipError(var Msg: TMessage); message WM_ZipError;
      end;

var
      frm_Main: Tfrm_Main;

implementation

uses
      QDialogs, ShellAPI;

const
      ZipFlag = 1; //压缩
      UnZipFlag = 2; //解压
      ZipErrorInfo = '%s失败！失败原因：%s '; //压缩/解压、失败原因

{$R *.dfm}

procedure Tfrm_Main.btn_ZipClick(Sender: TObject);
    var
      SaveName: string;
      i: Integer;
    begin
      Memo1.Lines.Clear;

if Dlg_OpenDlg.Execute then
      begin
        Update;

for i:= 0 to Dlg_OpenDlg.Files.Count - 1 do
          Memo1.Lines.Add(Dlg_OpenDlg.Files.Strings);
      end;

if Dlg_SaveDlg.Execute then
        SaveName:= Dlg_SaveDlg.FileName
      else
        Exit;

with VCLZip1 do
      begin
        ZipName:= SaveName;
        Password:= 'Simon.Hu'; //Here set your Password...
        Recurse:= True;
        Screen.Cursor:= crHourGlass;  
  
        for i:= 0 to Memo1.Lines.Count - 1 do
          FilesList.Add(Memo1.Lines);
      end;

ZipBegin;
      FZipThread:= TZipThread.Create(True);
      with FZipThread do
      begin
        FreeOnTerminate:= True;
        _VCLZip:= VCLZip1;
    
        Resume;
      end;
    end;

procedure Tfrm_Main.btn_UnZipClick(Sender: TObject);
    var
      i: Integer;
      OpenName: string;
      DestPath: WideString;
    begin
      Memo1.Lines.Clear;

if Dlg_OpenDlg.Execute then
        OpenName:= Dlg_OpenDlg.FileName
      else
        Exit;

with VCLUnZip1 do
      begin
        ZipName:= OpenName;
        Password:= 'Simon.Hu'; //Here set your Password...

Screen.Cursor:= crHourGlass;
        ReadZip;
        for i:= 0 to Count - 1 do
          Memo1.Lines.Add(Filename + #9 + Pathname);
        Screen.Cursor:= crDefault;

        if not SelectDirectory('请选择保存目录', '', DestPath) then //uses QDialogs...
          Exit;
        DestDir:= DestPath; 
        DoAll:= True;
        RecreateDirs:= True;
        RetainAttributes:= True;
      end; 
      ZipBegin;
      FUnZipThread:= TUnZipThread.Create(True);
      with FUnZipThread do
      begin
        FreeOnTerminate:= True;
        _VCLUnZip:= VCLUnZip1;
   
        Resume;
      end;
    end;
    procedure Tfrm_Main.Label1Click(Sender: TObject);
    begin
      ShellExecute(
                   0,
                   'Open',
                   'http://user.qzone.qq.com/395588677/infocenter',
                   nil,
                   nil,
                   SW_SHOW
                  );
    end;
    procedure Tfrm_Main.Tmr_FlashTipTimer(Sender: TObject);
    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;
    procedure Tfrm_Main.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
      if FInProcess then
      begin
        if Assigned(FZipThread) then
        begin
          FZipThread.Suspend;
          if MessageBox(
                        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;
    procedure Tfrm_Main.ZipBegin;
    begin
      FInProcess:= True;
      btn_Zip.Enabled:= False;
      btn_UnZip.Enabled:= False;
      SetTipShpsVisible(True);
      Shp1.Brush.Color:= clGreen;
      Tmr_FlashTip.Enabled:= True;
    end;
    procedure Tfrm_Main.WM_ZipDone(var Msg: TMessage);
    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;
    procedure Tfrm_Main.WM_ZipError(var Msg: TMessage);
    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;
      MessageBox(
                 Handle,
                 PChar(Msg.LParam),
                 '错误',
                 MB_OK + MB_ICONERROR
                );
    end;
    procedure Tfrm_Main.SetTipShpsVisible(IsVisible: Boolean);
    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;
    { TZipThread }
    procedure TZipThread.Execute;
    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;
    { TUnZipThread }
    procedure TUnZipThread.Execute;
    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;
    end.
附图片：

转载于:https://blog.51cto.com/adelphicoder/214651

VCLZip 简单 Demo相关推荐

  1. EPSON机器人建立TCP/IP通讯的简单demo

    以下为我近期研究EPSON机器人通讯的经验总结,主要实现机械手接收相机发送过来的数据,从而达到对应的位置,及其简单demo. 欢迎加入知识星球[3D视觉工坊],进行交流学习.

  2. Solr配置与简单Demo[转]

    Solr配置与简单Demo 简介: solr是基于Lucene Java搜索库的企业级全文搜索引擎,目前是apache的一个项目.它的官方网址在http://lucene.apache.org/sol ...

  3. VC++ 拖放编程简单Demo

    微软的编程类库都带有拖放编程的接口:下面看一个最简单demo:win7, vc6:新建一个对话框工程: 添加一个列表框控件:设置 接受文件 属性: 在 类向导-Class Info 做如下选择: 为W ...

  4. win32汇编定时器简单Demo

    timer.asm: .386.model flat,stdcalloption casemap:noneinclude windows.inc include user32.inc includel ...

  5. win32汇编创建线程简单Demo

    代码如下:thread.asm: .386.model flat,stdcalloption casemap:noneinclude windows.inc include user32.inc in ...

  6. rabbitMQ消息队列 – 面板介绍及简单demo

    首先rabbit安装好之后,运维会给一个控制面板. 默认账号密码为guest 登入以后可以看到具体界面. 在此鸣谢百度翻译给予的大力支持.. ###写一个简单的demo 编写之前..虽然说可以直接用底 ...

  7. python wpf教程_WPF使用IronPython库的简单Demo

    WPF使用IronPython库的简单Demo 一.IronPython和C#交互 IronPython是一个.NET平台上的Python实现,包括了完整的编译器.执行引擎与运行时支持,能够与.NET ...

  8. Ocelot 入门Demo系列（01-Ocelot极简单Demo及负载均衡的配置）

    来源:https://www.cnblogs.com/7tiny/p/10493805.html [前言] Ocelot是一个用.NET Core实现并且开源的API网关,它功能强大,包括了:路由.请 ...

  9. java爬虫的2种爬取方式（HTTP||Socket）简单Demo(一)

    转载自 java爬虫的2种爬取方式(HTTP||Socket)简单Demo(一) 最近在找java的小项目自己写着玩,但是找不到合适的,于是写开始学一点爬虫,自己也是感觉爬虫比较有趣.这里自己找了一个 ...

最新文章

  1. c语言 python-C语言和python的区别
  2. UCOSIIIAPI函数接口OSTaskCreate();函数
  3. C语言进行离散傅里叶DFT变换~MATLAB验证
  4. 氨氮吹脱法脱与php有关系吗,吹脱法处理氨氮废水的原理及优缺点分析
  5. 虚拟机centos 上安装svn
  6. 第五章 面向方面编程___AOP入门
  7. 剑指offer之和为s的数组
  8. MRP的数据处理-华北水利水电大学(作业)
  9. 【Tomcat】初次配置Tomcat的那些糟心事
  10. 无线技术网络导论--期末复习指导
  11. GCD中dispatch_barrier的使用方法
  12. 微信内置浏览器使用DevTools实现自动顶帖脚本
  13. python ValueError: No JSON object could be decoded
  14. MATLAB二维绘图(二)向图中添加标题，坐标轴，图标和文字信息
  15. react上拉加载更多
  16. [C++]派（二分算法）
  17. 计算机wps系统的造字程序在哪里,Windows10系统自带造字程序在哪？位置介绍
  18. 【多线程】采用Callable接口创建线程
  19. 【2D游戏制作笔记】给游戏战斗增加一点打击感
  20. 袁氏报表用代码画一个饼图

热门文章

  1. 长沙火宫殿城大庙会迎客 演绎传统与潮流交融
  2. 2018年《环球科学》十大科学新闻：霍金逝世、贺建奎事件位列前二
  3. mysql 开发进阶篇系列 23 应用层优化与查询缓存
  4. linux忘记root密码怎么修改密码和多台linux相互使用密钥连接
  5. Gym - 101194F（后缀数组）
  6. C语言 · 猜算式
  7. Java线程栈的获取和分析
  8. jekins 持续集成手记
  9. Hive-1.2.0学习笔记（四）Hive表管理
  10. Java网络编程从入门到精通（25）：创建ServerSocket对象