Версия для печати темы Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Zip or Rar

Автор: X-Vlad 19.3.2004, 13:42

Привет всем. Ребята помогите плз. Срочнно нужен компонент для упаковки в архив zip или rar именно для упаковки - компонент "Unrar" неподходит..... Горит проект.... Зарание благодарен.

Автор: bartram 19.3.2004, 13:45

Есть коипоненты ZipTv поищи в интернете правда они платные. Выложу их на сайте дам ссылку

Автор: X-Vlad 19.3.2004, 13:51

bartram спасибо.... качну... может есть бесплатные?

Автор: X-Vlad 19.3.2004, 14:53

нашол компонент называется "ZipForge" - много возможностей и наворотов. Бесплатный Для Delphi 4,5,6,7, CBuilder 4,5,6

Автор: NiJazz 19.3.2004, 16:48

X-Vlad Где нашёл? Оставь ссылку.

Автор: Akella 19.3.2004, 17:01

Мы ждем

Автор: z-END 19.3.2004, 17:34

Мож немного не втему, на диске с дельфями есть папка Extras и в ней есть такая штука как VCLZip и VCLUnZip - т.е. архиватор и разархиватор... если у кого нет могу на почту скинуть... правда ща посомтрел исходники ах для 3 дельфей... ну все равно думаю больших проблемм передевлть ни у кого небудет

Автор: X-Vlad 19.3.2004, 17:56

Сорри что так долго - на обед бегал ... http://www.torry.net/vcl/compress/std/zf.zip

Автор: Alex101 19.3.2004, 18:32

А запускать сам архиватор с параметрами не подходит?

Автор: Vit 19.3.2004, 19:50

Пакет бесплатных компонентов с исходниками Abbrevia, скачать можно с www.torry.net поддерживает zip и cab

Автор: pascal 19.3.2004, 20:17

у меня есть компонет VCLZIP зделан он был поначалу для delphi 1, потом дошло до delphi 5, но под delphi 6 не работало, пришлось хорошо постараться чтобы привести его в себя, подом до delphi 7 довёл... вобщем могу поделиться если кому надо, так как в инете я не видел этот компонент... уникальность в том что он 100% в виде пасовских исходников... TVCLZip = class(TVCLUnZip) private FPackLevel: Integer; FRecurse: Boolean; FDispose: Boolean; FStorePaths: Boolean; FRelativePaths: Boolean; FStoreVolumes: Boolean; FZipAction: TZipAction; FBlockSize: LongInt; FMultiZipInfo: TMultiZipInfo; FOnStartZipInfo: TStartZipInfo; FOnStartZip: TStartZipEvent; FOnDisposeFile: TDisposeEvent; FOnEndZip: TEndZipFileEvent; FOnDeleteEntry: TDeleteEvent; FOnNoSuchFile: TNoSuchFileEvent; AmountWritten: LongInt; AmountToWrite: LongInt; UsingTempFile: Boolean; CreatingSFX: Boolean; SFXStubFile: TLFNFileStream; protected { Protected declarations } zfile: TStream; { output compression file } IFile: TStream; { input file to compress } mfile: TStream; { temporary file during spanned file creation } IFileName: String; isize: LongInt; tmpfiles: TSortedZip; tmpfiles2: TSortedZip; tmpecrec: TEndCentral; tmpfile_info: TZipHeaderInfo; tmpZipName: String; mZipName: String; Deleting: Boolean; FileBytes: LongInt; SaveNewName: String; static_ltree: static_ltree_type; static_dtree: static_dtree_type; bl_count: array [0..MAX_ZBITS] of WORD; base_dist: array [0..D_CODES-1] of Integer; length_code: array [0..MAX_MATCH-MIN_MATCH] of Byte; dist_code: array [0..511] of Byte; base_length: array [0..LENGTH_CODES-1] of Integer; TRInitialized: Boolean; {$IFDEF WIN16} windowObj: TkpHugeByteArray; prevObj: TkpHugeWordArray; headObj: TkpHugeWordArray; l_bufObj: TkpHugeByteArray; d_bufObj: TkpHugeWordArray; flag_bufObj: TkpHugeByteArray; {$ENDIF} window: windowtypePtr; prev: prevtypePtr; head: headtypePtr; l_buf: l_buftypePtr; d_buf: d_buftypePtr; flag_buf: flag_buftypePtr; function zfwrite(buf: BytePtr; item_size, nb: Integer): LongInt; function zencode(c: Byte): Byte; function file_read( w: BytePtr; size: usigned ): LongInt; procedure CreateTempZip; function Deflate: LongInt; function ProcessFiles: Integer; function AddFileToZip( FName: String ): Boolean; {procedure MoveExistingFiles;} procedure MoveFile( Index: Integer ); procedure MoveTempFile; procedure StaticInit; procedure CryptHead( passwrd: String ); procedure SetZipName( ZName: String ); override; function GetIsModified: Boolean; procedure SetMultiZipInfo(Value: TMultiZipInfo); function GetCheckDiskLabels: Boolean; override; procedure SetStoreVolumes( Value: Boolean ); function GetMultiMode: TMultiMode; override; procedure SetCheckDiskLabels( Value: Boolean ); override; procedure SetMultiMode( Value: TMultiMode ); override; function DiskRoom: LongInt; function RoomLeft: LongInt; procedure NextPart; procedure LabelDisk; procedure SetPathname(Index: Integer; Value: TZipPathname); procedure SetFilename(Index: Integer; Value: String); procedure SetStorePaths(Value: Boolean); procedure SetRelativePaths(Value: Boolean); procedure Loaded; override; public { Public declarations } constructor Create( AOwner: TComponent ); override; destructor Destroy; override; function Zip: Integer; function DeleteEntries: Integer; procedure SaveModifiedZipFile; function ZipFromStream( theStream: TStream; FName: String ): Integer; function FixZip( InputFile, OutputFile: String): Integer; procedure MakeSFX( SFXStub: String; ModHeaders: Boolean ); property FileComment[Index: Integer]: String read GetFileComment write SetFileComment; property ZipComment: String read GetZipComment write SetZipComment; property IsModified: Boolean read GetIsModified; property CheckDiskLabels: Boolean read GetCheckDiskLabels write SetCheckDiskLabels; property MultiMode: TMultiMode read GetMultiMode write SetMultiMode; property Pathname[Index: Integer]: TZipPathname read GetPathname write SetPathname; property Filename[Index: Integer]: String read GetFilename write SetFilename; published { Published declarations } property PackLevel: Integer read FPackLevel write FPackLevel default 6; property Recurse: Boolean read FRecurse write FRecurse default False; property Dispose: Boolean read FDispose write FDispose default False; property StorePaths: Boolean read FStorePaths write SetStorePaths default False; property RelativePaths: Boolean read FRelativePaths write SetRelativePaths default False; property StoreVolumes: Boolean read FStoreVolumes write SetStoreVolumes default False; property ZipAction: TZipAction read FZipAction write FZipAction default zaUpdate; property MultiZipInfo: TMultiZipInfo read FMultiZipInfo write SetMultiZipInfo; { Event Properties } property OnStartZip: TStartZipEvent read FOnStartZip write FOnStartZip; property OnStartZipInfo: TStartZipInfo read FOnStartZipInfo write FOnStartZipInfo; property OnEndZip: TEndZipFileEvent read FOnEndZip write FOnEndZip; property OnDisposeFile: TDisposeEvent read FOnDisposeFile write FOnDisposeFile; property OnDeleteEntry: TDeleteEvent read FOnDeleteEntry write FOnDeleteEntry; property OnNoSuchFile: TNoSuchFileEvent read FOnNoSuchFile write FOnNoSuchFile; end; TVCLUnZip = class(TComponent) private { Private declarations } FZipName: String; FDestDir: String; FSortMode: TZipSortMode; FReCreateDir: Boolean; FOverwriteMode: TUZOverwriteMode; FFilesList: TStrings; FDoAll: Boolean; FPassword: String; FIncompleteZipMode: TIncompleteZipMode; FKeepZipOpen: Boolean; FDoProcessMessages: Boolean; FNumDisks: Integer; FRetainAttributes: Boolean; FThisVersion: Integer; { Event variables } FOnStartUnzipInfo: TStartUnzipInfo; FOnStartUnZip: TStartUnZipEvent; FOnEndUnZip: TEndUnZipEvent; FOnPromptForOverwrite: TPromptForOverwrite; FOnBadPassword: TBadPassword; FOnBadCRC: TBadCRC; FOnInCompleteZip: TInCompleteZip; { Decrypt } protected FOnFilePercentDone: TFilePercentDone; FOnTotalPercentDone: TTotalPercentDone; FOnSkippingFile: TSkippingFile; FOnGetNextDisk: TGetNextDisk; FArchiveStream: TStream; FBusy: Boolean; FRootDir: String; ArchiveIsStream: Boolean; FCheckDiskLabels: Boolean; FMultiMode: TMultiMode; file_info: TZipHeaderInfo; files: TSortedZip; sortfiles: TSortedZip; filesDate: TDateTime; ZipIsBad: Boolean; CurrentDisk: Integer; theZipFile: TStream; Crc32Val: LongInt; lrec: local_file_header; crec: central_file_header; ecrec: TEndCentral; ZipCommentPos: LongInt; Key: DecryptKey; CancelOperation: Boolean; ZipStream: TStream; StreamZipping: Boolean; Fixing: Boolean; DR: Boolean; TotalUncompressedSize: Comp; TotalBytesDone: Comp; {$IFDEF DEMO2} OpCount: Integer; DemoApp: Boolean; HowOften: Integer; {$ENDIF} procedure OpenZip; procedure CloseZip; function GetCount: Integer; procedure GetFileInfo; function GetZipName: String; procedure SetZipName( ZName: String ); virtual; procedure SetArchiveStream( theStream: TStream ); function GetDestDir: String; procedure SetDestDir( DDir: String ); procedure SetRootDir(Value: String); function UnZipFiles( zip_in_file: TStream ): Integer; function UpdCRC(Octet: Byte; Crc: LongInt) : LongInt; function SwapDisk( NewDisk: Integer): TStream; procedure SetFileComment( Index: Integer; theComment: String ); procedure SetZipComment( theComment: String ); procedure WriteNumDisks( NumberOfDisks: Integer ); procedure NewDiskEvent( Sender: TObject; var S: TStream ); procedure SetThisVersion( v: Integer ); function GetCheckDiskLabels: Boolean; virtual; procedure SetCheckDiskLabels( Value: Boolean ); virtual; { GetMultiMode and SetMultiMode added 3/10/98 for 2.03} function GetMultiMode: TMultiMode; virtual; procedure SetMultiMode( Value: TMultiMode ); virtual; { List functions } procedure SetFilesList( Value: TStrings ); function GetFilename(Index: Integer): TZipFilename; function GetPathname(Index: Integer): TZipPathname; function GetFullname(Index: Integer): String; function GetCompressMethod(Index: Integer): WORD; function GetCompressMethodStr(Index: Integer): String; function GetDateTime(Index: Integer): TDateTime; function GetCrc(Index: Integer): LongInt; function GetCompressedSize(Index: Integer): LongInt; function GetUnCompressedSize(Index: Integer): LongInt; function GetExternalFileAttributes(Index: Integer): LongInt; function GetIsEncrypted(Index: Integer): Boolean; function GetHasComment(Index: Integer): Boolean; function GetFileComment(Index: Integer): String; function GetDiskNo(Index: Integer): Integer; function GetZipHasComment: Boolean; function GetZipComment: String; function GetZipSize: LongInt; {Decryption} function DecryptTheHeader( Passwrd: String; zfile: TStream ): BYTE; procedure update_keys( ch: char ); function decrypt_byte: BYTE; procedure Init_Keys( Passwrd: String ); procedure decrypt_buff( bufptr: BYTEPTR; num_to_decrypt: WORD ); procedure Update_CRC_buff( bufptr: BYTEPTR; num_to_update: WORD ); procedure Loaded; override; public { Public declarations } constructor Create( AOwner: TComponent ); override; destructor Destroy; override; procedure ReadZip; function UnZip: Integer; procedure ClearZip; procedure FillList( FilesList: TStrings ); procedure Sort( SMode: TZipSortMode ); procedure CancelTheOperation; function UnZipToStream( theStream: TStream; FName: String ): Integer; property ArchiveStream: TStream read theZipFile write SetArchiveStream; property Count: Integer read GetCount; property Filename[Index: Integer]: TZipFilename read GetFilename; property Pathname[Index: Integer]: TZipPathname read GetPathname; property FullName[Index: Integer]: String read GetFullName; property CompressMethod[Index: Integer]: WORD read GetCompressMethod; property CompressMethodStr[Index: Integer]: String read GetCompressMethodStr; property DateTime[Index: Integer]: TDateTime read GetDateTime; property Crc[Index: Integer]: LongInt read GetCrc; property CompressedSize[Index: Integer]: LongInt read GetCompressedSize; property UnCompressedSize[Index: Integer]: LongInt read GetUnCompressedSize; property ExternalFileAttributes[Index: Integer]: LongInt read GetExternalFileAttributes; property IsEncrypted[Index: Integer]: Boolean read GetIsEncrypted; property FileHasComment[Index: Integer]: Boolean read GetHasComment; property FileComment[Index: Integer]: String read GetFileComment; property DiskNo[Index: Integer]: Integer read GetDiskNo; property ZipComment: String read GetZipComment; property Password: String read FPassword write FPassword; property ZipHasComment: Boolean read GetZipHasComment; property NumDisks: Integer read FNumDisks; property ZipSize: LongInt read GetZipSize; property CheckDiskLabels: Boolean read GetCheckDiskLabels write SetCheckDiskLabels default True; property MultiMode: TMultiMode read GetMultiMode write SetMultiMode default mmNone; property Busy: Boolean read FBusy default False; published { Published declarations } property ThisVersion: Integer read FThisVersion write SetThisVersion default kpThisVersion; property ZipName: String read GetZipName write SetZipName; property DestDir: String read GetDestDir write SetDestDir; property RootDir: String read FRootDir write SetRootDir; property SortMode: TZipSortMode read FSortMode write FSortMode default ByNone; property RecreateDirs: Boolean read FRecreateDir write FRecreateDir default False; property OverwriteMode: TUZOverwriteMode read FOverwriteMode write FOverwriteMode default Prompt; property FilesList: TStrings read FFilesList write SetFilesList; property DoAll: Boolean read FDoAll write FDoAll default False; property IncompleteZipMode: TIncompleteZipMode read FIncompleteZipMode write FIncompleteZipMode default izAssumeMulti; property KeepZipOpen: Boolean read FKeepZipOpen write FKeepZipOpen default False; property DoProcessMessages: Boolean read FDoProcessMessages write FDoProcessMessages default True; property RetainAttributes: Boolean read FRetainAttributes write FRetainAttributes default True; { Event Properties } property OnStartUnZipInfo: TStartUnzipInfo read FOnStartUnzipInfo write FOnStartUnzipInfo; property OnFilePercentDone: TFilePercentDone read FOnFilePercentDone write FOnFilePercentDone; property OnTotalPercentDone: TTotalPercentDone read FOnTotalPercentDone write FOnTotalPercentDone; property OnStartUnZip: TStartUnZipEvent read FOnStartUnZip write FOnStartUnZip; property OnEndUnZip: TEndUnZipEvent read FOnEndUnZip write FOnEndUnZip; property OnPromptForOverwrite: TPromptForOverwrite read FOnPromptForOverwrite write FOnPromptForOverwrite; property OnSkippingFile: TSkippingFile read FOnSkippingFile write FOnSkippingFile; property OnBadPassword: TBadPassword read FOnBadPassword write FOnBadPassword; property OnBadCRC: TBadCRC read FOnBadCRC write FOnBadCRC; property OnInCompleteZip: TInCompleteZip read FOnInCompleteZip write FOnInCompleteZip; property OnGetNextDisk: TGetNextDisk read FOnGetNextDisk write FOnGetNextDisk; end;

Автор: Alex 20.3.2004, 07:57

Что касается rar то самый надежный способ это работа через консоль

Автор: pascal 20.3.2004, 08:19

Цитата Что касается rar то самый надежный способ это работа через консоль распоковывать лучше и удобней через unrar.dll

Автор: NiJazz 20.3.2004, 12:44

Цитата распоковывать лучше и удобней через unrar.dll А где можно взять список экспортируемых функций?

Автор: pascal 20.3.2004, 16:02

Цитата А где можно взять список экспортируемых функций? Код unit RARArc; interface uses  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; const  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}  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  TRAR = class(TComponent)  private    { Private declarations }    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;    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;    Function GetErrorStringCZ(Error : Integer) : String;    constructor Create(AOwner : TComponent); override;    destructor Free;  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 Password : String      read FPassword write FPassword;}    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 {Following lines have been written by Jorge Rojas Mata. Thanx Jorge !!} function  RAROpenArchive(var ArchiveData: RAROpenArchiveData): THandle; stdcall; external 'unrar.dll'; function  RARCloseArchive(hArcData: THandle): Integer; stdcall; external 'unrar.dll'; function  RARReadHeader(hArcData: THandle; var HeaderData: RARHeaderData): Integer; stdcall; external 'unrar.dll'; function  RARProcessFile(hArcData: THandle; Operation: Integer; DestPath, DestName: PChar): Integer; stdcall; external 'unrar.dll'; procedure RARSetChangeVolProc(hArcData: THandle; CVP: TChangeVolProc); stdcall; external 'unrar.dll'; procedure RARSetProcessDataProc(hArcData: THandle; PDP: TProcessDataProc); stdcall; external 'unrar.dll'; procedure RARSetPassword(hArcData: THandle; Password: PChar); stdcall; external 'unrar.dll'; {Now something from me ...;-) } var xSelf : Pointer; procedure Register; begin  RegisterComponents('Samples', [TRAR]); end; constructor TRAR.Create(AOwner : TComponent); begin  inherited Create(AOwner);  FFilesToExtract:=TStringList.Create; FFilesToExtract.Sorted:=True;  FFilesToTest:=TStringList.Create; FFilesToTest.Sorted:=True; end; destructor TRAR.Free; begin  FFilesToExtract.Free;  FFilesToTest.Free; 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';    else Result:='Unknown error';  end; end; Function TRAR.GetErrorStringCZ(Error : Integer) : String; begin  case Error of    erEndArchive    : Result:='Konec archivu';    erNoMemory      : Result:='Nedostatek pamьti pro inicializaci datovщ oblasti';    erBadData       : Result:='Кpatn¤ kontrolnэ souшet. Data jsou pravdьpodobnь poЪkozena';    erBadArchive    : Result:='Soubor nenэ RAR archivem';    erUnknownFormat : Result:='Neznсm¤ formсt komentс°e';    erEOpen         : Result:='Chyba p°i otevэrсnэ souboru';    erECreate       : Result:='Chyba p°i vytvс°enэ souboru';    erEClose        : Result:='Chyba p°i zavэrсnэ souboru';    erERead         : Result:='Chyba p°i шtenэ';    erEWrite        : Result:='Chyba p°i zсpisu';    erSmallBuf      : Result:='Komentс° je moc velk¤ na aktuсlnэ zсsobnэk, nebude kompletnэ';    else Result:='Chyba';  end; end; procedure TRAR.ListArchive; var OpenArchiveData : RAROpenArchiveData;    hArcData        : THandle;    RHCode, PFCode  : Integer;    HeaderData      : RARHeaderData;    Comm            : TComment; begin  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:=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:=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.

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)