|
Registriert seit: 16. Sep 2003 19 Beiträge |
#1
Hallo
ich habe ein kleines Problem. Habe eine Software in Delphi 2007 codiert. Darin nutze ich die Klasse yDecoder. Diese ist für Delphi 7 entworfen also ohne Unicode. Ich kriege es einfach nicht hin diese Klasse so umzustellen, unter xe6, das sie wieder funktioniert. Er lädt die Parts und decodiert auch, aber was da raus kommt ist Datenmüll. Kann mir jemand einen Tip geben, was verändert werden muss ? Habe schon mal alle String auf Ansistring geändert. Leider gibt es von er Klasse nirgens ein Update..
Delphi-Quellcode:
// 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.
-----------------------------------
Madtrax |
Zitat |
Ansicht |
Linear-Darstellung |
Zur Hybrid-Darstellung wechseln |
Zur Baum-Darstellung wechseln |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
LinkBack URL |
About LinkBacks |