// TyDecoder Delphi Component
// ===========================================================================
//
// TyDecoder for Delphi 7 - Copyright 2002-2007, by Centova Technologies, Inc.
//
// WWW: http://source.yenc32.com
// E-mail: components@yenc32.com
//
// Version 0.1.6, August 1, 2005
//
//
// License
// -------
// TyDecoder - Copyright 2002-2007, Centova Technologies, Inc.
// http://source.yenc32.com - sourcecode@yenc32.com
//
// This library is free software; you can redistribute it and/or
// modify it under the terms of the GNU Lesser General Public
// License as published by the Free Software Foundation; either
// version 2.1 of the License, or (at your option) any later version.
//
// This library is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
// Lesser General Public License for more details.
//
// You should have received a copy of the GNU Lesser General Public
// License along with this library; if not, write to the Free Software
// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
//
//
// Version History
// ---------------
//
// 0.1.6 - Fixed buffer overflow in parseKeywords()
// 0.1.5 - Files with no CRC are no longer marked invalid
// - Files with no =yend marker are now marked as corrupt
// 0.1.4 - Added DecodeToInputFolder property - when enabled, each file is decoded
// into its respective input folder
// 0.1.3 - Changed licensing policies; TyDecoder is now distributed under the LGPL.
// - Event handlers are now reset to null in constructor
// - On single-part files, FOnDoneDecode was called even if null - fixed.
// - Destroy now calls inherited destructor.
// 0.1.2 - This is more-or-less a complete rewrite, and is NOT backwards-compatible
// with the old versions. This version includes tonnes of new functionality,
// and is the same version used in yEnc32 v0.0.5.
// 0.1.1 - Added AppendFilename property (see comments below).
// Added OutputPath property, used to set the output path when OutputFilename
// is left blank (i.e., autodetecting filename from Keywords).
// TyDecoder is now Kylix-compatible, and can be compiled under Linux.
// 0.1.0 - First release
//
{$UNDEF Debug} // Undefine to remove debug output (might improve speed by a couple milliseconds)
{$UNDEF ActiveX} // Define to derive from TWinControl for creating ActiveX Controls via Borland's
// ActiveX Control Wizard.
// Note that I never could get this component to work properly as an ActiveX
// control. It compiled and ran fine, but on deallocation it caused a flurry
// of AV's and "Privileged Insturction" errors. Rather than waste time figuring
// it out, I decided to scrap the ActiveX project and go with a nice, simple DLL.
unit yDecoder;
interface
uses SysUtils,classes
{$IFDEF ActiveX} ,controls
{$ENDIF};
Const
CH_ESC = Ord('
=');
CH_CR = 13;
CH_LF = 10;
PathSep =
{$ifndef Linux} '
\'
{$else} '
/'
{$endif} ;
DEFAULT_BUFFER_KB = 2048;
TEMP_BUFFER_KB = 512;
Type
TyDecProgressEvent =
procedure(Sender: TObject; Percent: Word;
var Abort: Boolean)
of Object;
TyDecDoneDecodeEvent =
procedure(Sender: TObject; Filename: AnsiString; Filesize: Integer; Corrupt,Complete: Boolean)
of Object;
TyDecStartPartEvent =
procedure(Sender: TObject; Filename: AnsiString; PartNo: Integer)
of Object;
TyDecDonePartEvent =
procedure(Sender: TObject; Filename: AnsiString; PartNo: Integer; Corrupt: Boolean)
of Object;
TyDecNotice =
procedure(Sender: TObject; Msg: AnsiString)
of Object;
TPartInfo =
record
TotalParts: Integer;
PartsProcessed: Integer;
PartsCorrupt: Integer;
LastPartProcessed: Boolean;
// if so, then we know for sure how many parts there are, all total
ReportedDone: Boolean;
end;
PPartInfo = ^TPartInfo;
TKeywordType = (kwdUnknown,kwdBegin, kwdEnd, kwdPart);
TKeyword =
record
TypicalLine: Integer;
Size: Integer;
Filename: AnsiString;
CRC32,
TotalParts,
PartNo,
PartCRC32,
PartBegin,
PartEnd: Integer;
KeywordType: TKeywordType;
end;
PKeyword = ^TKeyword;
PByte = ^Byte;
EyDecoder =
class(
Exception);
TOnDebugMessage =
procedure(Msg: AnsiString)
of object;
TyDecoder =
class(
{$IFDEF ActiveX} TCustomControl
{$ELSE} TComponent
{$ENDIF})
private
FActive: Boolean;
FInputFileName: TFileName;
FOutputFileName: TFileName;
FOutputPath: TFileName;
FDecodeToInputFolder: Boolean;
FInputFileList: TStringList;
FOnProgress: TyDecProgressEvent;
FOnDoneDecode: TyDecDoneDecodeEvent;
FOnStartPart: TyDecStartPartEvent;
FOnDonePart: TyDecDonePartEvent;
FOnNotice: TyDecNotice;
FOnDebugMessage: TOnDebugMessage;
FFileCorrupt: Boolean;
FFilename: AnsiString;
FTotalParts: Integer;
FPartNo: Integer;
FPartCRC32: Integer;
FFileCRC32: Integer;
FPartSize: Integer;
FFileSize: Integer;
FMultiPart: Boolean;
FCorruptReason: AnsiString;
FCalcFileCRC32,
FCalcPartCRC32: Integer;
FPartEnd: Integer;
InputFile,OutputFile:
File;
ifopen,ofopen: boolean;
InputBuf,OutputBuf: Pointer;
InputBlockNo,
InputFileSize,
InputBufferSize,
OutputBufferSize,
numRead: Integer;
Keyword:
Array[TKeywordType]
of PKeyword;
Keywords: Integer;
Escaped: Boolean;
OutputBufEnd,
O: PByte;
Abort: Boolean;
ofFilename: AnsiString;
PartData: TStringList;
function getStr(startIndex,endIndex: PByte): AnsiString;
function strToken(
Var S: AnsiString): AnsiString;
function strSplit(
Var S: AnsiString): AnsiString;
function parseKeywords(kwd: AnsiString): PKeyword;
procedure DebugMessage(S: AnsiString);
procedure ResetProperties;
function findKeywordEscape(pStart,pEnd: PByte): PByte;
function findCRLF(pStart,pEnd: PByte): PByte;
function decodeBuffer(pStart,pEnd: pByte): pByte;
procedure FlushOutputBuffer;
procedure SeekOutput(Position: Integer);
procedure OpenOutputFile(PK: PKeyword);
procedure CheckKeywords;
function SafeFilename(S: AnsiString): AnsiString;
function getExtension(S: AnsiString): AnsiString;
{$IFDEF ActiveX}
function axGetInputFileList: AnsiString;
procedure axSetInputFileList(
const Value: AnsiString);
{$ENDIF}
protected
procedure Activate(GoActive: Boolean);
procedure DecodeFile;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
published
// set to TRUE to begin processing
property Active: Boolean
read FActive
write Activate;
// full path/filename to input file
property InputFileName: TFileName
read FInputFileName;
// list of files to decode
property InputFileList:
{$IFNDEF ActiveX}
TStringList
read FInputFileList
write FInputFileList
{$ELSE}
AnsiString
read axGetInputFileList
write axSetInputFileList
{$ENDIF}
;
// full path/filename to the output file
property OutputFileName: TFileName
read FOutputFileName;
// folder to save decoded files into
property OutputPath: TFileName
read FOutputPath
write FOutputPath;
// if set to true, ignores OutputPath and uses the path of each input file
property DecodeToInputFolder: Boolean
read FDecodeToInputFolder
write FDecodeToInputFolder;
// returns true if the decoded file was corrupt
property FileCorrupt: Boolean
read FFileCorrupt;
// returns the reason the file is considered to be corrupt (if FileCorrupt is true)
property CorruptReason: AnsiString
read FCorruptReason;
// filename of original file (from file Keywords)
property Filename: AnsiString
read FFilename;
// total number of parts (if multipart file), otherwise -1
property TotalParts: Integer
read FTotalParts;
// part number of current part (if multipart file), otherwise -1
property PartNo: Integer
read FPartNo;
// original CRC32 of current part (if multipart file), otherwise -1
property PartCRC32: Integer
read FPartCRC32;
// calculated CRC32 of current part (if multipart file), otherwise -1
property CalcPartCRC32: Integer
read FCalcPartCRC32;
// size of current part (if multipart file), otherwise -1
property PartSize: Integer
read FPartSize;
// original CRC32 of entire file if present, otherwise -1
property FileCRC32: Integer
read FFileCRC32;
// calculated CRC32 of entire file
property CalcFileCRC32: Integer
read FCalcFileCRC32;
// size of entire output file
property FileSize: Integer
read FFileSize;
// returns true if a multipart file is detected
property MultiPart: Boolean
read FMultiPart;
// progress indicator event
property OnProgress: TyDecProgressEvent
read FOnProgress
write FOnProgress;
// special notice event
property OnNotice: TyDecNotice
read FOnNotice
write FOnNotice;
// if {$DEBUG} is defined, this event returns debug information
property OnDebugMessage: TOnDebugMessage
read FOnDebugMessage
write FOnDebugMessage;
// called when the input file is done decoding
property OnDoneDecode: TyDecDoneDecodeEvent
read FOnDoneDecode
write FOnDoneDecode;
// called when each part of a multipart file begins decoding
property OnStartPart: TyDecStartPartEvent
read FOnStartPart
write FOnStartPart;
// called when each part of a multipart file is done decoding.
property OnDonePart: TyDecDonePartEvent
read FOnDonePart
write FOnDonePart;
end;
procedure Register;
implementation
uses CRC32, windows;
const
EyDecFileNotFound = '
Input file not found: %s';
EyDecFileCreateFail = '
Could not create output file: %s';
EyDecOutOfMemory = '
Insufficient memory to allocate buffers';
KeywordTypeStr:
Array[TKeywordType]
of AnsiString = ('
Unknown','
Begin','
End','
Part');
procedure Register;
begin
RegisterComponents('
CommunicaEtor', [TyDecoder]);
end;
constructor TyDecoder.Create(AOwner: TComponent);
var
i: TKeywordType;
begin
inherited Create(AOwner);
for i:=low(TKeywordType)
to high(TKeywordType)
do
Keyword[i]:=nil;
PartData:=TStringList.Create;
FInputFileList:=TStringList.Create;
FFilename:='
';
FOutputFilename:='
';
FOnProgress:=nil;
FOnDoneDecode:=nil;
FOnStartPart:=nil;
FOnDonePart:=nil;
FOnNotice:=nil;
FOnDebugMessage:=nil;
end;
destructor TyDecoder.Destroy;
var
n: Integer;
begin
for n:=PartData.Count-1
DownTo 0
do
if Assigned(PartData.Objects[n])
then Dispose(PPartInfo(PartData.Objects[n]));
PartData.Free;
FInputFileList.Free;
inherited;
end;
procedure TyDecoder.Activate(GoActive: Boolean);
begin
if (GoActive)
then
begin
FActive:=True;
DebugMessage('
activated');
DecodeFile;
DebugMessage('
done');
FActive:=False;
end;
end;
function TyDecoder.getStr(startIndex,endIndex: PByte): AnsiString;
var
S: AnsiString;
Len: Integer;
begin
Len:=Integer(endIndex)-Integer(startIndex)+1;
SetLength(S,Len);
Move(startIndex^,S[1],Len);
result:=S;
end;
procedure TyDecoder.DebugMessage(S: AnsiString);
begin
if Assigned(FOnDebugMessage)
then FOnDebugMessage(S);
end;
function TyDecoder.strToken(
Var S: AnsiString): AnsiString;
begin
Result:=Copy(S,1,Pos('
',S)-1);
Delete(S,1,Pos('
',S));
end;
function TyDecoder.strSplit(
Var S: AnsiString): AnsiString;
Var p: Integer;
begin
P:=Pos('
=',S)-1;
if (P>0)
then
begin
Result:=Copy(S,1,P);
Delete(S,1,P+1);
end
else
begin
Result:=S;
S:='
';
end;
end;
function TyDecoder.getExtension(S: AnsiString): AnsiString;
var i: Integer;
begin
Result:='
';
i:=Length(S);
while ( (i>0)
and (S[i]<>'
.') )
do dec(i);
if (i>0)
then Result:=Copy(S,i+1,Length(S)-i);
end;
function TyDecoder.SafeFilename(S: AnsiString): AnsiString;
const BadChars = [#0..#31,'
*','
\','
/','
:','
<','
>','
?','
|','
"',#255];
var
i: Integer;
Ext: AnsiString;
begin
// filename is trimmed as per draft v1.3
S:=Trim(S);
// strip characters which would be invalid in filenames on Win32 platforms
for i:=length(s)
downto 1
do
if (s[i]
in BadChars)
then Delete(S,i,1);
// make sure the filename is of a sane length
if (Length(S)>100)
then
begin
Ext:=getExtension(S);
if (Ext<>'
')
then
begin
If (Length(Ext)>100)
then begin
Ext:= copy(Ext,Length(Ext) - 99,100);
// Ext:=Copy(Ext,1,100);
End;
S:=copy(S,Length(S) - 99,100-Length(Ext)) + Ext;
// S:=Copy(S,1,100-Length(Ext)) + Ext;
end
else
S:=copy(S,Length(S) - 99,100);
// S:=Copy(S,1,100);
end;
Result:=S;
end;
function TyDecoder.parseKeywords(kwd: AnsiString): PKeyword;
Var
Keyword: PKeyword;
Tok,KeywordStr: AnsiString;
pName: Integer;
begin
new(Keyword);
With Keyword^
Do
begin
TypicalLine:=-1;
Size:=-1;
Filename:='
';
CRC32:=-1;
TotalParts:=-1;
PartNo:=-1;
PartCRC32:=-1;
PartBegin:=-1;
PartEnd:=-1;
KeywordType:=kwdUnknown;
end;
pName:=Pos('
name=',kwd);
if (pName>0)
then
begin
Keyword.Filename:=SafeFilename(Copy(kwd,pName+5,Length(kwd)-pName-4));
SetLength(kwd,pName-1);
end
else
Keyword.Filename:='
';
kwd:=trim(kwd);
if copy(kwd,1,7)='
ybegin '
then Keyword^.KeywordType:=kwdBegin
else if copy(kwd,1,5)='
yend '
then Keyword^.KeywordType:=kwdEnd
else if copy(kwd,1,6)='
ypart '
then Keyword^.KeywordType:=kwdPart
else
begin
DebugMessage('
Unknown keyword line: '+kwd);
Keyword^.KeywordType:=kwdUnknown;
Result:=Keyword;
exit;
end;
Delete(kwd,1,Pos('
',kwd));
kwd:=Trim(kwd)+#32;
While Pos('
',kwd)>0
do
begin
Tok:=strToken(kwd);
KeywordStr:=strSplit(Tok);
With Keyword^
Do
if (KeywordStr='
begin')
then
PartBegin:=StrToIntDef(Tok,-1)
else if (KeywordStr='
end')
then
PartEnd:=StrToIntDef(Tok,-1)
else if (KeywordStr='
line')
then
TypicalLine:=StrToIntDef(Tok,-1)
else if (KeywordStr='
size')
then
Size:=StrToIntDef(Tok,-1)
else if (KeywordStr='
part')
then
PartNo:=StrToIntDef(Tok,-1)
else if (KeywordStr='
total')
then
TotalParts:=StrToIntDef(Tok,-1)
else if (KeywordStr='
crc32')
then
CRC32:=StrToIntDef('
$'+Tok,-1)
else if (KeywordStr='
pcrc32')
then
PartCRC32:=StrToIntDef('
$'+Tok,-1)
{$IFDEF Debug}
else
begin
DebugMessage(Format('
Unknown keyword: %s=%s',[KeywordStr,Tok]))
end;
{$ENDIF} ;
end;
with Keyword^
do
if (KeywordType=kwdBegin)
and (TypicalLine<0)
and (Size<0)
and (Filename='
')
then
begin
// as per draft v1.3, if the ybegin line doesn't contain "line=", "size=", or "name=",
// then it must be ignored
DebugMessage('
Invalid ybegin line: '+kwd);
KeywordType:=kwdUnknown;
Result:=Keyword;
exit;
end;
Result:=Keyword;
end;
procedure TyDecoder.ResetProperties;
begin
FMultiPart:=False;
FFileCorrupt:=False;
FFilename:='
';
FPartNo:=-1;
FTotalParts:=-1;
FPartCRC32:=-1;
FCalcPartCRC32:=-1;
FPartSize:=-1;
FFileCRC32:=-1;
FCalcFileCRC32:=-1;
FFileSize:=-1;
end;
function TyDecoder.findKeywordEscape(pStart,pEnd: PByte): PByte;
begin
while (
Not ((pStart^=CH_ESC)
and (pByte(Integer(pStart)+1)^=Ord('
y'))))
and (Integer(pStart)<Integer(pEnd))
do Inc(pStart);
Result:=pStart;
end;
function TyDecoder.findCRLF(pStart,pEnd: PByte): PByte;
begin
while (
Not (((pStart^=13)
and (pByte(Integer(pStart)+1)^=10))
or (pStart^=10)))
and (Integer(pStart)<Integer(pEnd))
do Inc(pStart);
// while (Not (((pStart^=13) and (pByte(Integer(pStart)+1)^=10)))) and (Integer(pStart)<Integer(pEnd)) do Inc(pStart);
Result:=pStart;
end;
// writes the contents of the output buffer to disk and moves the output
// pointer to the beginning of the buffer
procedure TyDecoder.FlushOutputBuffer;
var NW: Integer;
begin
if not ofopen
then exit;
{$IFDEF Debug}
DebugMessage(Format('
FlushOutputBuffer() before write: fp@%d',[FilePos(OutputFile)]));
{$ENDIF}
TEncoding.ANSI;
BlockWrite(OutputFile,OutputBuf^,Integer(O)-Integer(OutputBuf),NW);
FCalcPartCRC32:=CalcCRC32PKZip(FCalcPartCRC32,OutputBuf,Integer(O)-Integer(OutputBuf));
FCalcFileCRC32:=CalcCRC32PKZip(FCalcFileCRC32,OutputBuf,Integer(O)-Integer(OutputBuf));
{$IFDEF Debug}
DebugMessage(Format('
FlushOutputBuffer() wrote %d bytes: fp@%d',[NW,FilePos(OutputFile)]));
{$ENDIF}
O:=OutputBuf;
end;
// decodes the buffer starting at pStart; returns a pByte pointing to the first
// ESC+y character combination found, or pEnd if no ESC+y is found
function TyDecoder.decodeBuffer(pStart,pEnd: pByte): pByte;
var
I: pByte;
KeywordFound: Boolean;
n: Integer;
Tmp: TKeywordType;
begin
I:=pStart;
KeywordFound:=False;
DebugMessage(Format('
decodeBuffer(%d,%d)',[Integer(pStart),Integer(pEnd)]));
repeat
case I^
of
CH_ESC: Escaped:=True;
CH_CR,CH_LF: ;
else
begin
if Escaped
then
begin
Escaped:=False;
if (I^=Ord('
y'))
then
begin
KeywordFound:=True;
Dec(I);
end
else
begin
O^:=I^-64-42;
if O=OutputBufEnd
then FlushOutputBuffer;
Inc(O);
end;
end
else
begin
O^:=I^-42;
if O=OutputBufEnd
then FlushOutputBuffer;
Inc(O);
end;
end;
end;
inc(I);
if (Assigned(FOnProgress))
and (Integer(I)
mod 150000=0)
then
begin
Abort:=False;
n:=InputBlockNo*InputBufferSize;
if n>InputFileSize
then n:=InputFileSize;
FOnProgress(Self,Trunc(n/InputFileSize*100),Abort);
if Abort
then
begin
Result:=I;
DebugMessage('
user abort');
for tmp:=low(TKeywordType)
To high(TKeywordType)
do
if Assigned(Keyword[tmp])
then
begin
Dispose(Keyword[tmp]);
Keyword[Tmp]:=nil;
end;
if ifopen
then CloseFile(InputFile); ifopen:=false;
if ofopen
then CloseFile(OutputFile); ofopen:=false;
FreeMem(InputBuf);
FreeMem(OutputBuf);
Exit;
end;
end;
Until KeywordFound
or (Integer(I)>Integer(pEnd));
Dec(I);
FlushOutputBuffer;
Result:=I;
end;
// Seek to the specified Position in the output file. If Position is greater
// than the file's current size, pad the file with null bytes until it reaches
// Position bytes.
procedure TyDecoder.SeekOutput(Position: Integer);
var
TempBuf: pByte;
BufferSize,FillRequired,WriteSize: Integer;
FSO: Integer;
begin
DebugMessage(Format('
SeekOutput(%d)',[Position]));
Dec(Position);
FSO:=System.FileSize(OutputFile);
if Position>FSO
then
begin
BufferSize:=TEMP_BUFFER_KB*1024;
GetMem(TempBuf,BufferSize);
FillChar(TempBuf^,BufferSize,0);
FillRequired:=Position-FSO;
Seek(OutputFile,FSO);
Repeat
WriteSize:=BufferSize;
if WriteSize>FillRequired
then WriteSize:=FillRequired;
BlockWrite(OutputFile,TempBuf^,WriteSize);
FillRequired:=FillRequired-WriteSize;
Until FillRequired<=0;
FreeMem(TempBuf);
DebugMessage(Format('
pad %d : %d (%d bytes)',[FSO,FilePos(OutputFile),FilePos(OutputFile)-FSO]));
end
else
begin
Seek(OutputFile,Position);
DebugMessage(Format('
seek: %d',[FilePos(OutputFile)]));
end;
end;
procedure TyDecoder.OpenOutputFile(PK: PKeyword);
begin
if (PK^.Filename<>'
')
and (ofFilename<>PK^.Filename)
then
begin
if (ofFilename<>'
')
then
begin
DebugMessage(Format('
OpenOutputFile: preclosing %s',[ofFilename]));
if ofopen
then CloseFile(OutputFile); ofopen:=false;
end;
if (FOutputPath<>'
')
and (FOutputPath[Length(FOutputPath)]<>PathSep)
then
FOutputPath:=FOutputPath+PathSep;
FOutputFilename:=FOutputPath+PK^.Filename;
ofFilename:=PK^.Filename;
{$IFDEF Debug}
DebugMessage(Format('
OpenOutputFile(%s)',[FOutputFilename]));
{$ENDIF}
AssignFile(OutputFile,FOutputFilename);
try
if FileExists(FOutputFilename)
then
Reset(OutputFile,1)
else
ReWrite(OutputFile,1);
except
raise EyDecoder.Create(Format(EyDecFileCreateFail,[FOutputFilename]));
end;
ofopen:=true;
end
else
DebugMessage(Format('
OpenOutputFile(): no action',[]));
if PK^.PartBegin>-1
then
begin
SeekOutput(PK^.PartBegin);
end;
end;
procedure TyDecoder.CheckKeywords;
var i: TKeywordType;
begin
FCorruptReason:='
';
FFileCorrupt:=False;
if (Keywords=0)
then exit;
// don't bother if no headers were found
// go thru the headers we collected, and grab all the info we can find
for i:=low(TKeywordType)
to high(TKeywordType)
do
if Assigned(Keyword[i])
then
With Keyword[i]^
do
begin
if Filename<>'
'
then FFilename:=Filename;
if PartNo>=0
then begin FMultiPart:=True; FPartNo:=PartNo;
end;
if TotalParts>=0
then begin FMultiPart:=True; FTotalParts:=TotalParts;
end;
if PartCRC32<>-1
then FPartCRC32:=PartCRC32;
if CRC32<>-1
then FFileCRC32:=CRC32;
if (PartBegin>=0)
and (PartEnd>=0)
then FPartSize:=(PartEnd-PartBegin+1);
if (Size>=0)
and (KeywordType=kwdBegin)
then FFileSize:=Size;
if PartEnd<>-1
then FPartEnd:=PartEnd;
end;
// now, go back thru, and make sure everything's consistent between all the headers - if it's not,
// that means the file is corrupt
for i:=low(TKeywordType)
to high(TKeywordType)
do
if Assigned(Keyword[i])
then
With Keyword[i]^
do
begin
if (PartCRC32<>-1)
and (PartCRC32<>FCalcPartCRC32)
then
begin
FFileCorrupt:=True;
FCorruptReason:='
Inconsistent CRC in part '+IntToStr(FPartNo);
end;
if (
not FMultipart)
and (CRC32<>-1)
and (CRC32<>FFileCRC32)
then
begin
FFileCorrupt:=True;
FCorruptReason:='
Inconsistent file CRC';
end;
if ((PartBegin>=0)
and (PartEnd>=0))
and (FPartSize<>(PartEnd-PartBegin+1))
Then
begin
FFileCorrupt:=True;
FCorruptReason:='
Invalid part length';
end;
if (FPartNo<0)
and (Size>=0)
and (FFileSize<>Size)
Then
begin
FFileCorrupt:=True;
FCorruptReason:='
Invalid file size';
end;
end;
// finally, make sure the original CRC and the CRC we found are the same
// commented for multipart crc
// FCalcPartCRC32:=CalcCRC32PKZip($0,PartStart,Integer(O)-Integer(PartStart));
DebugMessage(Format('
CheckKeywords(): FCalcPartCRC32=(%.8x)',[FCalcPartCRC32]));
if (
not FMultipart)
and (FFileCRC32<>FCalcFileCRC32)
then
begin
FFileCorrupt:=True;
FCorruptReason:='
Bad CRC';
end;
if ((FPartNo>=0)
and (FCalcPartCRC32<>FPartCRC32))
Then
begin
FFileCorrupt:=True;
FCorruptReason:='
Bad CRC in part '+IntToStr(FPartNo);
end;
if (FFileCorrupt)
then
DebugMessage(Format('
CheckKeywords(): setting corrupt (%s)',[FCorruptReason]));
end;
procedure TyDecoder.DecodeFile;
var
LP: AnsiString;
P,EndBuf,KeywordLineEnd: pByte;
PK: PKeyword;
S: AnsiString;
idx: Integer;
FindNextKeyword: Boolean;
PI: PPartInfo;
kw: TKeywordType;
eachFile: Integer;
FoundyEncodedData: Boolean;
begin
Idx:=-1;
Abort:=False;
ResetProperties;
DebugMessage(Format('
DecodeFile() init',[]));
InputBufferSize:=DEFAULT_BUFFER_KB*1024;
OutputBufferSize:=InputBufferSize;
try
GetMem(InputBuf,InputBufferSize);
GetMem(OutputBuf,OutputBufferSize);
except
raise EyDecoder.Create(EyDecOutOfMemory);
end;
DebugMessage(Format('
ibs=(%d) obs=(%d)',[InputBufferSize,OutputBufferSize]));
OutputBufEnd:=PByte(Integer(OutputBuf)+OutputBufferSize);
O:=OutputBuf;
for eachFile:=0
to FInputFileList.Count-1
do
begin
Try
FInputFileName:=FInputFileList[eachFile];
except
Break;
End;
if (FInputFilename='
')
or (
Not FileExists(FInputFilename))
then
raise EyDecoder.Create(Format(EyDecFileNotFound,[FInputFilename]));
DebugMessage(Format('
if=(%s)',[FInputFileName]));
AssignFile(InputFile, FInputFilename);
try
Reset(InputFile,1);
except
raise EyDecoder.Create(Format(EyDecFileNotFound,[FInputFilename]));
end;
if FDecodeToInputFolder
then
FOutputPath:=ExtractFilePath(FInputFileName);
FoundyEncodedData:=False;
ifopen:=true;
InputBlockNo:=0;
InputFileSize:=System.FileSize(InputFile);
DebugMessage(Format('
ifs=(%d)',[InputFileSize]));
if Assigned(FOnProgress)
then
begin
Abort:=False;
FOnProgress(Self,0,Abort);
if Abort
then
begin
if ifopen
then CloseFile(InputFile); ifopen:=false;
FreeMem(InputBuf);
FreeMem(OutputBuf);
Exit;
end;
end;
Escaped:=False;
FindNextKeyword:=True;
Repeat
// read a chunk of data
BlockRead(InputFile,InputBuf^,InputBufferSize,numRead);
Inc(InputBlockNo);
DebugMessage(Format('
read %d bytes, fp@%d',[numRead,FilePos(InputFile)]));
P:=InputBuf;
if numRead=0
then
begin
DebugMessage(Format('
eof detected, bailing',[]));
break;
// bail out if EOF
end;
EndBuf:=PByte(Integer(InputBuf)+numRead-1);
// find the first escape character
// P:=nil;
DebugMessage(Format('
enter decode loop',[]));
Repeat
if FindNextKeyword
then
begin
DebugMessage(Format('
FindNextKeyword ret 1',[]));
P:=findKeywordEscape(P,EndBuf);
if P=EndBuf
then
begin
DebugMessage(Format('
no kwd this buf, next',[]));
Continue;
// no control characters in buffer, load another
end;
// find the end of the keyword line
KeywordLineEnd:=findCRLF(P,EndBuf);
// if the end of the keyword line turns out to be the end of the buffer,
// then the keyword line probably extends to the next buffer -- UNLESS
// we're at the end of the file, in which case the keyword line probably
// just wasn't terminated with a CRLF
if (Integer(KeywordLineEnd)>=Integer(EndBuf))
and (numRead=InputBufferSize)
then
begin
DebugMessage(Format('
buf ends mid-keyword',[]));
// in the rare event that the buffer ends in the middle of the keyword line,
// reload the buffer starting from the beginning of the keyword line.
Seek(InputFile,FilePos(InputFile)-numRead+(Integer(P)-Integer(InputBuf)));
DebugMessage(Format('
reposition to fp@%d',[FilePos(InputFile)]));
Break;
end;
if KeywordLineEnd^=13
then
Dec(KeywordLineEnd);
// get rid of trailing CR
S:=getStr(P,KeywordLineEnd);
// DebugMessage(Format('kwd line: (%s)',[S]));
Delete(S,1,1);
// DebugMessage(S);
PK:=parseKeywords(S);
{
if PK^.KeywordType=kwdUnknown then
begin
P:=KeywordLineEnd; Inc(P);// Inc(P);
DebugMessage(Format('unknown keyword, resuming search from %d',[Integer(P)]));
FindNextKeyword:=True;
Continue;
end;
}
if PK^.KeywordType=kwdBegin
then
for kw:=low(TKeywordType)
to high(TKeywordType)
do
if Assigned(Keyword[kw])
then begin Dispose(Keyword[kw]); Keyword[kw]:=nil;
end;
if Assigned(Keyword[PK^.KeywordType])
then Dispose(Keyword[PK^.KeywordType]);
Keyword[PK^.KeywordType]:=PK;
Inc(Keywords);
Case PK^.KeywordType
of
kwdBegin:
begin
FoundyEncodedData:=True;
FFilename:=PK^.Filename;
FPartNo:=PK^.PartNo;
FTotalParts:=PK^.TotalParts;
FFileSize:=PK^.Size;
FCalcFileCRC32:=0;
// if Trim(FFilename)='' then begin debugmessage('choke!'); exit; end;
{
PartData: TStringList;
TPartInfo = record
TotalParts: Integer;
PartsProcessed: Integer;
PartsCorrupt: Integer;
}
{$IFDEF Debug}
DebugMessage(Format('
ybegin - Size: %d / Part: %d / Total: %d / Line: %d / File: %s',[PK^.Size,PK^.PartNo,PK^.TotalParts,PK^.TypicalLine,PK^.Filename]));
{$ENDIF}
end;
kwdPart:
begin
{$IFDEF Debug}
DebugMessage(Format('
ypart - Begin: %d / End: %d',[PK^.PartBegin,PK^.PartEnd]));
{$ENDIF}
idx:=PartData.IndexOf(FFilename);
if idx=-1
then
begin
idx:=PartData.Add(FFilename);
New(PI);
PartData.Objects[idx]:=TObject(PI);
With PI^
do
begin
TotalParts:=0;
PartsProcessed:=0;
PartsCorrupt:=0;
LastPartProcessed:=False;
ReportedDone:=False;
end;
end
else
PI:=PPartInfo(PartData.Objects[idx]);
with PI^
do
begin
if PartNo>TotalParts
then TotalParts:=FPartNo;
Inc(PartsProcessed);
end;
FCalcPartCRC32:=0;
if Assigned(FOnStartPart)
and (FPartNo>=0)
then
FOnStartPart(Self,FFilename,FPartNo);
end;
kwdEnd:
begin
CheckKeywords;
if (Idx>-1)
then
begin
if (FFileCorrupt)
then Inc(PPartInfo(PartData.Objects[idx])^.PartsCorrupt);
if (FPartEnd=FFileSize)
then
begin
PPartInfo(PartData.Objects[idx])^.LastPartProcessed:=True;
DebugMessage(Format('
this part end (%d) = total file size (%d)',[FPartEnd,FFileSize]));
end;
if Assigned(FOnDonePart)
then
FOnDonePart(Self,FFilename,FPartNo,FFileCorrupt);
if Assigned(FOnDoneDecode)
and
(PPartInfo(PartData.Objects[idx])^.LastPartProcessed)
and
(PPartInfo(PartData.Objects[idx])^.PartsProcessed=PPartInfo(PartData.Objects[idx])^.TotalParts)
then
begin
// DebugMessage('Done!');
DebugMessage(Format('
processed %d parts, assuming done',[PPartInfo(PartData.Objects[idx])^.PartsProcessed]));
FOnDoneDecode(Self,FFilename,FFilesize,FFileCorrupt
or (PPartInfo(PartData.Objects[idx])^.PartsCorrupt>0),(PPartInfo(PartData.Objects[idx])^.PartsProcessed=PPartInfo(PartData.Objects[idx])^.TotalParts));
PPartInfo(PartData.Objects[idx])^.ReportedDone:=True;
end;
PI:=PPartInfo(PartData.Objects[idx]);
if PI^.LastPartProcessed
then
LP:='
Yes'
else
LP:='
No';
{$IFDEF Debug}
DebugMessage(Format('
FILE: %s Part#%d Total: %d Processed: %d Corrupt: %d LastProcessed: %s PartEnd: %d FileSize: %d',[FFilename,FPartNo,PI^.TotalParts,PI^.PartsProcessed,PI^.PartsCorrupt,LP,FPartEnd,FFileSize]));
DebugMessage('
');
DebugMessage(Format('
orig PCRC32: (%.8x) / calc PCRC32=(%.8x) partsize=%d',[FPartCRC32,FCalcPartCRC32,Integer(O)-Integer(PartStart)]));
{$ENDIF}
end
else
begin
if Assigned(FOnDoneDecode)
then
FOnDoneDecode(Self,FFilename,FFilesize,FFileCorrupt,True);
end;
{$IFDEF Debug}
DebugMessage(Format('
yend - Size: %d / Part: %d / PCRC: %.8x / CRC: %.8x',[PK^.Size,PK^.PartNo,PK^.PartCRC32,PK^.CRC32]));
DebugMessage(Format('
orig PCRC32: (%.8x) / calc PCRC32=(%.8x)',[FPartCRC32,FCalcPartCRC32]));
{$ENDIF}
P:=KeywordLineEnd;
if P<>EndBuf
then Inc(P);
FindNextKeyword:=True;
Continue;
end;
end;
P:=KeywordLineEnd;
if (P<>EndBuf)
then Inc(P);
// Inc(P);
OpenOutputFile(PK);
end;
P:=decodeBuffer(P,EndBuf);
if Abort
then Exit;
FindNextKeyword:=(P<>EndBuf);
Until Integer(P)>=Integer(EndBuf);
Until numRead=0;
FlushOutputBuffer;
DebugMessage('
close input file');
if ifopen
then CloseFile(InputFile); ifopen:=false;
// if not data was found in the file...
if not FoundyEncodedData
then
begin
if Assigned(FOnNotice)
then FOnNotice(Self,'
No yEncoded data found in input file: '+FInputFileName);
end
// otherwise, if data WAS found, but we didn't encounter a =yend, this file is corrupt
else if not FindNextKeyword
then
begin
FFileCorrupt:=True;
FCorruptReason:='
Missing end-of-encoded-data marker';
Inc(PPartInfo(PartData.Objects[idx])^.PartsCorrupt);
end;
end;
try
DebugMessage('
close output file');
if ofopen
then CloseFile(OutputFile); ofopen:=false;
except
;
end;
FreeMem(InputBuf);
FreeMem(OutputBuf);
for idx:=PartData.Count-1
DownTo 0
do
begin
if Assigned(FOnDoneDecode)
and (
not PPartInfo(PartData.Objects[idx])^.ReportedDone)
then
begin
FOnDoneDecode(Self,PartData[idx],FFilesize,
(PPartInfo(PartData.Objects[idx])^.PartsCorrupt>0),
(PPartInfo(PartData.Objects[idx])^.LastPartProcessed)
and
(PPartInfo(PartData.Objects[idx])^.PartsProcessed=PPartInfo(PartData.Objects[idx])^.TotalParts)
);
end;
Dispose(PPartInfo(PartData.Objects[idx]));
PartData.Delete(idx);
end;
DebugMessage('
end decode');
ofFilename:='
';
end;
{$IFDEF ActiveX}
function TyDecoder.axGetInputFileList: AnsiString;
var
i: Integer;
begin
Result:='
';
for i:=0
to FInputFileList.Count-1
do
if i=0
then
Result:=FInputFileList[i]
else
Result:=Result+'
;'+FInputFileList[i];
end;
procedure TyDecoder.axSetInputFileList(
const Value: AnsiString);
var
lp,p: Integer;
begin
FInputFileList.Clear;
lp:=1;
p:=1;
while (p<=length(Value))
do
begin
if (Value[p]='
;')
then
begin
FInputFileList.Add(Copy(Value,lp,p-lp));
lp:=p+1;
end;
inc(p);
end;
dec(p);
if (p>0)
and (Value[p]<>'
;')
then
FInputFileList.Add(Copy(Value,lp,p-lp));
end;
{$ENDIF}
end.