www.pudn.com > D7_7z_example.rar > Unit1.pas, change:2008-12-26,size:5073b


unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, JvDialogs, StdCtrls, Buttons, JvExButtons, JvButtons, 
  JvExStdCtrls, JvCombobox, JvDriveCtrls, FileCtrl, JvListBox, 
  JvExControls, JvXPCore, JvXPCheckCtrls, Mask, JvExMask, JvSpin, JvLabel, 
  ComCtrls; 
 
type 
  TForm1 = class(TForm) 
    JvOpenDialog1: TJvOpenDialog; 
    JvSaveDialog1: TJvSaveDialog; 
    JvDirectoryListBox1: TJvDirectoryListBox; 
    JvFileListBox1: TJvFileListBox; 
    JvDriveCombo1: TJvDriveCombo; 
    JvXPCheckbox1: TJvXPCheckbox; 
    JvXPCheckbox2: TJvXPCheckbox; 
    JvXPCheckbox3: TJvXPCheckbox; 
    JvXPCheckbox4: TJvXPCheckbox; 
    JvSpinEdit1: TJvSpinEdit; 
    JvLabel1: TJvLabel; 
    Button1: TButton; 
    Button2: TButton; 
    Label2: TLabel; 
    ListBox1: TListBox; 
    StatusBar1: TStatusBar; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure JvHTButton1Click(Sender: TObject); 
    procedure JvHTButton2Click(Sender: TObject); 
    procedure JvFileListBox1Click(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
uses SevenZip; 
 
{$R *.dfm} 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  LoadSevenZipDLL; 
  Label2.Caption := '7z ver '+IntToStr(hi(SevenZipGetVersion))+'.'+ 
    IntToStr(lo(SevenZipGetVersion)); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  UnLoadSevenZipDLL; 
end; 
 
procedure TForm1.JvHTButton1Click(Sender: TObject); 
var 
//  hWnd : HWND; 
  RecurseFolders : Boolean; 
  ExtractFullPaths : Boolean; 
  FileList : string; 
  ArcName : string; 
  ExtractBaseDir : string; 
  ShowProgress   : Boolean; 
  res:integer; 
// Callback       : TSevenZipCallbackProc = nil 
begin 
  RecurseFolders := JvXPCheckbox1.Checked; 
  ExtractFullPaths := JvXPCheckbox4.Checked; 
  FileList := '*.*'; 
  ArcName := JvOpenDialog1.FileName; 
  ExtractBaseDir := JvDirectoryListBox1.Directory; 
  ShowProgress := JvXPCheckbox3.Checked; 
  if JvOpenDialog1.Execute then 
  res := SevenZipExtractArchive( Handle, // parent window handle 
                                ArcName,  // fn 
                                FileList, // comma separated files to be extracted (wildcards ok) 
                                RecurseFolders, 
                                ExtractFullPaths, 
                                ExtractBaseDir, 
                                ShowProgress,     // if true uses dll's internal progress indicator (callback func ignored) 
                                nil ); // optional callback (ShowProgress must be false) 
  if res = 0 then ShowMessage('Success extract') 
  else ShowMessage('Unsuccess extract '+IntTostr(res)) 
end; 
 
procedure TForm1.JvHTButton2Click(Sender: TObject); 
var 
  CompressionLevel : integer; 
  CreateSolidArchive : Boolean; 
  RecurseFolders : Boolean; 
  ShowProgress   : Boolean; 
  FileList : string; 
  res:integer; 
// Callback       : TSevenZipCallbackProc = nil 
begin 
  CompressionLevel := JvSpinEdit1.AsInteger; 
  CreateSolidArchive := JvXPCheckbox2.Checked; 
  RecurseFolders := JvXPCheckbox1.Checked; 
  ShowProgress   := JvXPCheckbox3.Checked; 
  FileList:=''; 
  for res:=0 to JvFileListBox1.Count-1 do 
    if JvFileListBox1.Selected[res] then 
    begin 
      if FileList<>'' then FileList:= FileList+','+ExtractFileName(JvFileListBox1.Items[res]) 
      else FileList:=ExtractFileName(JvFileListBox1.Items[res]) 
    end; 
  JvSaveDialog1.Title :=' Save to archive:'; 
  if JvSaveDialog1.Execute then 
  res:= SevenZipCreateArchive( Handle, // parent window handle 
                                JvSaveDialog1.FileName, 
                                FileList, // comma separated files to be added to archive (wildcards ok) 
                                CompressionLevel,  // 0 = none, 9=max 
                                CreateSolidArchive, // solid = better compression for multiple files 
                                RecurseFolders,   // recurse folders? 
                                ShowProgress,     // if true uses dll's internal progress indicator (callback func ignored) 
                                nil ); // optional callback (ShowProgress must be false) 
  if res=0 then ShowMessage('Success archive') 
  else ShowMessage('Unsuccess archive '+IntTostr(res)) 
end; 
 
procedure TForm1.JvFileListBox1Click(Sender: TObject); 
var 
  an,ff:PAnsiChar; 
  fn:string; 
  i:integer; 
  h:HARC; 
  lpSubInfo : TSevenZipINDIVIDUALINFO; 
begin 
  fn:=UpperCase(ExtractFileExt(JvFileListBox1.FileName)); 
  if (fn='.7Z') or (fn='.ZIP') then 
  begin 
    an:=PChar(JvFileListBox1.FileName); 
    h:=SevenZipOpenArchive( Handle, an, 0 ); 
    StatusBar1.SimpleText := 'Files in acrchive:'+IntToStr(SevenZipGetFileCount(an))+ 
    ' ratio:'+IntToStr(hi(SevenZipGetRatio(h)))+'.'+ 
    IntToStr(lo(SevenZipGetRatio(h))); 
	  SevenZipCloseArchive( h ); 
 
  end 
  else StatusBar1.SimpleText :=''; 
end; 
 
end.