Привет всем.

Ребята помогите плз.

Срочнно нужен компонент для упаковки в архив zip или rar именно для упаковки - компонент "Unrar" неподходит.....


Горит проект....


Зарание благодарен.

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

bartram

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

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

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

Мы ждем

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

Сорри что так долго - на обед бегал ...

лежит здесь

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

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

у меня есть компонет 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;

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

Цитата

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

распоковывать лучше и удобней через unrar.dll

Цитата

распоковывать лучше и удобней через unrar.dll

А где можно взять список экспортируемых функций?

Цитата

А где можно взять список экспортируемых функций?

Код

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:[email protected][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:[email protected][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:[email protected][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:[email protected][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:[email protected][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:[email protected][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.

Это сообщение отредактировал(а) pascal - 20.3.2004, 16:02