AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi yenc Class yDecoder unter Delphi XE6

yenc Class yDecoder unter Delphi XE6

Ein Thema von Madtrax · begonnen am 24. Okt 2018
Antwort Antwort
Madtrax

Registriert seit: 16. Sep 2003
19 Beiträge
 
#1

yenc Class yDecoder unter Delphi XE6

  Alt 24. Okt 2018, 18:45
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
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es 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

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 13:47 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz