dfwraru.pas

dfw控件组V0.62

unit DFWRarU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    StdCtrls, ComCtrls, Buttons, DFWRARArc;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    Button2: TButton;
    Button3: TButton;
    RAR: TDFWRar;
    ProgressBar: TProgressBar;
    Label1: TLabel;
    StopB: TBitBtn;
    Button4: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    function VolumeChange(Sender: TObject;ArcName : PChar; Mode : Integer) : Integer;
    procedure Button2Click(Sender: TObject);
    procedure RARExtracting(Sender: TObject; eFile: RARHeaderData);
    procedure RARExtract(Sender: TObject; eFile: RARHeaderData; Result : Boolean);
    procedure RARComment(Sender: TObject; Comment: TComment);
    procedure RARError(Sender: TObject; Error: Integer);
    procedure Button3Click(Sender: TObject);
    procedure RARTesting(Sender: TObject; eFile: RARHeaderData);
    procedure RARTested(Sender: TObject; eFile: RARHeaderData;
      Result: Boolean);
    procedure RARListFile(Sender: TObject; ListedFile: RARHeaderData);
    function RARProcessData(Sender: TObject; Addr: PChar; BlockSize,
      Position: Integer): Integer;
    procedure StopBClick(Sender: TObject);
    procedure RARReqPassword(Sender: TObject; eFile: RARHeaderData;
      var Password: String);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  StopB.Enabled:=True;
  RAR.ListArchive;
  StopB.Enabled:=False;
end;

function TForm1.VolumeChange(Sender: TObject;ArcName : PChar; Mode : Integer) : Integer;
begin
{Result!}
  Result:=1;
  if Mode=moVolAsk then
  begin
    MessageDlg('Insert disk with '+ArcName,mtInformation,[mbOk],0);
    Result:=1;
  end;

  if Mode=moVolNotify then
  begin // Successfuly opened
    Result:=1;
  end;
end;


procedure TForm1.Button2Click(Sender: TObject);
//var xRAR : TDFWRar;
begin
  StopB.Enabled:=True;
  RAR.ExtractArchive;
  StopB.Enabled:=False;
end;

procedure TForm1.RARExtracting(Sender: TObject; eFile: RARHeaderData);
begin
  ListBox1.Items.Add('Extracting file : '+eFile.FileName);
  Label1.Caption:=eFile.FileName;
  ProgressBar.Min:=0;
  ProgressBar.Position:=0;
  ProgressBar.Max:=eFile.UnpSize;
  ListBox1.ItemIndex:=ListBox1.Items.Count-1;
  Application.ProcessMessages;
end;

procedure TForm1.RARExtract(Sender: TObject; eFile: RARHeaderData; Result : Boolean);
begin
  if Result then
    ListBox1.Items.Add('OK') else
    ListBox1.Items.Add('ERROR');
end;

procedure TForm1.RARComment(Sender: TObject; Comment: TComment);
begin
  MessageDlg('Comment present',mtInformation,[mbOk],0);
end;

procedure TForm1.RARError(Sender: TObject; Error: Integer);
begin
  MessageDlg(RAR.GetErrorString(Error),mtError,[mbOk],0);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  StopB.Enabled:=True;
  if not RAR.TestArchive then MessageDlg('Archive is corrupted',mtInformation,[mbOk],0) else
    MessageDlg('Archive is OK',mtInformation,[mbOk],0);
  StopB.Enabled:=False;
end;

procedure TForm1.RARTesting(Sender: TObject; eFile: RARHeaderData);
begin
  ListBox1.Items.Add('Testing file : '+eFile.FileName);
end;

procedure TForm1.RARTested(Sender: TObject; eFile: RARHeaderData;
  Result: Boolean);
begin
  if Result then
    ListBox1.Items.Add('CRC OK') else
    ListBox1.Items.Add('CRC ERROR');
  ListBox1.ItemIndex:=ListBox1.Items.Count-1;
  Application.ProcessMessages;
end;

procedure TForm1.RARListFile(Sender: TObject; ListedFile: RARHeaderData);
begin
  ListBox1.Items.Add('Recognized file : '+ListedFile.FileName);
  ListBox1.ItemIndex:=ListBox1.Items.Count-1;
  Application.ProcessMessages;
end;

function TForm1.RARProcessData(Sender: TObject; Addr: PChar; BlockSize,
  Position: Integer): Integer;
begin
  Result:=1;
  ProgressBar.Position:=Position;
  Application.ProcessMessages;
end;

procedure TForm1.StopBClick(Sender: TObject);
begin
  RAR.Stop:=True;
end;

procedure TForm1.RARReqPassword(Sender: TObject; eFile: RARHeaderData;
  var Password: String);
begin
  MessageDlg('Password required by '+StrPas(@eFile.FileName[1]),mtInformation,[mbOk],0);
  Password:='THIS_IS_PASSWORD_FOR_FILE_eFILE.FILENAME';
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
     if opendialog1.execute then Rar.ArchiveName:=OpenDialog1.FileName;
end;

end.