unit1.pas

来自「一个很方便的RAR解压/压缩的控件 delphi」· PAS 代码 · 共 146 行

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    pgc1: TPageControl;
    ts1: TTabSheet;
    ts2: TTabSheet;
    pnl1: TPanel;
    OBRARCompress1: TOBRARCompress;
    pb1: TProgressBar;
    lbl3: TLabel;
    lbl1: TLabel;
    edt1: TEdit;
    lbl2: TLabel;
    mmo1: TMemo;
    btn1: TButton;
    lbl4: TLabel;
    edt2: TEdit;
    edt3: TEdit;
    lbl5: TLabel;
    btn2: TButton;
    dlgSave1: TSaveDialog;
    dlgOpen1: TOpenDialog;
    btn3: TButton;
    btn4: TButton;
    btn5: TButton;
    btn6: TButton;
    procedure btn1Click(Sender: TObject);
    procedure btnBtnCloseClick(Sender: TObject);
    procedure OBRARCompress1Compressing(Sender: TObject;
      Progress: Integer);
    procedure FormCreate(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn5Click(Sender: TObject);
    procedure btn6Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
  private
    procedure UpdateControlsStatus(Enabled : Boolean);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);
begin
  //如果为TRUE的，而文件路径又太长的时候，Memo会自动换行，
  //会导致下面OBRARCompress1.SourceFiles.Assign得到的文件名不正确
  mmo1.WordWrap:=false;
  Screen.Cursor := crHourGlass;
  UpdateControlsStatus(False);
  //动态创建OBRARCompress控件
  try
    //OBRARCompress1.OnCompressing:=OBCompressing;
    OBRARCompress1.SourceFiles.Assign(mmo1.Lines);
    OBRARCompress1.RARFileName := edt1.Text;
    if OBRARCompress1.Compress then
      ShowMessage('压缩成功啦 !')
    else
      ShowMessage('压缩失败啦 !');
  finally
    UpdateControlsStatus(True);
    Screen.Cursor := crDefault;
  end;
end;

procedure TForm1.btnBtnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.UpdateControlsStatus(Enabled: Boolean);
begin
  edt1.Enabled := Enabled;
  mmo1.Enabled := Enabled;
  Btn1.Enabled := Enabled;
end;

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

procedure TForm1.FormCreate(Sender: TObject);
begin
	pgc1.Align := alClient;
   pgc1.TabIndex :=0;
end;

procedure TForm1.btn3Click(Sender: TObject);
begin
   dlgOpen1.Filter := 'RAR文件|*.rar';
	if not dlgSave1.Execute then Exit;
   edt1.Text := dlgSave1.FileName;
end;

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

procedure TForm1.btn6Click(Sender: TObject);
begin
	mmo1.Lines.Clear;
end;

procedure TForm1.btn4Click(Sender: TObject);
begin
	dlgOpen1.Filter := 'RAR文件|*.rar';
	if not dlgOpen1.Execute then Exit;
   edt2.Text := dlgOpen1.FileName;
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
	if not DirectoryExists(edt3.Text) then
   	CreateDir(edt3.Text);
   OBRARCompress1.UnPath:=edt3.text;       
   OBRARCompress1.RARFileName := edt2.Text;
   try
    if OBRARCompress1.UNCompress then
       ShowMessage('解压缩成功啦 !')
     else
       ShowMessage('解压缩失败啦 !');
   except
       ShowMessage('解压缩出现了问题 !');
   end;
end;

end.