Стартовый пул
This commit is contained in:
176
unrar/Examples/Delphi/UnRAR.pas
Normal file
176
unrar/Examples/Delphi/UnRAR.pas
Normal file
@@ -0,0 +1,176 @@
|
||||
// Delphi interface unit for UnRAR.dll
|
||||
// Translated from unrar.h
|
||||
// Use Delphi 2.0 and higher to compile this module
|
||||
//
|
||||
// Ported to Delphi by Eugene Kotlyarov, fidonet: 2:5058/26.9 ek@oris.ru
|
||||
// Fixed version by Alexey Torgashin <alextp@mail.ru>, 2:5020/604.24@fidonet
|
||||
//
|
||||
// Revisions:
|
||||
// Aug 2001 - changed call convention for TChangeVolProc and TProcessDataProc
|
||||
// - added RARGetDllVersion function, see comment below
|
||||
//
|
||||
// Jan 2002 - Added RARSetCallback // eugene
|
||||
//
|
||||
// Oct 2002 - Added RARHeaderDataEx, RAROpenArchiveDataEx // eugene
|
||||
|
||||
unit UnRAR;
|
||||
|
||||
interface
|
||||
|
||||
uses Windows;
|
||||
|
||||
const
|
||||
ERAR_END_ARCHIVE = 10;
|
||||
ERAR_NO_MEMORY = 11;
|
||||
ERAR_BAD_DATA = 12;
|
||||
ERAR_BAD_ARCHIVE = 13;
|
||||
ERAR_UNKNOWN_FORMAT = 14;
|
||||
ERAR_EOPEN = 15;
|
||||
ERAR_ECREATE = 16;
|
||||
ERAR_ECLOSE = 17;
|
||||
ERAR_EREAD = 18;
|
||||
ERAR_EWRITE = 19;
|
||||
ERAR_SMALL_BUF = 20;
|
||||
ERAR_UNKNOWN = 21;
|
||||
|
||||
RAR_OM_LIST = 0;
|
||||
RAR_OM_EXTRACT = 1;
|
||||
|
||||
RAR_SKIP = 0;
|
||||
RAR_TEST = 1;
|
||||
RAR_EXTRACT = 2;
|
||||
|
||||
RAR_VOL_ASK = 0;
|
||||
RAR_VOL_NOTIFY = 1;
|
||||
|
||||
RAR_DLL_VERSION = 3;
|
||||
|
||||
UCM_CHANGEVOLUME = 0;
|
||||
UCM_PROCESSDATA = 1;
|
||||
UCM_NEEDPASSWORD = 2;
|
||||
|
||||
type
|
||||
RARHeaderData = packed record
|
||||
ArcName: packed array[0..Pred(260)] of AnsiChar;
|
||||
FileName: packed array[0..Pred(260)] of AnsiChar;
|
||||
Flags: UINT;
|
||||
PackSize: UINT;
|
||||
UnpSize: UINT;
|
||||
HostOS: UINT;
|
||||
FileCRC: UINT;
|
||||
FileTime: UINT;
|
||||
UnpVer: UINT;
|
||||
Method: UINT;
|
||||
FileAttr: UINT;
|
||||
CmtBuf: PAnsiChar;
|
||||
CmtBufSize: UINT;
|
||||
CmtSize: UINT;
|
||||
CmtState: UINT;
|
||||
end;
|
||||
|
||||
RARHeaderDataEx = packed record
|
||||
ArcName: packed array [0..1023] of AnsiChar;
|
||||
ArcNameW: packed array [0..1023] of WideChar;
|
||||
FileName: packed array [0..1023] of AnsiChar;
|
||||
FileNameW: packed array [0..1023] of WideChar;
|
||||
Flags: UINT;
|
||||
PackSize: UINT;
|
||||
PackSizeHigh: UINT;
|
||||
UnpSize: UINT;
|
||||
UnpSizeHigh: UINT;
|
||||
HostOS: UINT;
|
||||
FileCRC: UINT;
|
||||
FileTime: UINT;
|
||||
UnpVer: UINT;
|
||||
Method: UINT;
|
||||
FileAttr: UINT;
|
||||
CmtBuf: PAnsiChar;
|
||||
CmtBufSize: UINT;
|
||||
CmtSize: UINT;
|
||||
CmtState: UINT;
|
||||
Reserved: packed array [0..1023] of UINT;
|
||||
end;
|
||||
|
||||
RAROpenArchiveData = packed record
|
||||
ArcName: PAnsiChar;
|
||||
OpenMode: UINT;
|
||||
OpenResult: UINT;
|
||||
CmtBuf: PAnsiChar;
|
||||
CmtBufSize: UINT;
|
||||
CmtSize: UINT;
|
||||
CmtState: UINT;
|
||||
end;
|
||||
|
||||
RAROpenArchiveDataEx = packed record
|
||||
ArcName: PAnsiChar;
|
||||
ArcNameW: PWideChar;
|
||||
OpenMode: UINT;
|
||||
OpenResult: UINT;
|
||||
CmtBuf: PAnsiChar;
|
||||
CmtBufSize: UINT;
|
||||
CmtSize: UINT;
|
||||
CmtState: UINT;
|
||||
Flags: UINT;
|
||||
Reserved: packed array [0..31] of UINT;
|
||||
end;
|
||||
|
||||
TUnrarCallback = function (Msg: UINT; UserData, P1, P2: Integer) :Integer; stdcall;
|
||||
|
||||
const
|
||||
_unrar = 'unrar.dll';
|
||||
|
||||
function RAROpenArchive(var ArchiveData: RAROpenArchiveData): THandle;
|
||||
stdcall; external _unrar;
|
||||
function RAROpenArchiveEx(var ArchiveData: RAROpenArchiveDataEx): THandle;
|
||||
stdcall; external _unrar;
|
||||
function RARCloseArchive(hArcData: THandle): Integer;
|
||||
stdcall; external _unrar;
|
||||
function RARReadHeader(hArcData: THandle; var HeaderData: RARHeaderData): Integer;
|
||||
stdcall; external _unrar;
|
||||
function RARReadHeaderEx(hArcData: THandle; var HeaderData: RARHeaderDataEx): Integer;
|
||||
stdcall; external _unrar;
|
||||
function RARProcessFile(hArcData: THandle; Operation: Integer; DestPath, DestName: PChar): Integer;
|
||||
stdcall; external _unrar;
|
||||
procedure RARSetCallback(hArcData: THandle; UnrarCallback: TUnrarCallback; UserData: Integer);
|
||||
stdcall; external _unrar;
|
||||
procedure RARSetPassword(hArcData: THandle; Password: PChar);
|
||||
stdcall; external _unrar;
|
||||
|
||||
// Wrapper for DLL's function - old unrar.dll doesn't export RARGetDllVersion
|
||||
// Returns: -1 = DLL not found; 0 = old ver. (C-style callbacks); >0 = new ver.
|
||||
function RARGetDllVersion: integer;
|
||||
|
||||
// obsolete functions
|
||||
type
|
||||
TChangeVolProc = function(ArcName: PAnsiChar; Mode: Integer): Integer; stdcall;
|
||||
TProcessDataProc = function(Addr: PUChar; Size: Integer): Integer; stdcall;
|
||||
|
||||
procedure RARSetChangeVolProc(hArcData: THandle; ChangeVolProc: TChangeVolProc);
|
||||
stdcall; external _unrar;
|
||||
procedure RARSetProcessDataProc(hArcData: THandle; ProcessDataProc: TProcessDataProc);
|
||||
stdcall; external _unrar;
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
TRARGetDllVersion = function: integer; stdcall;
|
||||
|
||||
function RARGetDllVersion: integer;
|
||||
var
|
||||
h: THandle;
|
||||
f: TRARGetDllVersion;
|
||||
begin
|
||||
h := LoadLibrary(_unrar);
|
||||
if h = 0 then begin
|
||||
Result := -1;
|
||||
Exit
|
||||
end;
|
||||
f := GetProcAddress(h, 'RARGetDllVersion');
|
||||
if @f = nil then
|
||||
Result := 0
|
||||
else
|
||||
Result := f;
|
||||
FreeLibrary(h);
|
||||
end;
|
||||
|
||||
end.
|
||||
266
unrar/Examples/Delphi/UnRDLL.dpr
Normal file
266
unrar/Examples/Delphi/UnRDLL.dpr
Normal file
@@ -0,0 +1,266 @@
|
||||
// UnRDLL - simple example of UnRAR.dll usage
|
||||
// Translated from UnRDLL.c
|
||||
// Use Delphi 2.0 or higher to compile this module
|
||||
//
|
||||
// Ported to Delphi by Eugene Kotlyarov, fidonet: 2:5058/26.9 ek@oris.ru
|
||||
// Fixed version by Alexey Torgashin <alextp@mail.ru>, 2:5020/604.24@fidonet
|
||||
|
||||
program UnRDLL;
|
||||
|
||||
{$APPTYPE CONSOLE}
|
||||
{$H+}
|
||||
|
||||
uses AnsiStrings, Windows, UnRAR, SysUtils;
|
||||
|
||||
const
|
||||
EXTRACT = 0;
|
||||
TEST = 1;
|
||||
PRINT = 2;
|
||||
|
||||
procedure ShowComment(CmtBuf: PAnsiChar); forward;
|
||||
procedure OutHelp; forward;
|
||||
procedure OutOpenArchiveError(Error: Integer; ArcName: PAnsiChar); forward;
|
||||
procedure OutProcessFileError(Error: Integer); forward;
|
||||
procedure ShowArcInfo(Flags: UINT; ArcName: PAnsiChar); forward;
|
||||
|
||||
const
|
||||
CR = #13#10;
|
||||
|
||||
function SFmt(const S: AnsiString; Width: Byte): AnsiString;
|
||||
begin
|
||||
if Length(S) < Width then
|
||||
Result := S + StringOfChar(AnsiChar(' '), Width - Length(S))
|
||||
else
|
||||
Result := Copy(S, 1, Width);
|
||||
end;
|
||||
|
||||
function CallbackProc(msg: UINT; UserData, P1, P2: integer) :integer; stdcall;
|
||||
var
|
||||
Ch: AnsiChar;
|
||||
I: Integer;
|
||||
C: PAnsiChar;
|
||||
S: AnsiString;
|
||||
begin
|
||||
Result := 0;
|
||||
case msg of
|
||||
UCM_CHANGEVOLUME:
|
||||
if (P2 = RAR_VOL_ASK) then begin
|
||||
Write(CR, 'Insert disk with ', PAnsiChar(P1), ' and press ''Enter'' or enter ''Q'' to exit ');
|
||||
Readln(Ch);
|
||||
if (UpCase (Ch) = 'Q') then
|
||||
Result := -1;
|
||||
end;
|
||||
UCM_NEEDPASSWORD:
|
||||
begin
|
||||
Write(CR, 'Please enter the password for this archive: ');
|
||||
Readln(S);
|
||||
C := PAnsiChar(S);
|
||||
Move(pointer(C)^, pointer(p1)^, AnsiStrings.StrLen(C) + 1);
|
||||
//+1 to copy the zero
|
||||
end;
|
||||
UCM_PROCESSDATA: begin
|
||||
if (UserData <> 0) and (PINT (UserData)^ = PRINT) then begin
|
||||
Flush (Output);
|
||||
// Windows.WriteFile fails on big data
|
||||
for I := 0 to P2 - 1 do
|
||||
Write(PAnsiChar(P1 + I)^);
|
||||
Flush (Output);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ExtractArchive(ArcName: PAnsiChar; Mode: Integer);
|
||||
var
|
||||
hArcData: THandle;
|
||||
RHCode, PFCode: Integer;
|
||||
CmtBuf: array[0..Pred(16384)] of AnsiChar;
|
||||
HeaderData: RARHeaderData;
|
||||
OpenArchiveData: RAROpenArchiveDataEx;
|
||||
Operation: Integer;
|
||||
begin
|
||||
OpenArchiveData.ArcName := ArcName;
|
||||
OpenArchiveData.CmtBuf := @CmtBuf;
|
||||
OpenArchiveData.CmtBufSize := SizeOf(CmtBuf);
|
||||
OpenArchiveData.OpenMode := RAR_OM_EXTRACT;
|
||||
hArcData := RAROpenArchiveEx(OpenArchiveData);
|
||||
|
||||
if (OpenArchiveData.OpenResult <> 0) then
|
||||
begin
|
||||
OutOpenArchiveError(OpenArchiveData.OpenResult, ArcName);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
ShowArcInfo(OpenArchiveData.Flags, ArcName);
|
||||
|
||||
if (OpenArchiveData.CmtState = 1) then
|
||||
ShowComment(CmtBuf);
|
||||
|
||||
RARSetCallback (hArcData, CallbackProc, Integer (@Mode));
|
||||
|
||||
HeaderData.CmtBuf := nil;
|
||||
|
||||
repeat
|
||||
RHCode := RARReadHeader(hArcData, HeaderData);
|
||||
if RHCode <> 0 then
|
||||
Break;
|
||||
|
||||
case Mode of
|
||||
EXTRACT: Write(CR, 'Extracting ', SFmt(HeaderData.FileName, 45));
|
||||
TEST: Write(CR, 'Testing ', SFmt(HeaderData.FileName, 45));
|
||||
PRINT: Write(CR, 'Printing ', SFmt(HeaderData.FileName, 45), CR);
|
||||
end;
|
||||
|
||||
if Mode = EXTRACT then
|
||||
Operation := RAR_EXTRACT
|
||||
else
|
||||
Operation := RAR_TEST;
|
||||
PFCode := RARProcessFile(hArcData, Operation, nil, nil);
|
||||
|
||||
if (PFCode = 0) then
|
||||
Write(' Ok')
|
||||
else begin
|
||||
OutProcessFileError(PFCode);
|
||||
Break;
|
||||
end;
|
||||
until False;
|
||||
|
||||
if (RHCode = ERAR_BAD_DATA) then
|
||||
Write(CR, 'File header broken');
|
||||
|
||||
RARCloseArchive(hArcData);
|
||||
end;
|
||||
|
||||
procedure ListArchive(ArcName: PAnsiChar);
|
||||
var
|
||||
hArcData: THandle;
|
||||
RHCode, PFCode: Integer;
|
||||
CmtBuf: array[0..Pred(16384)] of AnsiChar;
|
||||
HeaderData: RARHeaderDataEx;
|
||||
OpenArchiveData: RAROpenArchiveDataEx;
|
||||
begin
|
||||
OpenArchiveData.ArcName := ArcName;
|
||||
OpenArchiveData.CmtBuf := @CmtBuf;
|
||||
OpenArchiveData.CmtBufSize := SizeOf(CmtBuf);
|
||||
OpenArchiveData.OpenMode := RAR_OM_LIST;
|
||||
hArcData := RAROpenArchiveEx(OpenArchiveData);
|
||||
|
||||
if (OpenArchiveData.OpenResult <> 0) then
|
||||
begin
|
||||
OutOpenArchiveError(OpenArchiveData.OpenResult, ArcName);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
ShowArcInfo(OpenArchiveData.Flags, ArcName);
|
||||
|
||||
if (OpenArchiveData.CmtState = 1) then
|
||||
ShowComment(CmtBuf);
|
||||
|
||||
RARSetCallback (hArcData, CallbackProc, 0);
|
||||
|
||||
HeaderData.CmtBuf := @CmtBuf;
|
||||
HeaderData.CmtBufSize := SizeOf(CmtBuf);
|
||||
|
||||
Write(CR, 'File', StringOfChar(' ',42),'Size');
|
||||
Write(CR, StringOfChar('-', 50));
|
||||
repeat
|
||||
RHCode := RARReadHeaderEx(hArcData, HeaderData);
|
||||
if RHCode <> 0 then
|
||||
Break;
|
||||
Write(CR, SFmt(HeaderData.FileName, 39), ' ',
|
||||
(HeaderData.UnpSize + HeaderData.UnpSizeHigh * 4294967296.0):10:0);
|
||||
if (HeaderData.CmtState = 1) then
|
||||
ShowComment(CmtBuf);
|
||||
PFCode:= RARProcessFile(hArcData, RAR_SKIP, nil, nil);
|
||||
if (PFCode <> 0) then
|
||||
begin
|
||||
OutProcessFileError(PFCode);
|
||||
Break;
|
||||
end;
|
||||
until False;
|
||||
|
||||
if (RHCode = ERAR_BAD_DATA) then
|
||||
Write(CR, 'File header broken');
|
||||
|
||||
RARCloseArchive(hArcData);
|
||||
end;
|
||||
|
||||
procedure ShowComment(CmtBuf: PAnsiChar);
|
||||
begin
|
||||
Write(CR, 'Comment:', CR, CmtBuf, CR);
|
||||
end;
|
||||
|
||||
procedure ShowArcInfo(Flags: UINT; ArcName: PAnsiChar);
|
||||
function CheckFlag(S: AnsiString; FlagBit: UINT): AnsiString;
|
||||
begin
|
||||
if (Flags and FlagBit) > 0 then result := 'yes' else result := 'no';
|
||||
Write(CR, Format('%-16s %s',[S, Result]));
|
||||
end;
|
||||
begin
|
||||
Writeln(CR, 'Archive ', ArcName);
|
||||
CheckFlag('Volume:', 1);
|
||||
CheckFlag('Comment:', 2);
|
||||
CheckFlag('Locked:', 4);
|
||||
CheckFlag('Solid:', 8);
|
||||
CheckFlag('New naming:', 16);
|
||||
CheckFlag('Authenticity:', 32);
|
||||
CheckFlag('Recovery:', 64);
|
||||
CheckFlag('Encr.headers:', 128);
|
||||
CheckFlag('First volume:', 256);
|
||||
Writeln(CR, '---------------------------');
|
||||
end;
|
||||
|
||||
procedure OutHelp;
|
||||
begin
|
||||
Write(CR, 'UNRDLL. This is a simple example of UNRAR.DLL usage', CR);
|
||||
Write(CR, 'Syntax:', CR);
|
||||
Write(CR, 'UNRDLL X <Archive> extract archive contents');
|
||||
Write(CR, 'UNRDLL T <Archive> test archive contents');
|
||||
Write(CR, 'UNRDLL P <Archive> print archive contents to stdout');
|
||||
Write(CR, 'UNRDLL L <Archive> view archive contents', CR);
|
||||
end;
|
||||
|
||||
procedure OutOpenArchiveError(Error: Integer; ArcName: PAnsiChar);
|
||||
begin
|
||||
case Error of
|
||||
ERAR_NO_MEMORY: Write(CR, 'Not enough memory');
|
||||
ERAR_EOPEN: Write(CR, 'Cannot open ', ArcName);
|
||||
ERAR_BAD_ARCHIVE: Write(CR, ArcName, ' is not RAR archive');
|
||||
ERAR_BAD_DATA: Write(CR, ArcName, ': archive header broken');
|
||||
ERAR_UNKNOWN: Write(CR, 'Unknown error');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure OutProcessFileError(Error: Integer);
|
||||
begin
|
||||
case Error of
|
||||
ERAR_UNKNOWN_FORMAT: Write('Unknown archive format');
|
||||
ERAR_BAD_ARCHIVE: Write('Bad volume');
|
||||
ERAR_ECREATE: Write('File create error');
|
||||
ERAR_EOPEN: Write('Volume open error');
|
||||
ERAR_ECLOSE: Write('File close error');
|
||||
ERAR_EREAD: Write('Read error');
|
||||
ERAR_EWRITE: Write('Write error');
|
||||
ERAR_BAD_DATA: Write('CRC error');
|
||||
ERAR_UNKNOWN: Write('Unknown error');
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
if ParamCount <> 2 then
|
||||
begin
|
||||
OutHelp;
|
||||
Halt(0);
|
||||
end;
|
||||
|
||||
case UpCase(ParamStr(1)[1]) of
|
||||
'X': ExtractArchive(PAnsiChar(AnsiString(ParamStr(2))), EXTRACT);
|
||||
'T': ExtractArchive(PAnsiChar(AnsiString(ParamStr(2))), TEST);
|
||||
'P': ExtractArchive(PAnsiChar(AnsiString(ParamStr(2))), PRINT);
|
||||
'L': ListArchive(PAnsiChar(AnsiString(ParamStr(2))));
|
||||
else
|
||||
OutHelp;
|
||||
end;
|
||||
|
||||
Halt(0);
|
||||
end.
|
||||
Reference in New Issue
Block a user