unit1.pas

vb压缩源码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Graphics, Controls, Forms, 
  Dialogs, Buttons, ShellApi, Classes, ExtCtrls, StdCtrls, FileCtrl;

type
  TMainForm = class(TForm)
    odgOpenFile: TOpenDialog;
    GroupBox1: TGroupBox;
    Label1: TStaticText;
    edtSourceFile: TEdit;
    btnBrowseSourceFile: TBitBtn;
    btnBrowseTargetFile: TBitBtn;
    edtTargetFile: TEdit;
    Label2: TStaticText;
    btnZip: TBitBtn;
    GroupBox2: TGroupBox;
    Label3: TStaticText;
    Label4: TStaticText;
    EdtZipFileName: TEdit;
    btnBrowseZipFile: TBitBtn;
    btnBrowseUnZipPath: TBitBtn;
    edtUnZipPath: TEdit;
    btnUnZip: TBitBtn;
    Panel1: TPanel;
    Label_Website: TStaticText;
    Label_Free: TStaticText;
    Image_Icon: TImage;
    Label_Software: TStaticText;
    Label_Version: TStaticText;
    Label_Author: TStaticText;
    sdgSaveFile: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure btnBrowseSourceFileClick(Sender: TObject);
    procedure btnBrowseZipFileClick(Sender: TObject);
    procedure btnBrowseTargetFileClick(Sender: TObject);
    procedure btnBrowseUnZipPathClick(Sender: TObject);
    procedure btnZipClick(Sender: TObject);
    procedure btnUnZipClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

  function ZipTo(strSourceFileName,strZipFileName:PChar;IsKeepPaths:Boolean;strRootDir,strPassword:PChar):Boolean; Stdcall; External 'wfZip.dll';
  function UnZipTo(strZipFileName, strDirectoryPath: PChar;IsKeepPaths:Boolean;strPassword:PChar):Boolean; Stdcall; External 'wfZip.dll';

  function Get_Software():PChar; Stdcall; External 'wfZip.dll';
  function Get_Author():PChar; Stdcall; External 'wfZip.dll';
  function Get_Version():PChar; Stdcall; External 'wfZip.dll';
  function Get_Website():PChar; Stdcall; External 'wfZip.dll';
  function Get_EMail():PChar; Stdcall; External 'wfZip.dll';

implementation

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
begin
   Label_Software.Caption := '软件: '+Get_Software();
   Label_Version.Caption  := '版本: '+Get_Version();
   Label_Author.Caption   := '作者: '+Get_Author();
   Label_Website.Caption  := '网站: '+Get_Website();
end;


procedure TMainForm.btnBrowseSourceFileClick(Sender: TObject);
var
   strFileList:String;
   N:Integer;
begin
   odgOpenFile.Title:='请选择待压缩源文件';
   odgOpenFile.Filter:='All files ( *.* )|*.*';
   odgOpenFile.Options:=[ofHideReadOnly,ofAllowMultiSelect,ofEnableSizing];

   if odgOpenFile.Execute then
      begin
        for N:=0 to odgOpenFile.Files.Count-1 do
           begin
              //用"|"符号分隔，可以压缩多个文件
              strFileList:=strFileList+','+odgOpenFile.Files[N];
           end;
           
        edtSourceFile.Text:=strFileList;
      end;
end;

procedure TMainForm.btnBrowseZipFileClick(Sender: TObject);
begin
   odgOpenFile.Title:='请选择压缩文件';
   odgOpenFile.Filter:='Zip files ( *.zip )|*.zip';
   odgOpenFile.Options:=[ofHideReadOnly,ofEnableSizing];

   if odgOpenFile.Execute then
      begin
        EdtZipFileName.Text:=odgOpenFile.FileName;
      end;
end;

procedure TMainForm.btnBrowseTargetFileClick(Sender: TObject);
begin
   sdgSaveFile.Title:='保存压缩文件';
   sdgSaveFile.Filter:='Zip files ( *.zip )|*.zip';

   if sdgSaveFile.Execute then
      begin
        edtTargetFile.Text:=sdgSaveFile.FileName;
      end;
end;

procedure TMainForm.btnBrowseUnZipPathClick(Sender: TObject);
var
   strPath:string;
begin
   if SelectDirectory('请选择解压目录','',strPath) then
      begin
         edtUnZipPath.Text:=strPath;
      end;
end;

procedure TMainForm.btnZipClick(Sender: TObject);
begin
   if ZipTo(PChar(edtSourceFile.Text),PChar(edtTargetFile.Text),true,'C:\aaa\','')=true then
      application.MessageBox('文件压缩成功！','好消息！',mb_iconInformation)
   else
      application.MessageBox('文件压缩失败！','出错了！',mb_iconWarning);
end;

procedure TMainForm.btnUnZipClick(Sender: TObject);
begin
   if UnZipTo(PChar(EdtZipFileName.Text),PChar(edtUnZipPath.Text),true,'')=true then
      application.MessageBox('文件解压缩成功！','好消息！',mb_iconInformation)
   else
      application.MessageBox('文件解压缩失败！','出错了！',mb_iconWarning);
end;

end.