267 lines
7.2 KiB
ObjectPascal
267 lines
7.2 KiB
ObjectPascal
// 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.
|