asked on
Unrar component which works with Delphi2009

Can you point me to an interface to unrar.dll which works for Delphi2009? I've tried about 10 and they all fail in the first call to open the archive.
aikimark
1. you may save yourself some headache and wasted time if you post the names or links to those you've tried and already know do not work.

2. what kind of failure are you getting with D2009?
bryan7
1- Can't possibly remember them, I'd have to look for them all over again, but some that come to mind..

- The one found in rarlab.com (winrar's website)
- Philippe Wechsler's TRar
- Rar32
- RarArc

2- They all fail at the first step to open the archive, with error code 15
Geert G
how did you used to do it ?

you probably have the definitions using stdcall and external ?
menorcanet
ASKER
unit RARArc;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;
 
const
  UnRARdll = 'UnRAR.dll';
 
  rMaxCommentSize = 65535; {Modify this to change the limit of Comment size}
 
  erEndArchive    = 10; {End of archive}
  erNoMemory      = 11; {Not enough memory to initialize data structures}
  erBadData       = 12; {Archive header broken}
  erBadArchive    = 13; {File is not valid RAR archive}
  erUnknownFormat = 14; {UnKnown comment format}
  erEOpen         = 15; {File open error}
  erECreate       = 16; {File create error}
  erEClose        = 17; {File close error}
  erERead         = 18; {Read error}
  erEWrite        = 19; {Write error}
  erSmallBuf      = 20; {Buffer too small, comments weren't read completely}
  erDLLnotFound   = 50; {UNRAR.dll not found. Must be placed in actual dir or in WINDOWS\SYSTEM (SYSTEM32)}
 
  opList          =  0; {Open archive for reading file headers only}
  opExtract       =  1; {Open archive for testing and extracting files}
 
  doSkip          =  0; {Move to the next file in archive}
                        {Warning: If the archive is solid and opExtract mode                                  was set when the archive was opened, the
                                  current file will be processed - the operation
                                  will be performed slower than a simple seek}
  doTest          =  1; {Test the current file and move to the next file in
                         the archive. If the archive was opened with opList mode,
                         the operation is equal to doSkip}
  doExtract       =  2; {Extract the current file and move to the next file.
                         If the archive was opened with opList mode,
                         the operation is equal to doSkip}
 
  moVolAsk        =  0; {Required volume is absent. The function should prompt
                         user and return non-zero value to retry the operation.
                         The function may also specify a new volume name,
                         placing it to ArcName parameter}
                         {!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
  moVolNotify     =  1; {Required volume is successfully opened. This is a
                         notification call and ArcName modification is NOT
                         allowed. The funciton should return non-zero value
                         to continue or a zero value to terminate operation}
                         {!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
 
 
type
    RARHeaderData = record
                    ArcName                            : array[1..260] of char;
                    FileName                           : array[1..260] of char;
                    Flags                              : Cardinal;
                    PackSize                           : Cardinal;
                    UnpSize                            : Cardinal;
                    HostOS                             : Cardinal;
                    FileCRC                            : Cardinal;
                    FileTime                           : Cardinal;
                    UnpVer                             : Cardinal;
                    Method                             : Cardinal;
                    FileAttr                           : Cardinal;
                    CmtBuf                             : PChar;
                    CmtBufSize, CmtSize, CmtState      : Cardinal;
                  end;
 
  RAROpenArchiveData = record
                         ArcName                       : PChar;
                         OpenMode                      : Cardinal;
                         OpenResult                    : Cardinal;
                         CmtBuf                        : PChar;
                         CmtBufSize                    : Cardinal;
                         CmtSize                       : Cardinal;
                         CmtState                      : Cardinal;
                       end;
 
  TComment = record
               Size : Integer;
               Data : Array[1..rMaxCommentSize] of Char;
             end;
 
  {EVENTS}
  TChangeVolProcN     = function (Sender: TObject; ArcName : PChar; Mode : Integer) : Integer of object;
  TProcessDataProcN   = function (Sender: TObject; Addr : PChar; BlockSize, Position : Integer) : Integer of object;
 
  TErrorProc          = procedure (Sender: TObject; Error : Integer) of object;
  TCommentProc        = procedure (Sender: TObject; Comment : TComment) of object;
  TListFileProc       = procedure (Sender: TObject; ListedFile : RARHeaderData) of object;
  TFileBeingExtracted = procedure (Sender: TObject; eFile : RARHeaderData) of object;
  TFileExtracted      = procedure (Sender: TObject; eFile : RARHeaderData; Result : Boolean) of object;
  TFileBeingTested    = procedure (Sender: TObject; eFile : RARHeaderData) of object;
  TFileTested         = procedure (Sender: TObject; eFile : RARHeaderData; Result : Boolean) of object;
  TReqPassword        = procedure (Sender: TObject; eFile : RARHeaderData; var Password : String) of object;
 
  TChangeVolProc      = function (var ArcName : PChar; Mode : Integer) : Integer; cdecl;
  TProcessDataProc    = function (Addr : PChar; Size : Integer) : Integer; cdecl;
 
type PTRAROpenArchive = function (var ArchiveData: RAROpenArchiveData) : THandle; stdcall;
     PTRARCloseArchive = function (hArcData : THandle) : Integer; stdcall;
     PTRARReadHeader = function (hArcData : THandle; var HeaderData : RARHeaderData) : Integer; stdcall;
     PTRARProcessFile = function (hArcData : THandle; Operation : Integer; DestPath, DestName : PChar) : Integer; stdcall;
     PTRARSetChangeVolProc = procedure (hArcData : THandle; CVP : TChangeVolProc); stdcall;
     PTRARSetProcessDataProc = procedure (hArcData : THandle; PDP : TProcessDataProc); stdcall;
     PTRARSetPassword = procedure (hArcData : THandle; Password : PChar); stdcall;
 
  TRAR = class(TComponent)
  private
    { Private declarations }
    FDLLHandle                 : HModule; //THandle; //by at
    FArchiveName               : String;
    FFilesToExtract            : TStringList;
    FFilesToTest               : TStringList;
    FTargetDir                 : String;
    FStop                      : Boolean;
 
    FOnProgress                : TProcessDataProcN;
    FChngVolume                : TChangeVolProcN;
    FError                     : TErrorProc;
    FComment                   : TCommentProc;
    FListFile                  : TListFileProc;
    FFileBeingExtracted        : TFileBeingExtracted;
    FFileExtracted             : TFileExtracted;
    FFileBeingTested           : TFileBeingTested;
    FFileTested                : TFileTested;
    FReqPassword               : TReqPassword;
    FLoadedDLL                 : Boolean;
 
    FActualPos                 : Integer;
 
    procedure SetFilesToExtract(Value : TStringList);
    procedure SetFilesToTest(Value : TStringList);
 
  protected
    { Protected declarations }
 
  public
    { Public declarations }
    procedure ListArchive;
    function ExtractArchive : Boolean; {False - errors in archive, True - everything went ok}
    function TestArchive : Boolean; {False - archive corrupted, True - archive is ok}
 
    Function GetErrorString(Error : Integer) : String;
 
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
 
  published
    { Published declarations }
    property ArchiveName : String read FArchiveName write FArchiveName;
    property FilesToExtract : TStringList read FFilesToExtract write SetFilesToExtract;
    property FilesToTest : TStringList read FFilesToTest write SetFilesToTest;
    property TargetDir : String read FTargetDir write FTargetDir;
    property Stop : Boolean read FStop write FStop default False;
    property LoadedDLL : Boolean read FLoadedDLL;
 
    property OnProcessData : TProcessDataProcN read FOnProgress write FOnProgress;
    property OnVolumeChange : TChangeVolProcN read FChngVolume write FChngVolume;
    property OnError : TErrorProc read FError write FError;
    property OnComment : TCommentProc read FComment write FComment;
    property OnListFile : TListFileProc read FListFile write FListFile;
    property OnExtracting : TFileBeingExtracted read FFileBeingExtracted write FFileBeingExtracted;
    property OnExtract : TFileExtracted read FFileExtracted write FFileExtracted;
    property OnTesting : TFileBeingTested read FFileBeingTested write FFileBeingTested;
    property OnTested : TFileTested read FFileTested write FFileTested;
    property OnReqPassword : TReqPassword read FReqPassword write FReqPassword;
 
 
  end;
 
procedure Register;
 
implementation
 
var
    RAROpenArchive : PTRAROpenArchive;
    RARCloseArchive : PTRARCloseArchive;
    RARReadHeader : PTRARReadHeader;
    RARProcessFile : PTRARProcessFile;
    RARSetChangeVolProc : PTRARSetChangeVolProc;
    RARSetProcessDataProc : PTRARSetProcessDataProc;
    RARSetPassword : PTRARSetPassWord;
 
 
 
var xSelf : Pointer;
    rStream: TResourceStream;
 
procedure Register;
begin
  RegisterComponents('Compression', [TRAR]);
end;
 
constructor TRAR.Create(AOwner : TComponent);
begin
  inherited;
 
  FFilesToExtract:= TStringList.Create; FFilesToExtract.Sorted:=True;
  FFilesToTest:= TStringList.Create; FFilesToTest.Sorted:=True;
  if (csDesigning in ComponentState) then Exit;
 
  @RAROpenArchive:= nil; @RARCloseArchive:= nil; @RARReadHeader:= nil;
  @RARProcessFile:= nil; @RARSetChangeVolProc:= nil; @RARSetProcessDataProc:= nil; @RARSetPassword:= nil;
 
  FDLLHandle := LoadLibrary(PChar(a+UnRARdll));
 
  {if FDLLHandle=0 then FLoadedDLL:=False else }FLoadedDLL:= True;
 
  @RAROpenArchive:= GetProcAddress(FDLLHandle, PChar('RAROpenArchive'));
  @RARCloseArchive:= GetProcAddress(FDLLHandle, PChar('RARCloseArchive'));
  @RARReadHeader:= GetProcAddress(FDLLHandle, PChar('RARReadHeader'));
  @RARProcessFile:= GetProcAddress(FDLLHandle, PChar('RARProcessFile'));
  @RARSetChangeVolProc:= GetProcAddress(FDLLHandle, PChar('RARSetChangeVolProc'));
  @RARSetProcessDataProc:= GetProcAddress(FDLLHandle, PChar('RARSetProcessDataProc'));
  @RARSetPassword:= GetProcAddress(FDLLHandle, PChar('RARSetPassword'));
 
  if (@RAROpenArchive=nil) or (@RARCloseArchive=nil) or (@RARReadHeader=nil) or (@RARProcessFile=nil) or
     (@RARSetChangeVolProc=nil) or (@RARSetProcessDataProc=nil) or (@RARSetPassword=nil) then
       FLoadedDLL:=False;
 
end;
 
destructor TRAR.Destroy;
begin
  FFilesToExtract.Free;
  FFilesToTest.Free;
  FreeLibrary(FDllHandle);
  inherited;
end;
 
procedure TRAR.SetFilesToExtract(Value : TStringList);
begin
  FFilesToExtract.Assign(Value);
end;
 
procedure TRAR.SetFilesToTest(Value : TStringList);
begin
  FFilesToTest.Assign(Value);
end;
 
function ChangeVolProc(var ArcName : PChar; Mode : Integer) : Integer; cdecl;
begin // Future - ArcName sensitive ...
  Result := TRAR(xSelf).OnVolumeChange(xSelf,ArcName,Mode);
end;
 
function ProcessDataProc(Addr : PChar; Size : Integer) : Integer; cdecl;
begin
  TRAR(xSelf).FActualPos:=(TRAR(xSelf).FActualPos+Size);
  Result:=TRAR(xSelf).OnProcessData(xSelf,Addr,Size,TRAR(xSelf).FActualPos);
end;
 
Function TRAR.GetErrorString(Error : Integer) : String;
begin
  case Error of
    erEndArchive    : Result:='End of archive';
    erNoMemory      : Result:='Not enough memory to initialize data structures';
    erBadData       : Result:='CRC error, data damaged';
    erBadArchive    : Result:='File is not valid RAR archive';
    erUnknownFormat : Result:='Unknown comment format';
    erEOpen         : Result:='File open error';
    erECreate       : Result:='File create error';
    erEClose        : Result:='File close error';
    erERead         : Result:='Read error';
    erEWrite        : Result:='Write error';
    erSmallBuf      : Result:='Buffer is too small for comment';
    erDLLnotFound   : Result:='UNRAR.dll not found';
    else Result:='Unknown error';
  end;
end;
 
procedure TRAR.ListArchive;
var OpenArchiveData : RAROpenArchiveData;
    hArcData        : THandle;
    RHCode, PFCode  : Integer;
    HeaderData      : RARHeaderData;
    Comm            : TComment;
begin
  if not LoadedDLL then
  begin
    if Assigned(OnError) then
      OnError(Self,erDLLnotFound);
    Exit;
  end;
  xSelf:=Self;
  OpenArchiveData.ArcName:=@FArchiveName[1];
  {!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
  OpenArchiveData.CmtBuf:=@Comm.Data[1];
  OpenArchiveData.CmtBufSize:=SizeOf(Comm.Data);
  OpenArchiveData.OpenMode:=opList;
  hArcData:=RAROpenArchive(OpenArchiveData);
  Comm.Size:=OpenArchiveData.CmtSize;
 
  if OpenArchiveData.OpenResult<>0 then
  begin
    if Assigned(OnError) then
      OnError(Self,OpenArchiveData.OpenResult);
    RARCloseArchive(hArcData);
    Exit;
  end;
 
  if (OpenArchiveData.CmtState=1) then
  begin
    if Assigned(OnComment) then
      OnComment(Self,Comm);
  end;
 
  if Assigned(OnVolumeChange) then
    RARSetChangeVolProc(hArcData,ChangeVolProc);
 
  HeaderData.CmtBuf:=@Comm.Data[1];
  HeaderData.CmtBufSize:=SizeOf(Comm.Data);
 
  RHCode:=RARReadHeader(hArcData,HeaderData);
  while RHCode=0 do
  begin
    if Assigned(OnListFile) then OnListFile(Self, HeaderData);
    if FStop then
    begin
      FStop:=False;
      RARCloseArchive(hArcData);
      Exit;
    end;
    if (HeaderData.CmtState=1) then OnComment(Self,Comm);
    PFCode:=RARProcessFile(hArcData,doSkip,NIL,NIL);
    if (PFCode<>0) then
    begin
      if Assigned(OnError) then OnError(Self,PFCode);
      Break;
    end;
    RHCode:=RARReadHeader(hArcData,HeaderData);
   end;
 
  if (RHCode=erBadData) and (Assigned(OnError)) then OnError(Self,RHCode);
  RARCloseArchive(hArcData);
end;
///////////////////////////////////////////////////////////////////////////////
function TRAR.ExtractArchive : Boolean;
var OpenArchiveData : RAROpenArchiveData;
    hArcData        : THandle;
    RHCode, PFCode  : Integer;
    HeaderData      : RARHeaderData;
    Comm            : TComment;
    TDir            : PChar;
    Temp            : Integer;
    S               : String;
    Password        : String;
begin
  Result:=False;
  if not LoadedDLL then
  begin
    if Assigned(OnError) then
      OnError(Self,erDLLnotFound);
    Exit;
  end;
  Result:=True;
  if (FArchiveName='') then
  begin
    if Assigned(OnError) then
      OnError(Self,erBadArchive);
    Result:=False;
    Exit;
  end;
  xSelf:=Self;
  OpenArchiveData.ArcName:=@FArchiveName[1];
  {!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
  OpenArchiveData.CmtBuf:=@Comm.Data[1];
  OpenArchiveData.CmtBufSize:=SizeOf(Comm.Data);
  OpenArchiveData.OpenMode:=opExtract;
  hArcData:=RAROpenArchive(OpenArchiveData);
  Comm.Size:=OpenArchiveData.CmtSize;
 
  If FTargetDir='' then TDir:=Nil else TDir:=@FTargetDir[1];
 
  if OpenArchiveData.OpenResult<>0 then
  begin
    RARCloseArchive(hArcData);
    if Assigned(OnError) then
      OnError(Self,OpenArchiveData.OpenResult);
    Result:=False;
    Exit;
  end;
 
  if (OpenArchiveData.CmtState=1) then
  begin
    if Assigned(OnComment) then
      OnComment(Self,Comm);
  end;
 
  if Assigned(OnVolumeChange) then
    RARSetChangeVolProc(hArcData,ChangeVolProc);
 
  HeaderData.CmtBuf:=@Comm.Data[1];
  HeaderData.CmtBufSize:=SizeOf(Comm.Data);
 
  if Assigned(OnProcessData) then
    RARSetProcessDataProc(hArcData,ProcessDataProc);
 
  RHCode:=RARReadHeader(hArcData,HeaderData);
  while RHCode=0 do
  begin
    S:=''; for Temp:=1 to SizeOf(HeaderData.FileName) do if HeaderData.FileName[Temp]=#00 then break else S:=S+HeaderData.FileName[Temp];
    if FStop then
      begin
        FStop:=False;
        RARCloseArchive(hArcData);
        Exit;
      end;
    if (FFilesToExtract.Count=0) or (FFilesToExtract.Find(S,Temp)) then
    begin
      if Assigned(OnExtracting) then OnExtracting(Self, HeaderData);
      FActualPos:=0;
      if ((HeaderData.Flags and 4)=4) and (Assigned(OnReqPassword)) then
      begin
        OnReqPassword(Self,HeaderData,Password);
        if Password<>'' then RARSetPassword(hArcData,@Password[1]);
      end;
      PFCode:=RARProcessFile(hArcData,doExtract,TDir,NiL);
      if Assigned(OnExtract) then OnExtract(Self, HeaderData, PFCode=0);
      if PFCode<>0 then
         begin
           Result:=False;
           if Assigned(OnError) then OnError(Self,PFCode);
           if (PFCode<>erECreate) and (PFCode<>erBadData) then
           begin
             RARCloseArchive(hArcData);
             Exit;
           end;
         end;
    end else
    begin
      PFCode:=RARProcessFile(hArcData,doSkip,TDir,NiL);
      if PFCode<>0 then
         begin
           Result:=False;
           if Assigned(OnError) then OnError(Self,PFCode);
           RARCloseArchive(hArcData);
           Exit;
         end;
    end;
    RHCode:=RARReadHeader(hArcData,HeaderData);
  end;
 
  if (RHCode=erBadData) and (Assigned(OnError)) then OnError(Self,RHCode);
  RARCloseArchive(hArcData);
end;
////////////////////////////////////////////////////////////////////////////////
function TRAR.TestArchive : Boolean;
var OpenArchiveData : RAROpenArchiveData;
    hArcData        : THandle;
    RHCode, PFCode  : Integer;
    HeaderData      : RARHeaderData;
    Comm            : TComment;
    Temp            : Integer;
    S               : String;
    Password        : String;
begin
  Result:=False;
  if not LoadedDLL then
  begin
    if Assigned(OnError) then
      OnError(Self,erDLLnotFound);
    Exit;
  end;
  Result:=True;
  if (FArchiveName='') then
  begin
    if Assigned(OnError) then
      OnError(Self,erBadArchive);
    Result:=False;
    Exit;
  end;
  xSelf:=Self;
  OpenArchiveData.ArcName:=@FArchiveName[1];
  {!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
  OpenArchiveData.CmtBuf:=@Comm.Data[1];
  OpenArchiveData.CmtBufSize:=SizeOf(Comm.Data);
  OpenArchiveData.OpenMode:=opExtract;
  hArcData:=RAROpenArchive(OpenArchiveData);
  Comm.Size:=OpenArchiveData.CmtSize;
 
  if OpenArchiveData.OpenResult<>0 then
  begin
    if Assigned(OnError) then
      OnError(Self,OpenArchiveData.OpenResult);
    Result:=False;
    RARCloseArchive(hArcData);
    Exit;
  end;
 
  if (OpenArchiveData.CmtState=1) then
  begin
    if Assigned(OnComment) then
      OnComment(Self,Comm);
  end;
 
  if Assigned(OnVolumeChange) then
    RARSetChangeVolProc(hArcData,ChangeVolProc);
 
  HeaderData.CmtBuf:=@Comm.Data[1];
  HeaderData.CmtBufSize:=SizeOf(Comm.Data);
 
  RHCode:=RARReadHeader(hArcData,HeaderData);
  while RHCode=0 do
  begin
    S:=''; for Temp:=1 to SizeOf(HeaderData.FileName) do if HeaderData.FileName[Temp]=#00 then break else S:=S+HeaderData.FileName[Temp];
    if FStop then
      begin
        FStop:=False;
        RARCloseArchive(hArcData);
        Exit;
      end;
    if (FFilesToTest.Count=0) or (FFilesToTest.Find(S,Temp)) then
    begin
      if Assigned(OnTesting) then OnTesting(Self, HeaderData);
      if ((HeaderData.Flags and 4)=4) and (Assigned(OnReqPassword)) then
      begin
        OnReqPassword(Self,HeaderData,Password);
        if Password<>'' then RARSetPassword(hArcData,@Password[1]);
      end;
      PFCode:=RARProcessFile(hArcData,doTest,nil,niL);
      if Assigned(OnTested) then OnTested(Self, HeaderData,PFCode=0);
      if PFCode<>0 then
         begin
           Result:=False;
           If Assigned(OnError) then OnError(Self,PFCode);
           if (PFCode<>erECreate) and (PFCode<>erBadData) then
           begin
             RARCloseArchive(hArcData);
             Exit; {Serios error, exit}
           end;
         end;
    end else
    begin
      PFCode:=RARProcessFile(hArcData,doSkip,nil,niL);
      if PFCode<>0 then
         begin
           if Assigned(OnError) then OnError(Self,PFCode);
           Result:=False;
           RARCloseArchive(hArcData);
           Exit;
         end;
    end;
    RHCode:=RARReadHeader(hArcData,HeaderData);
  end;
 
  if (RHCode=erBadData) and (Assigned(OnError)) then OnError(Self,RHCode);
  RARCloseArchive(hArcData);
end;
 
end.
Open in new window
ChristianWimmer
It is easy to convert Philippe's rar sources to ansicode to use in Delphi 2009 until he converted it completely.
Just convert:
*String to AnsiString
*PChar to PAnsiChar
*char to AnsiChar
*FindFirstFile to FindFirstFileA
menorcanet
ASKER
Won't that make it impossible to read unicode files?
ChristianWimmer
Sure, but it is only temporary until P. converted it.
menorcanet
ASKER
I need it to support Unicode though, maybe you could modify it for me? Raised the points to 250.

Thanks
ChristianWimmer
Sorry, haven't any time at the moment. However, I think you should directly contact Philippe. As far as I know he is in the middle of conversion.
menorcanet
ASKER