Subscribe

RSS Feed (xml)

Powered By

Skin Design:
Free Blogger Skins

Powered by Blogger

星期三, 9月 26, 2007

RAR壓縮及解壓縮




首先要加入OBRARCompress的元件,然後新增1個視窗form、1個TProgressBar,並加入PageControl1及新增兩個Page:

TabSheet1有
3個TLabel、2個TEdit(密碼的TEdit屬性PasswordChar=*)、4個TButton、1個TMemo、1個TOpenDiolag及TOBRARCompress。

TabSheet2有
3個TLabel、3個TEdit(密碼的TEdit屬性PasswordChar=*、解壓縮至的TEdit屬性Text=C:\)、2個TButton。

事件:
除了所有按鈕皆點兩下加入外,TOBRARCompress事件OnCompressing也要加入。



unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, OBRARCompress;

type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
ProgressBar1: TProgressBar;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Button5: TButton;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Button6: TButton;
OpenDialog1: TOpenDialog;
OBRARCompress1: TOBRARCompress;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure OBRARCompress1Compressing(Sender: TObject;
Progress: Integer);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure UpdateControlsStatus1(Enabled : Boolean);
procedure UpdateControlsStatus2(Enabled : Boolean);
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.UpdateControlsStatus1(Enabled: Boolean);
begin
Edit1.Enabled := Enabled;
Edit2.Enabled := Enabled;
Memo1.Enabled := Enabled;
Button1.Enabled := Enabled;
Button2.Enabled := Enabled;
Button3.Enabled := Enabled;
Button4.Enabled := Enabled;
end;

procedure TForm1.UpdateControlsStatus2(Enabled: Boolean);
begin
Edit3.Enabled := Enabled;
Edit4.Enabled := Enabled;
Edit5.Enabled := Enabled;
Button5.Enabled := Enabled;
Button6.Enabled := Enabled;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
OpenDialog1.Filter := 'RAR文件|*.rar';
if not OpenDialog1.Execute then
Exit;
Edit1.Text := OpenDialog1.FileName;
if Pos('.rar',Edit1.Text)>0 then
Exit;
Edit1.Text := Edit1.Text + '.rar';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Memo1.Lines.Clear;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
OpenDialog1.Filter := '所有文件|*.*';
if not OpenDialog1.Execute then
Exit;
Memo1.Lines.Add(OpenDialog1.FileName);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
//如果為TRUE的,而文件路徑又太長的時候,Memo會自動換行,
//會導致下面OBRARCompress1.SourceFiles.Assign得到的文件名不正確
Memo1.WordWrap:=false;


UpdateControlsStatus1(False);
Screen.Cursor := crHourGlass;

//動態創建OBRARCompress控件
try
//OBRARCompress1.OnCompressing:=OBCompressing;
OBRARCompress1.SourceFiles.Assign(Memo1.Lines);
OBRARCompress1.RARFileName := Edit1.Text;
OBRARCompress1.Password := Edit2.Text;
if OBRARCompress1.Compress then
ShowMessage('壓縮成功啦 !')
else
ShowMessage('壓縮失敗啦 !');
finally
UpdateControlsStatus1(True);
ProgressBar1.Position := 0;
Screen.Cursor := crDefault;
end;
end;

procedure TForm1.OBRARCompress1Compressing(Sender: TObject;
Progress: Integer);
begin
ProgressBar1.Position := Progress;
Application.ProcessMessages;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
OpenDialog1.Filter := 'RAR文件|*.rar';
if not OpenDialog1.Execute then
Exit;
Edit3.Text := OpenDialog1.FileName;
if Pos('.rar',Edit3.Text)>0 then
Exit;
Edit3.Text := Edit3.Text + '.rar';
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
OBRARCompress1.RARFileName := Edit3.Text;
if not DirectoryExists(Edit4.Text) then
CreateDir(Edit4.Text);
OBRARCompress1.UnPath:=Edit4.text;
OBRARCompress1.Password := Edit5.Text;
UpdateControlsStatus2(False);
Screen.Cursor := crHourGlass;
try
try
if OBRARCompress1.UNCompress then
ShowMessage('解壓縮成功啦 !')
else
ShowMessage('解壓縮失敗啦 !');
except
ShowMessage('解壓縮出現了問題 !');
end;
finally
UpdateControlsStatus2(True);
ProgressBar1.Position := 0;
Screen.Cursor := crDefault;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
PageControl1.TabIndex :=0;
end;

end.

zLib.dll、UnzLib.dll、OBRARCompress.dcu 皆要放在同一目錄喔。

沒有留言: