diff --git a/.gitattributes b/.gitattributes index 5e7c1fe746..ac9dfe3a23 100644 --- a/.gitattributes +++ b/.gitattributes @@ -54,11 +54,8 @@ components/chmhelp/lhelp/lhelpcore.lfm svneol=native#text/plain components/chmhelp/lhelp/lhelpcore.lrs svneol=native#text/plain components/chmhelp/lhelp/lhelpcore.pas svneol=native#text/plain components/chmhelp/lhelp/lnethttpdataprovider.pas svneol=native#text/plain -components/chmhelp/packages/chm/chmbase.pas svneol=native#text/plain components/chmhelp/packages/chm/chmpkg.lpk svneol=native#text/plain components/chmhelp/packages/chm/chmpkg.pas svneol=native#text/plain -components/chmhelp/packages/chm/chmreader.pas svneol=native#text/plain -components/chmhelp/packages/chm/paslzx.pas svneol=native#text/plain components/chmhelp/packages/help/lhelpcontrol.pas svneol=native#text/plain components/chmhelp/packages/help/lhelpcontrolpkg.lpk svneol=native#text/plain components/chmhelp/packages/help/lhelpcontrolpkg.pas svneol=native#text/plain diff --git a/components/chmhelp/packages/chm/chmbase.pas b/components/chmhelp/packages/chm/chmbase.pas deleted file mode 100644 index e048bf2536..0000000000 --- a/components/chmhelp/packages/chm/chmbase.pas +++ /dev/null @@ -1,203 +0,0 @@ -{ Copyright (C) <2005> chmbase.pas - - This library is free software; you can redistribute it and/or modify it - under the terms of the GNU Library General Public License as published by - the Free Software Foundation; either version 2 of the License, or (at your - option) any later version. - - This program 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 Library General Public License - for more details. - - You should have received a copy of the GNU Library 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. -} -{ - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the copyright. -} -unit chmbase; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils; - -type - {$PACKRECORDS C} - TITSFHeader= record - ITSFsig: array [0..3] of char; - Version: LongWord; - HeaderLength: LongWord; - Unknown_1: LongWord; - TimeStamp: LongWord; //bigendian - LanguageID: LongWord; - Guid1: TGuid; - Guid2: TGuid; - end; - TITSFHeaderEntry = record - PosFromZero: QWord; - Length: QWord; - end; - - //Version 3 has this qword. 2 does not - TITSFHeaderSuffix = record - Offset: QWord; // offset within file of content section 0 - end; - - TITSPHeaderPrefix = record - Unknown1: LongWord;// = $01FE - Unknown2: LongWord;// = 0 - FileSize: QWord; - Unknown3: LongWord;// =0 - Unknown4: LongWord;// =0 - end; - - TITSPHeader = record - ITSPsig: array [0..3] of char; // = 'ITSP' - Version: LongWord; // =1 - DirHeaderLength: Longword; // Length of the directory header - Unknown1: LongWord; // =$0a - ChunkSize: LongWord; // $1000 - Density: LongWord; // usually = 2 - IndexTreeDepth: LongWord;// 1 if there is no index 2 if there is one level of PMGI chunks - IndexOfRootChunk: LongInt;// -1 if no root chunk - FirstPMGLChunkIndex, - LastPMGLChunkIndex: LongWord; - Unknown2: LongInt; // = -1 - DirectoryChunkCount: LongWord; - LanguageID: LongWord; - GUID: TGuid; - LengthAgain: LongWord; //??? $54 - Unknown3: LongInt; // = -1 - Unknown4: LongInt; // = -1 - Unknown5: LongInt; // = -1 - end; - - TPMGchunktype = (ctPMGL, ctPMGI, ctUnknown); - - TPMGListChunk = record - PMGLsig: array [0..3] of char; - UnusedSpace: Longword; ///!!! this value can also represent the size of quickref area in the end of the chunk - Unknown1: Longword; //always 0 - PreviousChunkIndex: LongInt; // chunk number of the prev listing chunk when reading dir in sequence - // (-1 if this is the first listing chunk) - NextChunkIndex: LongInt; // chunk number of the next listing chunk (-1 if this is the last chunk) - end; - - PPMGListChunkEntry = ^TPMGListChunkEntry; - TPMGListChunkEntry = record - //NameLength: LongInt; we don't need this permanantly so I've moved it to a temp var - Name: String; - ContentSection: LongWord;//QWord; - ContentOffset: QWord; - DecompressedLength: QWord; - end; - - TPMGIIndexChunk = record - PMGIsig: array [0..3] of char; - UnusedSpace: LongWord; // has a quickref area - end; - - TPMGIIndexChunkEntry = record - Name: String; - ListingChunk: DWord; - end; - - -const - ITSFHeaderGUID : TGuid = '{7C01FD10-7BAA-11D0-9E0C-00A0C922E6EC}'; - ITSFFileSig: array [0..3] of char = 'ITSF'; - - ITSPHeaderGUID : TGuid = '{5D02926A-212E-11D0-9DF9-00A0C922E6EC}'; - ITSPHeaderSig: array [0..3] of char = 'ITSP'; - - // this function will advance the stream to the end of the compressed integer - // and return the value - function GetCompressedInteger(const Stream: TStream): DWord; - // returns the number of bytes written to the stream - function WriteCompressedInteger(const Stream: TStream; ANumber: DWord): DWord; - function WriteCompressedInteger(Buffer: Pointer; ANumber: DWord): DWord; - - // stupid needed function - function ChmCompareText(S1, S2: String): Integer; inline; - - -implementation - -function GetCompressedInteger(const Stream: TStream): DWord; -var - total: QWord = 0; - temp: Byte; - Sanity: Integer = 0; -begin - try - temp := Stream.ReadByte; - while temp >= $80 do begin - total := total shl 7; - total := total + temp and $7f; - temp := Stream.ReadByte; - Inc(Sanity); - if Sanity > 8 then begin - Result := 0; - Exit; - end; - end; - Result := (total shl 7) + temp; - except - Result := 0; - end; -end; - -// returns how many bytes were written -function WriteCompressedInteger(const Stream: TStream; ANumber: DWord): DWord; -var - Buffer: QWord; // Easily large enough -begin - Result := WriteCompressedInteger(@Buffer, ANumber); - Result := Stream.Write(Buffer, Result); -end; - -// returns how many bytes were written -function WriteCompressedInteger(Buffer: Pointer; ANumber: DWord): DWord; -var - bit: dword; - mask: QWord; - buf: PByte; - Value: DWord = 0; - TheEnd: DWord = 0; -begin - bit := (sizeof(DWord)*8)div 7*7; - buf := @Value; - while True do begin - mask := $7f shl bit; - if (bit = 0) or ((ANumber and mask)<>0) then break; - Dec(bit, 7); - end; - - while True do begin - buf^ := Byte(((ANumber shr bit)and $7f)); - if(bit = 0) then break; - buf^ := buf^ or $80; - Inc(buf); - Dec(bit, 7); - Inc(TheEnd); - end; - - buf := @Value; - Result := TheEnd+1; - Move(Value, Buffer^, Result); -end; - -function ChmCompareText(S1, S2: String): Integer; inline; -begin - // for our purposes the CompareText function will not work. - Result := CompareStr(LowerCase(S1), Lowercase(S2)); -end; - -end. - diff --git a/components/chmhelp/packages/chm/chmpkg.lpk b/components/chmhelp/packages/chm/chmpkg.lpk index a912e91d88..7871b5e3c8 100644 --- a/components/chmhelp/packages/chm/chmpkg.lpk +++ b/components/chmhelp/packages/chm/chmpkg.lpk @@ -1,15 +1,14 @@ + - + + - + - - - @@ -20,14 +19,17 @@ + + + @@ -42,10 +44,11 @@ - + + diff --git a/components/chmhelp/packages/chm/chmreader.pas b/components/chmhelp/packages/chm/chmreader.pas deleted file mode 100644 index cc6212385d..0000000000 --- a/components/chmhelp/packages/chm/chmreader.pas +++ /dev/null @@ -1,1181 +0,0 @@ -{ Copyright (C) <2005> chmreader.pas - - This library is free software; you can redistribute it and/or modify it - under the terms of the GNU Library General Public License as published by - the Free Software Foundation; either version 2 of the License, or (at your - option) any later version. - - This program 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 Library General Public License - for more details. - - You should have received a copy of the GNU Library 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. -} -{ - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the copyright. -} -unit chmreader; - -{$mode objfpc}{$H+} - -//{$DEFINE CHM_DEBUG} -//{$DEFINE CHM_DEBUG_CHUNKS} - -interface - -uses - Classes, SysUtils, FileUtil, chmbase, paslzx; - -type - - TLZXResetTableArr = array of QWord; - - PContextItem = ^TContextItem; - TContextItem = record - Context: THelpContext; - Url: String; - end; - - TContextList = class(TList) - public - procedure AddContext(Context: THelpContext; Url: String); - function GetURL(Context: THelpContext): String; - procedure Clear; override; - end; - { TITSFReader } - - TFileEntryForEach = procedure(Name: String; Offset, UncompressedSize, Section: Integer) of object; - - TITSFReader = class(TObject) - protected - fStream: TStream; - fFreeStreamOnDestroy: Boolean; - fChmHeader: TITSFHeader; - fHeaderSuffix: TITSFHeaderSuffix; - fDirectoryHeader: TITSPHeader; - fDirectoryHeaderPos: Int64; - fDirectoryHeaderLength: QWord; - fDirectoryEntriesStartPos: Int64; - fDirectoryEntries: array of TPMGListChunkEntry; - fCachedEntry: TPMGListChunkEntry; //contains the last entry found by ObjectExists - fDirectoryEntriesCount: LongWord; - private - procedure ReadHeader; - function GetChunkType(Stream: TMemoryStream; ChunkIndex: LongInt): TPMGchunktype; - function GetDirectoryChunk(Index: Integer; OutStream: TStream): Integer; - function ReadPMGLchunkEntryFromStream(Stream: TMemoryStream; var PMGLEntry: TPMGListChunkEntry): Boolean; - function ReadPMGIchunkEntryFromStream(Stream: TMemoryStream; var PMGIEntry: TPMGIIndexChunkEntry): Boolean; - procedure LookupPMGLchunk(Stream: TMemoryStream; out PMGLChunk: TPMGListChunk); - procedure LookupPMGIchunk(Stream: TMemoryStream; out PMGIChunk: TPMGIIndexChunk); - - procedure GetSections(out Sections: TStringList); - function GetBlockFromSection(SectionPrefix: String; StartPos: QWord; BlockLength: QWord): TMemoryStream; - function FindBlocksFromUnCompressedAddr(var ResetTableEntry: TPMGListChunkEntry; - out CompressedSize: Int64; out UnCompressedSize: Int64; out LZXResetTable: TLZXResetTableArr): QWord; // Returns the blocksize - public - constructor Create(AStream: TStream; FreeStreamOnDestroy: Boolean); virtual; - destructor Destroy; override; - public - ChmLastError: LongInt; - function IsValidFile: Boolean; - procedure GetCompleteFileList(ForEach: TFileEntryForEach); - function ObjectExists(Name: String): QWord; // zero if no. otherwise it is the size of the object - // NOTE directories will return zero size even if they exist - function GetObject(Name: String): TMemoryStream; // YOU must Free the stream - end; - - { TChmReader } - - TChmReader = class(TITSFReader) - protected - fDefaultPage: String; - fIndexFile: String; - fTOCFile: String; - fTitle: String; - fPreferedFont: String; - fContextList: TContextList; - fLocaleID: DWord; - private - procedure ReadCommonData; - public - constructor Create(AStream: TStream; FreeStreamOnDestroy: Boolean); override; - destructor Destroy; override; - public - function GetContextUrl(Context: THelpContext): String; - function HasContextList: Boolean; - property DefaultPage: String read fDefaultPage; - property IndexFile: String read fIndexFile; - property TOCFile: String read fTOCFile; - property Title: String read fTitle write fTitle; - property PreferedFont: String read fPreferedFont; - property LocaleID: dword read fLocaleID; - end; - - { TChmFileList } - TChmFileList = class; - TChmFileOpenEvent = procedure(ChmFileList: TChmFileList; Index: Integer) of object; - TChmFileList = class(TStringList) - protected - fLastChm: TChmReader; - fUnNotifiedFiles: TList; - fOnOpenNewFile: TChmFileOpenEvent; - procedure Delete(Index: Integer); override; - function GetChm(AIndex: Integer): TChmReader; - function GetFileName(AIndex: Integer): String; - procedure OpenNewFile(AFileName: String); - function CheckOpenFile(AFileName: String): Boolean; - function MetaObjectExists(var Name: String): QWord; - function MetaGetObject(Name: String): TMemoryStream; - procedure SetOnOpenNewFile(AValue: TChmFileOpenEvent); - public - constructor Create(PrimaryFileName: String); - destructor Destroy; override; - function GetObject(Name: String): TMemoryStream; - function IsAnOpenFile(AFileName: String): Boolean; - function ObjectExists(Name: String; fChm: TChmReader = nil): QWord; - //properties - property Chm[Index: Integer]: TChmReader read GetChm; - property FileName[Index: Integer]: String read GetFileName; - property OnOpenNewFile: TChmFileOpenEvent read fOnOpenNewFile write SetOnOpenNewFile; - end; - -//ErrorCodes -const - ERR_NO_ERR = 0; - ERR_STREAM_NOT_ASSIGNED = 1; - ERR_NOT_SUPPORTED_VERSION = 2; - ERR_NOT_VALID_FILE = 3; - ERR_UNKNOWN_ERROR = 10; - - function ChmErrorToStr(Error: Integer): String; - -implementation - -function ChmErrorToStr(Error: Integer): String; -begin - Result := ''; - case Error of - ERR_STREAM_NOT_ASSIGNED : Result := 'ERR_STREAM_NOT_ASSIGNED'; - ERR_NOT_SUPPORTED_VERSION : Result := 'ERR_NOT_SUPPORTED_VERSION'; - ERR_NOT_VALID_FILE : Result := 'ERR_NOT_VALID_FILE'; - ERR_UNKNOWN_ERROR : Result := 'ERR_UNKNOWN_ERROR'; - end; -end; - -function ChunkType(Stream: TMemoryStream): TPMGchunktype; -var - ChunkID: array[0..3] of char; -begin - Result := ctUnknown; - if Stream.Size< 4 then exit; - Move(Stream.Memory^, ChunkId[0], 4); - if ChunkID = 'PMGL' then Result := ctPMGL - else if ChunkID = 'PMGI' then Result := ctPMGI; -end; - -{ TITSFReader } - -procedure TITSFReader.ReadHeader; -var -fHeaderEntries: array [0..1] of TITSFHeaderEntry; -begin - fStream.Position := 0; - fStream.Read(fChmHeader,SizeOf(fChmHeader)); - - // Fix endian issues - {$IFDEF ENDIAN_BIG} - fChmHeader.Version := LEtoN(fChmHeader.Version); - fChmHeader.HeaderLength := LEtoN(fChmHeader.HeaderLength); - //Unknown_1 - fChmHeader.TimeStamp := BEtoN(fChmHeader.TimeStamp);//bigendian - fChmHeader.LanguageID := LEtoN(fChmHeader.LanguageID); - //Guid1 - //Guid2 - {$ENDIF} - - if not IsValidFile then Exit; - - // Copy EntryData into memory - fStream.Read(fHeaderEntries[0], SizeOf(fHeaderEntries)); - - if fChmHeader.Version > 2 then - fStream.Read(fHeaderSuffix.Offset, SizeOf(QWord)); - fHeaderSuffix.Offset := LEtoN(fHeaderSuffix.Offset); - // otherwise this is set in fill directory entries - - fStream.Position := LEtoN(fHeaderEntries[1].PosFromZero); - fDirectoryHeaderPos := LEtoN(fHeaderEntries[1].PosFromZero); - fStream.Read(fDirectoryHeader, SizeOf(fDirectoryHeader)); - {$IFDEF ENDIAN_BIG} - with fDirectoryHeader do begin - Version := LEtoN(Version); - DirHeaderLength := LEtoN(DirHeaderLength); - //Unknown1 - ChunkSize := LEtoN(ChunkSize); - Density := LEtoN(Density); - IndexTreeDepth := LEtoN(IndexTreeDepth); - IndexOfRootChunk := LEtoN(IndexOfRootChunk); - FirstPMGLChunkIndex := LEtoN(FirstPMGLChunkIndex); - LastPMGLChunkIndex := LEtoN(LastPMGLChunkIndex); - //Unknown2 - DirectoryChunkCount := LEtoN(DirectoryChunkCount); - LanguageID := LEtoN(LanguageID); - //GUID: TGuid; - LengthAgain := LEtoN(LengthAgain); - end; - {$ENDIF} - {$IFDEF CHM_DEBUG} - WriteLn('PMGI depth = ', fDirectoryHeader.IndexTreeDepth); - WriteLn('PMGI Root = ', fDirectoryHeader.IndexOfRootChunk); - {$ENDIF} - fDirectoryEntriesStartPos := fStream.Position; - fDirectoryHeaderLength := LEtoN(fHeaderEntries[1].Length); -end; - -procedure TChmReader.ReadCommonData; - // A little helper proc to make reading a null terminated string easier - function ReadString(const Stream: TStream): String; - var - buf: array[0..49] of char; - begin - Result := ''; - repeat - Stream.Read(buf, 50); - Result := Result + buf; - until Pos(#0, buf) > -1; - end; - procedure ReadFromSystem; - var - //Version: DWord; - EntryType: Word; - EntryLength: Word; - Data: array[0..511] of char; - fSystem: TMemoryStream; - Tmp: String; - begin - fSystem := TMemoryStream(GetObject('/#SYSTEM')); - if fSystem = nil then begin - exit; - end; - fSystem.Position := 0; - if fSystem.Size < SizeOf(DWord) then begin - fSystem.Free; - Exit; - end; - {Version := }LEtoN(fSystem.ReadDWord); - while fSystem.Position < fSystem.Size do begin - EntryType := LEtoN(fSystem.ReadWord); - EntryLength := LEtoN(fSystem.ReadWord); - case EntryType of - 0: // Table of contents - begin - if EntryLength > 511 then EntryLength := 511; - fSystem.Read(Data[0], EntryLength); - Data[EntryLength] := #0; - fTOCFile := '/'+Data; - end; - 1: // Index File - begin - if EntryLength > 511 then EntryLength := 511; - fSystem.Read(Data[0], EntryLength); - Data[EntryLength] := #0; - fIndexFile := '/'+Data; - end; - 2: // DefaultPage - begin - if EntryLength > 511 then EntryLength := 511; - fSystem.Read(Data[0], EntryLength); - Data[EntryLength] := #0; - fDefaultPage := '/'+Data; - end; - 3: // Title of chm - begin - if EntryLength > 511 then EntryLength := 511; - fSystem.Read(Data[0], EntryLength); - Data[EntryLength] := #0; - fTitle := Data; - end; - 4: // Locale ID - begin - fLocaleID := LEtoN(fSystem.ReadDWord); - fSystem.Position := (fSystem.Position + EntryLength) - SizeOf(DWord); - end; - 6: // chm file name. use this to get the index and toc name - begin - if EntryLength > 511 then EntryLength := 511; - fSystem.Read(Data[0], EntryLength); - Data[EntryLength] := #0; - if (fIndexFile = '') then begin - Tmp := '/'+Data+'.hhk'; - if (ObjectExists(Tmp) > 0) then begin - fIndexFile := Tmp; - end - end; - if (fTOCFile = '') then begin - Tmp := '/'+Data+'.hhc'; - if (ObjectExists(Tmp) > 0) then begin - fTOCFile := Tmp; - end; - end; - end; - 16: // Prefered font - begin - if EntryLength > 511 then EntryLength := 511; - fSystem.Read(Data[0], EntryLength); - Data[EntryLength] := #0; - fPreferedFont := Data; - end; - else - // Skip entries we are not interested in - fSystem.Position := fSystem.Position + EntryLength; - end; - end; - fSystem.Free; - end; - procedure ReadFromWindows; - var - fWindows, - fStrings: TMemoryStream; - EntryCount, - EntrySize: DWord; - EntryStart: Int64; - StrPosition: DWord; - X: Integer; - OffSet: Int64; - begin - fWindows := TMemoryStream(GetObject('/#WINDOWS')); - if fWindows = nil then begin - exit; - end; - fStrings := TMemoryStream(GetObject('/#STRINGS')); - if fStrings = nil then begin - if fWindows <> nil then fWindows.Free; - Exit; - end; - fWindows.Position := 0; - if (fWindows.Size = 0) or (fStrings.Size = 0) then begin - fWindows.Free; - fStrings.Free; - Exit; - end; - EntryCount := LEtoN(fWindows.ReadDWord); - EntrySize := LEtoN(fWindows.ReadDWord); - OffSet := fWindows.Position; - for X := 0 to EntryCount -1 do begin - EntryStart := OffSet + (X*EntrySize); - if fTitle = '' then begin - fWindows.Position := EntryStart + $14; - StrPosition := LEtoN(fWindows.ReadDWord); - fStrings.Position := StrPosition; - fTitle := '/'+ReadString(fStrings); - end; - if fTOCFile = '' then begin - fWindows.Position := EntryStart + $60; - StrPosition := LEtoN(fWindows.ReadDWord); - fStrings.Position := StrPosition; - fTOCFile := '/'+ReadString(fStrings); - end; - if fIndexFile = '' then begin - fWindows.Position := EntryStart + $64; - StrPosition := LEtoN(fWindows.ReadDWord); - fStrings.Position := StrPosition; - fIndexFile := '/'+ReadString(fStrings); - end; - if fDefaultPage = '' then begin - fWindows.Position := EntryStart + $68; - StrPosition := LEtoN(fWindows.ReadDWord); - fStrings.Position := StrPosition; - fDefaultPage := '/'+ReadString(fStrings); - end; - end; - end; - procedure ReadContextIds; - var - fIVB, - fStrings: TStream; - Str: String; - Value: DWord; - OffSet: DWord; - //TotalSize: DWord; - begin - fIVB := GetObject('/#IBV'); - if fIVB = nil then Exit; - fStrings := GetObject('/#STRINGS'); - if fStrings = nil then begin - fIVB.Free; - Exit; - end; - fIVB.Position := 0; - {TotalSize := }LEtoN(fIVB.ReadDWord); - while fIVB.Position < fIVB.Size do begin - Value := LEtoN(fIVB.ReadDWord); - OffSet := LEtoN(fIVB.ReadDWord); - fStrings.Position := Offset; - Str := '/'+ReadString(fStrings); - fContextList.AddContext(Value, Str); - end; - end; -begin - ReadFromSystem; - ReadFromWindows; - ReadContextIds; - {$IFDEF CHM_DEBUG} - WriteLn('TOC=',fTocfile); - WriteLn('DefaultPage=',fDefaultPage); - {$ENDIF} -end; - -constructor TChmReader.Create(AStream: TStream; FreeStreamOnDestroy: Boolean); -begin - inherited Create(AStream, FreeStreamOnDestroy); - if not IsValidFile then exit; - - fContextList := TContextList.Create; - ReadCommonData; -end; - -destructor TChmReader.Destroy; -begin - fContextList.Free; - inherited Destroy; -end; - -function TITSFReader.GetChunkType(Stream: TMemoryStream; ChunkIndex: LongInt): TPMGchunktype; -var - Sig: array[0..3] of char; -begin - Result := ctUnknown; - Stream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * ChunkIndex); - - Stream.Read(Sig, 4); - if Sig = 'PMGL' then Result := ctPMGL - else if Sig = 'PMGI' then Result := ctPMGI; -end; - -function TITSFReader.GetDirectoryChunk(Index: Integer; OutStream: TStream): Integer; -begin - Result := Index; - fStream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * Index); - OutStream.Position := 0; - OutStream.Size := fDirectoryHeader.ChunkSize; - OutStream.CopyFrom(fStream, fDirectoryHeader.ChunkSize); - OutStream.Position := 0; -end; - -procedure TITSFReader.LookupPMGLchunk(Stream: TMemoryStream; out PMGLChunk: TPMGListChunk); -begin - //Stream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * ChunkIndex); - Stream.Read(PMGLChunk, SizeOf(PMGLChunk)); - {$IFDEF ENDIAN_BIG} - with PMGLChunk do begin - UnusedSpace := LEtoN(UnusedSpace); - //Unknown1 - PreviousChunkIndex := LEtoN(PreviousChunkIndex); - NextChunkIndex := LEtoN(NextChunkIndex); - end; - {$ENDIF} -end; - -function TITSFReader.ReadPMGLchunkEntryFromStream(Stream: TMemoryStream; var PMGLEntry: TPMGListChunkEntry): Boolean; -var -Buf: array [0..1023] of char; -NameLength: LongInt; -begin - Result := False; - //Stream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * ChunkIndex); - NameLength := LongInt(GetCompressedInteger(Stream)); - - if NameLength > 1022 then NameLength := 1022; - Stream.Read(buf[0], NameLength); - buf[NameLength] := #0; - PMGLEntry.Name := buf; - PMGLEntry.ContentSection := LongWord(GetCompressedInteger(Stream)); - PMGLEntry.ContentOffset := GetCompressedInteger(Stream); - PMGLEntry.DecompressedLength := GetCompressedInteger(Stream); - if NameLength = 0 then Exit; // failed GetCompressedInteger sanity check - Result := True; -end; - -procedure TITSFReader.LookupPMGIchunk(Stream: TMemoryStream; out PMGIChunk: TPMGIIndexChunk); -begin - //Stream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * ChunkIndex); - Stream.Read(PMGIChunk, SizeOf(PMGIChunk)); - {$IFDEF ENDIAN_BIG} - with PMGIChunk do begin - UnusedSpace := LEtoN(UnusedSpace); - end; - {$ENDIF} -end; - -function TITSFReader.ReadPMGIchunkEntryFromStream(Stream: TMemoryStream; - var PMGIEntry: TPMGIIndexChunkEntry): Boolean; -var -Buf: array [0..1023] of char; -NameLength: LongInt; -begin - Result := False; - //Stream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * ChunkIndex); - NameLength := LongInt(GetCompressedInteger(Stream)); - if NameLength > 1023 then NameLength := 1023; - Stream.Read(buf, NameLength); - - buf[NameLength] := #0; - PMGIEntry.Name := buf; - - PMGIEntry.ListingChunk := GetCompressedInteger(Stream); - if NameLength = 0 then Exit; // failed GetCompressedInteger sanity check - Result := True; -end; - -constructor TITSFReader.Create(AStream: TStream; FreeStreamOnDestroy: Boolean); -begin - fStream := AStream; - fFreeStreamOnDestroy := FreeStreamOnDestroy; - ReadHeader; - if not IsValidFile then Exit; -end; - -destructor TITSFReader.Destroy; -begin - SetLength(fDirectoryEntries, 0); - if fFreeStreamOnDestroy then FreeAndNil(fStream); - - inherited Destroy; -end; - -function TITSFReader.IsValidFile: Boolean; -begin - if (fStream = nil) then ChmLastError := ERR_STREAM_NOT_ASSIGNED - else if (fChmHeader.ITSFsig <> 'ITSF') then ChmLastError := ERR_NOT_VALID_FILE - else if (fChmHeader.Version <> 2) and (fChmHeader.Version <> 3) then - ChmLastError := ERR_NOT_SUPPORTED_VERSION; - Result := ChmLastError = ERR_NO_ERR; -end; - -procedure TITSFReader.GetCompleteFileList(ForEach: TFileEntryForEach); -var - ChunkStream: TMemoryStream; - I : Integer; - Entry: TPMGListChunkEntry; - PMGLChunk: TPMGListChunk; - CutOffPoint: Integer; - NameLength: Integer; - {$IFDEF CHM_DEBUG_CHUNKS} - PMGIChunk: TPMGIIndexChunk; - PMGIndex: Integer; - {$ENDIF} -begin - if ForEach = nil then Exit; - ChunkStream := TMemoryStream.Create; - for I := 0 to fDirectoryHeader.DirectoryChunkCount-1 do begin - GetDirectoryChunk(I, ChunkStream); - case ChunkType(ChunkStream) of - ctPMGL: - begin - LookupPMGLchunk(ChunkStream, PMGLChunk); - {$IFDEF CHM_DEBUG_CHUNKS} - WriteLn('PMGL: ', I, ' Prev PMGL: ', PMGLChunk.PreviousChunkIndex, ' Next PMGL: ', PMGLChunk.NextChunkIndex); - {$ENDIF} - CutOffPoint := ChunkStream.Size - PMGLChunk.UnusedSpace - 10; - while ChunkStream.Position < CutOffPoint do begin - NameLength := GetCompressedInteger(ChunkStream); - SetLength(Entry.Name, NameLength); - ChunkStream.ReadBuffer(Entry.Name[1], NameLength); - if (Entry.Name = '') or (ChunkStream.Position > CutOffPoint) then - Continue; // we have entered the quickref section - Entry.ContentSection := GetCompressedInteger(ChunkStream); - Entry.ContentOffset := GetCompressedInteger(ChunkStream); - Entry.DecompressedLength := GetCompressedInteger(ChunkStream); - fCachedEntry := Entry; // if the caller trys to get this data we already know where it is :) - ForEach(Entry.Name, Entry.ContentOffset, Entry.DecompressedLength, Entry.ContentSection); - end; - end; - {$IFDEF CHM_DEBUG_CHUNKS} - ctPMGI: - begin - WriteLn('PMGI: ', I); - LookupPMGIchunk(ChunkStream, PMGIChunk); - CutOffPoint := ChunkStream.Size - PMGIChunk.UnusedSpace - 10; - while ChunkStream.Position < CutOffPoint do begin - NameLength := GetCompressedInteger(ChunkStream); - SetLength(Entry.Name, NameLength); - ChunkStream.ReadBuffer(Entry.Name[1], NameLength); - PMGIndex := GetCompressedInteger(ChunkStream); - WriteLn(Entry.Name, ' ', PMGIndex); - end; - end; - ctUnknown: WriteLn('UNKNOWN CHUNKTYPE!' , I); - {$ENDIF} - end; - end; -end; - -function TITSFReader.ObjectExists(Name: String): QWord; -var - ChunkStream: TMemoryStream; - QuickRefCount: Word; - QuickRefIndex: array of Word; - ItemCount: Integer; - procedure ReadQuickRefSection; - var - OldPosn: Int64; - Posn: Integer; - I: Integer; - begin - OldPosn := ChunkStream.Position; - Posn := ChunkStream.Size-1-SizeOf(Word); - ChunkStream.Position := Posn; - - ItemCount := LEToN(ChunkStream.ReadWord); - //WriteLn('Max ITems for next block = ', ItemCount-1); - QuickRefCount := ItemCount div (1 + (1 shl fDirectoryHeader.Density)); - //WriteLn('QuickRefCount = ' , QuickRefCount); - SetLength(QuickRefIndex, QuickRefCount+1); - for I := 1 to QuickRefCount do begin - Dec(Posn, SizeOf(Word)); - ChunkStream.Position := Posn; - QuickRefIndex[I] := LEToN(ChunkStream.ReadWord); - end; - Inc(QuickRefCount); - ChunkStream.Position := OldPosn; - end; - function ReadString(StreamPosition: Integer = -1): String; - var - NameLength: Integer; - begin - if StreamPosition > -1 then ChunkStream.Position := StreamPosition; - - NameLength := GetCompressedInteger(ChunkStream); - SetLength(Result, NameLength); - ChunkStream.Read(Result[1], NameLength); - end; -var - PMGLChunk: TPMGListChunk; - PMGIChunk: TPMGIIndexChunk; - //ChunkStream: TMemoryStream; declared above - Entry: TPMGListChunkEntry; - NextIndex: Integer; - EntryName: String; - CRes: Integer; - I: Integer; -begin - Result := 0; - - if Name = '' then Exit; - if fDirectoryHeader.DirectoryChunkCount = 0 then exit; - - //WriteLn('Looking for ', Name); - if Name = fCachedEntry.Name then - Exit(fCachedEntry.DecompressedLength); // we've already looked it up - - ChunkStream := TMemoryStream.Create; - - try - - NextIndex := fDirectoryHeader.IndexOfRootChunk; - if NextIndex < 0 then NextIndex := 0; // no PMGI chunks - - while NextIndex > -1 do begin - GetDirectoryChunk(NextIndex, ChunkStream); - NextIndex := -1; - ReadQuickRefSection; - //WriteLn('In Block ', ChunkIndex); - case ChunkType(ChunkStream) of - ctUnknown: // something is wrong - begin - {$IFDEF CHM_DEBUG}WriteLn(ChunkIndex, ' << Unknown BlockType!');{$ENDIF} - Break; - end; - ctPMGI: // we must follow the PMGI tree until we reach a PMGL block - begin - LookupPMGIchunk(ChunkStream, PMGIChunk); - - //QuickRefIndex[0] := ChunkStream.Position; - - I := 0; - while ChunkStream.Position <= ChunkStream.Size - PMGIChunk.UnusedSpace do begin; - EntryName := ReadString; - if EntryName = '' then break; - if ChunkStream.Position >= ChunkStream.Size - PMGIChunk.UnusedSpace then break; - CRes := ChmCompareText(Name, EntryName); - if CRes = 0 then begin - // no more need of this block. onto the next! - NextIndex := GetCompressedInteger(ChunkStream); - Continue; - end; - if CRes < 0 then begin - if I = 0 then Break; // File doesn't exist - // file is in previous entry - Break; - end; - NextIndex := GetCompressedInteger(ChunkStream); - Inc(I); - end; - end; - ctPMGL: - begin - LookupPMGLchunk(ChunkStream, PMGLChunk); - QuickRefIndex[0] := ChunkStream.Position; - I := 0; - while ChunkStream.Position <= ChunkStream.Size - PMGLChunk.UnusedSpace do begin - // we consume the entry by reading it - Entry.Name := ReadString; - if Entry.Name = '' then break; - if ChunkStream.Position >= ChunkStream.Size - PMGLChunk.UnusedSpace then break; - - Entry.ContentSection := GetCompressedInteger(ChunkStream); - Entry.ContentOffset := GetCompressedInteger(ChunkStream); - Entry.DecompressedLength := GetCompressedInteger(ChunkStream); - - CRes := ChmCompareText(Name, Entry.Name); - if CRes = 0 then begin - fCachedEntry := Entry; - Result := Entry.DecompressedLength; - Break; - end; - Inc(I); - end; - end; // case - end; - end; - finally - ChunkStream.Free; - end; -end; - -function TITSFReader.GetObject(Name: String): TMemoryStream; -var - SectionNames: TStringList; - Entry: TPMGListChunkEntry; - SectionName: String; -begin - Result := nil; - if ObjectExists(Name) = 0 then begin - //WriteLn('Object ', name,' Doesn''t exist or is zero sized.'); - Exit; - end; - - Entry := fCachedEntry; - if Entry.ContentSection = 0 then begin - Result := TMemoryStream.Create; - fStream.Position := fHeaderSuffix.Offset+ Entry.ContentOffset; - Result.CopyFrom(fStream, fCachedEntry.DecompressedLength); - end - else begin // we have to get it from ::DataSpace/Storage/[MSCompressed,Uncompressed]/ControlData - GetSections(SectionNames); - FmtStr(SectionName, '::DataSpace/Storage/%s/',[SectionNames[Entry.ContentSection-1]]); - Result := GetBlockFromSection(SectionName, Entry.ContentOffset, Entry.DecompressedLength); - SectionNames.Free; - end; - if Result <> nil then Result.Position := 0; -end; - -function TChmReader.GetContextUrl(Context: THelpContext): String; -begin - // will get '' if context not found - Result := fContextList.GetURL(Context); -end; - -function TChmReader.HasContextList: Boolean; -begin - Result := fContextList.Count > 0; -end; - -procedure TITSFReader.GetSections(out Sections: TStringList); -var - Stream: TStream; - EntryCount: Word; - X: Integer; - {$IFDEF ENDIAN_BIG} - I: Integer; - {$ENDIF} - WString: array [0..31] of WideChar; - StrLength: Word; -begin - Sections := TStringList.Create; - //WriteLn('::DataSpace/NameList Size = ', ObjectExists('::DataSpace/NameList')); - Stream := GetObject('::DataSpace/NameList'); - - if Stream = nil then begin - //WriteLn('Failed to get ::DataSpace/NameList!'); - exit; - end; - - Stream.Position := 2; - EntryCount := LEtoN(Stream.ReadWord); - for X := 0 to EntryCount -1 do begin - StrLength := LEtoN(Stream.ReadWord); - if StrLength > 31 then StrLength := 31; - Stream.Read(WString, SizeOf(WideChar)*(StrLength+1)); // the strings are stored null terminated - {$IFDEF ENDIAN_BIG} - for I := 0 to StrLength-1 do - WString[I] := WideChar(LEtoN(Ord(WString[I]))); - {$ENDIF} - Sections.Add(WString); - end; - // the sections are sorted alphabetically, this way section indexes will jive - Sections.Sort; - Stream.Free; -end; - -function TITSFReader.GetBlockFromSection(SectionPrefix: String; StartPos: QWord; - BlockLength: QWord): TMemoryStream; -var - Compressed: Boolean; - Sig: Array [0..3] of char; - CompressionVersion: LongWord; - CompressedSize: Int64; - UnCompressedSize: Int64; - //LZXResetInterval: LongWord; - //LZXWindowSize: LongWord; - //LZXCacheSize: LongWord; - ResetTableEntry: TPMGListChunkEntry; - ResetTable: TLZXResetTableArr; - WriteCount: QWord; - BlockWriteLength: QWord; - WriteStart: LongWord; - ReadCount:LongInt; - LZXState: PLZXState; - InBuf: array of Byte; - OutBuf: PByte; - BlockSize: QWord; - X: Integer; - FirstBlock, LastBlock: LongInt; - ResultCode: LongInt; - procedure ReadBlock; - begin - if ReadCount > Length(InBuf) then - SetLength(InBuf, ReadCount); - fStream.Read(InBuf[0], ReadCount); - end; -begin - // okay now the fun stuff ;) - Result := nil; - Compressed := ObjectExists(SectionPrefix+'Transform/{7FC28940-9D31-11D0-9B27-00A0C91E9C7C}/InstanceData/ResetTable')>0; - // the easy method - if Not(Compressed) then begin - if ObjectExists(SectionPrefix+'Content') > 0 then begin - Result := TMemoryStream.Create; - fStream.Position := fHeaderSuffix.Offset + fCachedEntry.ContentOffset + StartPos; - Result.CopyFrom(fStream, BlockLength); - end; - Exit; - end - else - ResetTableEntry := fCachedEntry; - - // First make sure that it is a compression we can read - if ObjectExists(SectionPrefix+'ControlData') > 0 then begin - fStream.Position := fHeaderSuffix.Offset + fCachedEntry.ContentOffset + 4; - fStream.Read(Sig, 4); - if Sig <> 'LZXC' then Exit; - CompressionVersion := LEtoN(fStream.ReadDWord); - if CompressionVersion > 2 then exit; - {LZXResetInterval := }LEtoN(fStream.ReadDWord); - {LZXWindowSize := }LEtoN(fStream.ReadDWord); - {LZXCacheSize := }LEtoN(fStream.ReadDWord); - - - BlockSize := FindBlocksFromUnCompressedAddr(ResetTableEntry, CompressedSize, UnCompressedSize, ResetTable); - if UncompressedSize > 0 then ; // to avoid a compiler note - if StartPos > 0 then - FirstBlock := StartPos div BlockSize - else - FirstBlock := 0; - LastBlock := (StartPos+BlockLength) div BlockSize; - - if ObjectExists(SectionPrefix+'Content') = 0 then exit; - //WriteLn('Compressed Data start''s at: ', fHeaderSuffix.Offset + fCachedEntry.ContentOffset,' Size is: ', fCachedEntry.DecompressedLength); - Result := TMemoryStream.Create; - Result.Size := BlockLength; - SetLength(InBuf,BlockSize); - OutBuf := GetMem(BlockSize); - // First Init a PLZXState - LZXState := LZXinit(16); - if LZXState = nil then begin - Exit; - end; - // if FirstBlock is odd (1,3,5,7 etc) we have to read the even block before it first. - if (FirstBlock <> 0) and (FirstBlock mod 2 > 0) then begin - fStream.Position := fHeaderSuffix.Offset + fCachedEntry.ContentOffset + (ResetTable[FirstBLock-1]); - ReadCount := ResetTable[FirstBlock] - ResetTable[FirstBlock-1]; - BlockWriteLength:=BlockSize; - ReadBlock; - ResultCode := LZXdecompress(LZXState, @InBuf[0], OutBuf, ReadCount, LongInt(BlockWriteLength)); - end; - // now start the actual decompression loop - for X := FirstBlock to LastBlock do begin - fStream.Position := fHeaderSuffix.Offset + fCachedEntry.ContentOffset + (ResetTable[X]); - - if X = FirstBLock then - WriteStart := StartPos - (X*BlockSize) - else - WriteStart := 0; - - if X = High(ResetTable) then - ReadCount := CompressedSize - ResetTable[X] - else - ReadCount := ResetTable[X+1] - ResetTable[X]; - - BlockWriteLength := BlockSize; - - if FirstBlock = LastBlock then begin - WriteCount := BlockLength; - end - else if X = LastBlock then - WriteCount := (StartPos+BlockLength) - (X*BlockSize) - else WriteCount := BlockSize - WriteStart; - - ReadBlock; - ResultCode := LZXdecompress(LZXState, @InBuf[0], OutBuf, ReadCount, LongInt(BlockWriteLength)); - - //now write the decompressed data to the stream - if ResultCode = DECR_OK then begin - Result.Write(OutBuf[WriteStart], Int64(WriteCount)); - end - else begin - {$IFDEF CHM_DEBUG} // windows gui program will cause an exception with writeln's - WriteLn('Decompress FAILED with error code: ', ResultCode); - {$ENDIF} - Result.Free; - Result := Nil; - FreeMem(OutBuf); - SetLength(ResetTable,0); - LZXteardown(LZXState); - Exit; - end; - - // if the next block is an even numbered block we have to reset the decompressor state - if (X < LastBlock) and (X mod 2 > 0) then LZXreset(LZXState); - - end; - FreeMem(OutBuf); - SetLength(ResetTable,0); - LZXteardown(LZXState); - end; -end; - -function TITSFReader.FindBlocksFromUnCompressedAddr(var ResetTableEntry: TPMGListChunkEntry; - out CompressedSize: Int64; out UnCompressedSize: Int64; out LZXResetTable: TLZXResetTableArr): QWord; -var - BlockCount: LongWord; - {$IFDEF ENDIAN_BIG} - I: Integer; - {$ENDIF} -begin - Result := 0; - fStream.Position := fHeaderSuffix.Offset + ResetTableEntry.ContentOffset; - fStream.ReadDWord; - BlockCount := LEtoN(fStream.ReadDWord); - fStream.ReadDWord; - fStream.ReadDWord; // TableHeaderSize; - fStream.Read(UnCompressedSize, SizeOf(QWord)); - UnCompressedSize := LEtoN(UnCompressedSize); - fStream.Read(CompressedSize, SizeOf(QWord)); - CompressedSize := LEtoN(CompressedSize); - fStream.Read(Result, SizeOf(QWord)); // block size - Result := LEtoN(Result); - - // now we are located at the first block index - - SetLength(LZXResetTable, BlockCount); - fStream.Read(LZXResetTable[0], SizeOf(QWord)*BlockCount); - {$IFDEF ENDIAN_BIG} - for I := 0 to High(LZXResetTable) do - LZXResetTable[I] := LEtoN(LZXResetTable[I]); - {$ENDIF} -end; - -{ TContextList } - -procedure TContextList.AddContext(Context: THelpContext; Url: String); -var - ContextItem: PContextItem; -begin - New(ContextItem); - Add(ContextItem); - ContextItem^.Context := Context; - ContextItem^.Url := Url; -end; - -function TContextList.GetURL(Context: THelpContext): String; -var - X: Integer; -begin - Result := ''; - for X := 0 to Count-1 do begin - if PContextItem(Get(X))^.Context = Context then begin - Result := PContextItem(Get(X))^.Url; - Exit; - end; - end; -end; - -procedure TContextList.Clear; -var - X: Integer; -begin - for X := Count-1 downto 0 do begin - Dispose(PContextItem(Get(X))); - Delete(X); - end; -end; - - -{ TChmFileList } - -procedure TChmFileList.Delete(Index: Integer); -begin - Chm[Index].Free; - inherited Delete(Index); -end; - -function TChmFileList.GetChm(AIndex: Integer): TChmReader; -begin - Result := TChmReader(Objects[AIndex]); -end; - -function TChmFileList.GetFileName(AIndex: Integer): String; -begin - Result := Strings[AIndex]; -end; - -procedure TChmFileList.OpenNewFile(AFileName: String); -var -AStream: TFileStream; -AChm: TChmReader; -AIndex: Integer; -begin - if not FileExistsUTF8(AFileName) then exit; - AStream := TFileStream.Create(UTF8ToSys(AFileName), fmOpenRead); - AChm := TChmReader.Create(AStream, True); - AIndex := AddObject(AFileName, AChm); - fLastChm := AChm; - if Assigned(fOnOpenNewFile) then fOnOpenNewFile(Self, AIndex) - else fUnNotifiedFiles.Add(AChm); -end; - -function TChmFileList.CheckOpenFile(AFileName: String): Boolean; -var - X: Integer; - -begin - Result := False; - for X := 0 to Count-1 do begin - if ExtractFileName(FileName[X]) = AFileName then begin - fLastChm := Chm[X]; - Result := True; - Exit; - end; - end; - if not Result then begin - AFileName := ExtractFilePath(FileName[0])+AFileName; - if FileExistsUTF8(AFileName) and (ExtractFileExt(AFileName) = '.chm') then OpenNewFile(AFileName); - Result := True; - end; -end; - -function TChmFileList.MetaObjectExists(var Name: String): QWord; -var - AFileName: String; - URL: String; - fStart, fEnd: Integer; - Found: Boolean; -begin - Found := False; - Result := 0; - //Known META file link types - // ms-its:name.chm::/topic.htm - //mk:@MSITStore:name.chm::/topic.htm - if Pos('ms-its:', Name) > 0 then begin - fStart := Pos('ms-its:', Name)+Length('ms-its:'); - fEnd := Pos('::', Name)-fStart; - AFileName := Copy(Name, fStart, fEnd); - fStart := fEnd+fStart+2; - fEnd := Length(Name) - (fStart-1); - URL := Copy(Name, fStart, fEnd); - Found := True; - end - else if Pos('mk:@MSITStore:', Name) > 0 then begin - fStart := Pos('mk:@MSITStore:', Name)+Length('mk:@MSITStore:'); - fEnd := Pos('::', Name)-fStart; - AFileName := Copy(Name, fStart, fEnd); - fStart := fEnd+fStart+2; - fEnd := Length(Name) - (fStart-1); - URL := Copy(Name, fStart, fEnd); - Found := True; - end; - if not Found then exit; - if CheckOpenFile(AFileName) then - Result := fLastChm.ObjectExists(URL); - if Result > 0 then NAme := Url; -end; - -function TChmFileList.MetaGetObject(Name: String): TMemoryStream; -begin - Result := nil; - if MetaObjectExists(Name) > 0 then Result := fLastChm.GetObject(Name); -end; - -constructor TChmFileList.Create(PrimaryFileName: String); -begin - inherited Create; - fUnNotifiedFiles := TList.Create; - OpenNewFile(PrimaryFileName); -end; - -destructor TChmFileList.Destroy; -begin - fUnNotifiedFiles.Free; -end; - -procedure TChmFileList.SetOnOpenNewFile(AValue: TChmFileOpenEvent); -var - X: Integer; -begin - fOnOpenNewFile := AValue; - if AValue = nil then exit; - for X := 0 to fUnNotifiedFiles.Count-1 do - AValue(Self, X); - fUnNotifiedFiles.Clear; -end; - -function TChmFileList.ObjectExists(Name: String; fChm: TChmReader = nil): QWord; -begin - Result := 0; - if Count = 0 then exit; - if fChm <> nil then fLastChm := fChm; - Result := fLastChm.ObjectExists(Name); - if Result = 0 then begin - Result := Chm[0].ObjectExists(Name); - if Result > 0 then fLastChm := Chm[0]; - end; - if Result = 0 then begin - Result := MetaObjectExists(Name); - end; -end; - -function TChmFileList.GetObject(Name: String): TMemoryStream; -begin - Result := nil; - if Count = 0 then exit; - Result := fLastChm.GetObject(Name); - if Result = nil then Result := MetaGetObject(Name); -end; - -function TChmFileList.IsAnOpenFile(AFileName: String): Boolean; -var - X: Integer; -begin - Result := False; - for X := 0 to Count-1 do begin - if AFileName = FileName[X] then Exit(True); - end; -end; - -end. - diff --git a/components/chmhelp/packages/chm/paslzx.pas b/components/chmhelp/packages/chm/paslzx.pas deleted file mode 100644 index 76e70b888d..0000000000 --- a/components/chmhelp/packages/chm/paslzx.pas +++ /dev/null @@ -1,1017 +0,0 @@ -{ Copyright (C) <2005> paslzx.pas - - This library is free software; you can redistribute it and/or modify it - under the terms of the GNU Library General Public License as published by - the Free Software Foundation; either version 2 of the License, or (at your - option) any later version. - - This program 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 Library General Public License - for more details. - - You should have received a copy of the GNU Library 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. -} -{ - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the copyright. -} - -{*************************************************************************** - * paslzx.pas - LZX decompression routines * - * ------------------- * - * * - * maintainer: Andrew Haines * - * source: modified lzx.c from chmlib 0.37-4 * - * notes: The lzx.c file was taken from cabextract v0.5, which was, * - * itself, a modified version of the lzx decompression code * - * from unlzx. This file would not be available without the * - * invaluable help from Micha Nelissen fixing my errors. * - * * - * Licensed with permission of Stuart Caie with a modified * - * LGPL. * - * * - * platforms: Should work on any platform that FreePascal is available * - * on. However it has been tested on only an amd64(Linux) and * - * x86(Linux and Windows). Only tested on little endian pc's. * - ***************************************************************************} - -unit paslzx; - -{$mode objfpc}{$H+}{$R+} - -interface - -uses - Classes, SysUtils; - -const - DECR_OK = 0; - DECR_DATAFORMAT = 1; - DECR_ILLEGALDATA = 2; - DECR_NOMEMORY = 3; - - - // some constants defined by the LZX specification - LZX_MIN_MATCH = 2; - LZX_MAX_MATCH = 257; - LZX_NUM_CHARS = 256; - LZX_BLOCKTYPE_INVALID = 0; // also blocktypes 4-7 invalid - LZX_BLOCKTYPE_VERBATIM = 1; - LZX_BLOCKTYPE_ALIGNED = 2; - LZX_BLOCKTYPE_UNCOMPRESSED= 3; - LZX_PRETREE_NUM_ELEMENTS = 20; - LZX_ALIGNED_NUM_ELEMENTS = 8; // aligned offset tree #elements - LZX_NUM_PRIMARY_LENGTHS = 7; // this one missing from spec! - LZX_NUM_SECONDARY_LENGTHS = 249;// length tree #elements - - // LZX huffman defines: tweak tablebits as desired - LZX_PRETREE_MAXSYMBOLS = LZX_PRETREE_NUM_ELEMENTS; - LZX_PRETREE_TABLEBITS = 6; - LZX_MAINTREE_MAXSYMBOLS = LZX_NUM_CHARS + 50*8; - LZX_MAINTREE_TABLEBITS = 12; - LZX_LENGTH_MAXSYMBOLS = LZX_NUM_SECONDARY_LENGTHS+1; - LZX_LENGTH_TABLEBITS = 12; - LZX_ALIGNED_MAXSYMBOLS = LZX_ALIGNED_NUM_ELEMENTS; - LZX_ALIGNED_TABLEBITS = 7; - - LZX_LENTABLE_SAFETY = 64; // we allow length table decoding overruns - - extra_bits: array [0..50] of Byte = ( - 0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, - 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13, 14, 14, - 15, 15, 16, 16, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, - 17, 17, 17 - ); - - position_base: array [0..50] of dword = ( - 0, 1, 2, 3, 4, 6, 8, 12, 16, 24, 32, 48, 64, 96, 128, 192, - 256, 384, 512, 768, 1024, 1536, 2048, 3072, 4096, 6144, 8192, 12288, 16384, 24576, 32768, 49152, - 65536, 98304, 131072, 196608, 262144, 393216, 524288, 655360, 786432, 917504, 1048576, 1179648, 1310720, 1441792, 1572864, 1703936, - 1835008, 1966080, 2097152 - ); -type - - { TBits } - - TBufBits = class - private - bitbuf: dword; - bitsleft: LongInt; - public - procedure Init; - procedure ensure(num: LongInt; var inpos:PByte); - function peek(numbits: LongInt): dword; - function remove(numbits: LongInt): dword; - function read(numbits: LongInt; var inpos: PByte): dword; - end; - - TLZX_PRETREE_TABLE = record - Table: array [0..(1 shl LZX_PRETREE_TABLEBITS) + (LZX_PRETREE_MAXSYMBOLS shl 1)-1] of Word; - Len: array [0..LZX_PRETREE_MAXSYMBOLS + LZX_LENTABLE_SAFETY-1] of Byte; - end; - TLZX_MAINTREE_TABLE = record - Table: array [0..(1 shl LZX_MAINTREE_TABLEBITS) + (LZX_MAINTREE_MAXSYMBOLS shl 1)-1] of Word; - Len: array [0..LZX_MAINTREE_MAXSYMBOLS + LZX_LENTABLE_SAFETY-1] of Byte; - end; - - TLZX_LENGTH_TABLE = record - Table: array [0..(1 shl LZX_LENGTH_TABLEBITS) + (LZX_LENGTH_MAXSYMBOLS shl 1)-1] of Word; - Len: array [0..LZX_LENGTH_MAXSYMBOLS + LZX_LENTABLE_SAFETY-1] of Byte; - end; - - TLZX_ALIGNED_TABLE = record - Table: array [0..(1 shl LZX_ALIGNED_TABLEBITS) + (LZX_ALIGNED_MAXSYMBOLS shl 1)-1] of Word; - Len: array [0..LZX_ALIGNED_MAXSYMBOLS + LZX_LENTABLE_SAFETY-1] of Byte; - end; - - PLZXState = ^TLZXState; - TLZXState = record - window: PByte; // the actual decoding window - window_size, // window size (32Kb through 2Mb) - actual_size, // window size when it was first allocated - window_posn, // current offset within the window - R0, R1, R2: dword; // for the LRU offset system - main_elements : Word; // number of main tree elements - header_read: LongInt; // have we started decoding at all yet? - block_type: Word; // type of this block - block_length, // uncompressed length of this block - block_remaining, // uncompressed bytes still left to decode - frames_read: dword; // the number of CFDATA blocks - intel_filesize, // magic header value used for transform - intel_curpos: LongInt; // current offset in transform space - intel_started: LongInt; // have we seen any translatable data yet? - - PreTreeTable: TLZX_PRETREE_TABLE; - MainTreeTable: TLZX_MAINTREE_TABLE; - LengthTable: TLZX_LENGTH_TABLE; - AlignedTAble: TLZX_ALIGNED_TABLE; - end; - - // create an lzx state object - function LZXinit(window: LongInt): PLZXState; - - // destroy an lzx state object - procedure LZXteardown(pState: PLZXState); - - // reset an lzx stream - function LZXreset(pState: PLZXState): LongInt; - - function LZXdecompress(pState: PLZXstate; inpos, outpos: PByte; inlen, outlen: LongInt): LongInt; - -implementation - -const - ULONG_BITS = sizeof(LongInt)shl 3; - -function make_decode_table(nsyms: dword; nbits: dword; length: PByte; table: PWord): LongInt; -var - Sym: Word; - leaf: dword; - bit_num: Byte = 1; - fill: dword; - pos: dword = 0; //* the current position in the decode table */ - table_mask: dword; - bit_mask: dword; //* don't do 0 length codes */ - next_symbol: dword; //* base of allocation for long codes */ -begin - Result := 0; - table_mask := 1 shl nbits; - bit_mask := table_mask shr 1; - next_symbol := bit_mask; - //* fill entries for codes short enough for a direct mapping */ - while (bit_num <= nbits) do begin - for sym := 0 to nsyms-1 do begin - if (length[sym] = bit_num) then begin - leaf := pos; - - Inc(pos, bit_mask); - if pos > table_mask then begin - Result := 1; //* table overrun */ - exit; - end; - - //* fill all possible lookups of this symbol with the symbol itself */ - fill := bit_mask; - while fill > 0 do - begin - dec(fill); - table[leaf] := sym; - Inc(leaf); - end; - end; - end; - bit_mask := bit_mask shr 1; - Inc(bit_num); - end; - - //* if there are any codes longer than nbits */ - if pos <> table_mask then begin - //* clear the remainder of the table */ - for sym := pos to table_mask-1 do table[sym] := 0; - - //* give ourselves room for codes to grow by up to 16 more bits */ - pos := pos shl 16; - table_mask := table_mask shl 16; - bit_mask := 1 shl 15; - - while (bit_num <= 16) do begin - for sym := 0 to nsyms-1 do begin - if (length[sym] = bit_num) then begin - leaf := pos shr 16; - for fill := 0 to (bit_num - nbits)-1 do begin - //* if this path hasn't been taken yet, 'allocate' two entries */ - if (table[leaf] = 0) then begin - table[(next_symbol shl 1)] := 0; - table[(next_symbol shl 1)+1] := 0; - table[leaf] := Word(next_symbol); - Inc(next_symbol); - end; - //* follow the path and select either left or right for next bit */ - leaf := table[leaf] shl 1; - if ((pos shr (15-fill)) and 1) > 0 then Inc(leaf); - end; - table[leaf] := sym; - - pos := pos + bit_mask; - if (pos > table_mask) then begin - Result := 1; //* table overflow */ - exit; - end; - end; - end; - bit_mask := bit_mask shr 1; - Inc(bit_num); - end; - end; - - //* full table? */ - if (pos = table_mask) then begin - Result := 0; - Exit; - end; - - //* either erroneous table, or all elements are 0 - let's find out. */ - for sym := 0 to nsyms-1 do begin - if length[sym] > 0 then begin - Result := 1; - Exit; - end; - end; - Result := 0; -end; - -type - PLZX_bits = ^TLzx_bits; - Tlzx_bits = record - bb: dword; - bl: LongInt; - ip: PByte; - end; - -function READ_HUFFSYM(Table: PWord; Len: PByte; const bits: TBufBits; var inpos: PByte; - var i, j: DWord; const TableBits, MaxSymbols: DWord; out z: LongInt): LongInt; -var - hufftbl: PWord; -begin - bits.ensure(16, inpos); - hufftbl := Table; - i := hufftbl[bits.peek(TableBits)]; - if (i) >= MaxSymbols then begin - j := 1 shl (ULONG_BITS - TableBits); - repeat - j := j shr 1; - i := i shl 1; - i := i or ord((bits.bitbuf and j) <> 0); - if j = 0 then begin - Result := DECR_ILLEGALDATA; - Exit; - end; - i := hufftbl[i]; - until i < MaxSymbols; - end; - z := i; - j := Len[z]; - bits.remove(j); - Result := 0; -end; - -function lzx_read_lens(pState: PLZXState; lens: PByte; first: dword; last: dword; lb: Plzx_bits): LongInt; -var - i: dword = 0; - j: dword = 0; - x,y: dword; - z: LongInt; - - inpos: PByte; - bits: TBufBits; -begin - bits := TBufBits.Create; - bits.bitbuf := lb^.bb; - bits.bitsleft := lb^.bl; - - inpos := lb^.ip; - - - for X := 0 to 19 do begin - y := bits.read(4, inpos); - pState^.PreTreeTable.Len[x] := byte(y); - end; - if make_decode_table(LZX_PRETREE_MAXSYMBOLS, LZX_PRETREE_TABLEBITS, - @pState^.PreTreeTable.Len[0],@pState^.PreTreeTable.Table[0]) >0 then - begin - Result := DECR_ILLEGALDATA; - bits.Free; - Exit; - end; - - - x := first; - while x < last do begin - if READ_HUFFSYM(@pState^.PreTreeTable.Table[0], @pstate^.PreTreeTable.Len[0], bits, inpos, i, j, - LZX_PRETREE_TABLEBITS, LZX_PRETREE_MAXSYMBOLS, z) <> 0 then - begin - Result := DECR_ILLEGALDATA; - bits.Free; - Exit; - end; - if (z = 17) then begin - y := bits.read(4, inpos); - Inc(y, 4); - while y > 0 do begin - dec(y); - Lens[x] := 0; - Inc(x); - end; - end - else if (z = 18) then begin - y := bits.read(5, inpos); - Inc(y, 20); - while y > 0 do begin - dec(y); - lens[x] := 0; - inc(x); - end; - end - else if (z = 19) then begin - y := bits.read(1, inpos); - Inc(y, 4); - if READ_HUFFSYM(@pState^.PreTreeTable.Table[0], @pstate^.PreTreeTable.Len[0], bits, inpos, i, j, - LZX_PRETREE_TABLEBITS, LZX_PRETREE_MAXSYMBOLS, z) <> 0 then - begin - Result := DECR_ILLEGALDATA; - bits.Free; - Exit; - end; - z := lens[x] - z; - if (z < 0) then z := z + 17; - while y > 0 do begin - dec(y); - lens[x] := byte(z); - inc(x); - end; - end - else begin - z := lens[x] - z; - if (z < 0) then z := z + 17; - lens[x] := byte(z); - inc(x); - end; - end; - - lb^.bb := bits.bitbuf; - lb^.bl := bits.bitsleft; - lb^.ip := inpos; - Result := 0; - bits.Free; -end; - - -////////////////////////////////////////////////////////////////////////////////////// - -function LZXinit(window: LongInt): PLZXState; -var - pState: PLZXState; - wndsize: dword; - i, - posn_slots: LongInt; -begin - Result := nil; - wndsize := 1 shl window; - - //* LZX supports window sizes of 2^15 (32Kb) through 2^21 (2Mb) */ - //* if a previously allocated window is big enough, keep it */ - if (window < 15) or (window > 21) then begin - Exit; - end; - - //* allocate state and associated window */ - New(pState); - pState^.window := GetMem(wndsize); - if pState^.window = nil then - begin - Dispose(pState); - Result := nil; - exit; - end; - pState^.actual_size := wndsize; - pState^.window_size := wndsize; - - //* calculate required position slots */ - if (window = 20) then posn_slots := 42 - else if (window = 21) then posn_slots := 50 - else posn_slots := window shl 1; - - ///** alternatively **/ - ///* posn_slots=i=0; while (i < wndsize) i += 1 << extra_bits[posn_slots++]; */ - - ///* initialize other state */ - pState^.R0 := 1; - pState^.R1 := 1; - pState^.R2 := 1; - - pState^.main_elements := LZX_NUM_CHARS + (posn_slots shl 3); - pState^.header_read := 0; - pState^.frames_read := 0; - pState^.block_remaining := 0; - pState^.block_type := LZX_BLOCKTYPE_INVALID; - pState^.intel_curpos := 0; - pState^.intel_started := 0; - pState^.window_posn := 0; - - ///* initialise tables to 0 (because deltas will be applied to them) */ - for i := 0 to LZX_MAINTREE_MAXSYMBOLS-1 do pState^.MainTreeTable.Len[i] := 0; - for i := 0 to LZX_LENGTH_MAXSYMBOLS-1 do pState^.LengthTable.Len[i] := 0; - - Result := pState; -end; - -procedure LZXteardown(pState: PLZXState); -begin - if pState <> nil then - begin - if pState^.window <> nil then - Freemem(pState^.window); - Dispose(pState); - end; -end; - -function LZXreset(pState: PLZXState): LongInt; -var - i: LongInt; -begin - pState^.R0 := 1; - pState^.R1 := 1; - pState^.R2 := 1; - pState^.header_read := 0; - pState^.frames_read := 0; - pState^.block_remaining := 0; - pState^.block_type := LZX_BLOCKTYPE_INVALID; - pState^.intel_curpos := 0; - pState^.intel_started := 0; - pState^.window_posn := 0; - - for i := 0 to (LZX_MAINTREE_MAXSYMBOLS + LZX_LENTABLE_SAFETY - 1) do pState^.MainTreeTable.Len[i] := 0; - for i := 0 to LZX_LENGTH_MAXSYMBOLS+LZX_LENTABLE_SAFETY-1 do pState^.LengthTable.Len[i] := 0; - Result := DECR_OK; -end; - -function LZXdecompress(pState: PLZXstate; inpos, outpos: PByte; inlen, - outlen: LongInt): LongInt; -var - endinp: PByte; - window: PByte; - runsrc, - rundest: PByte; - window_posn: dword; - window_size: dword; - R0, - r1, - R2: dword; - bits: TBufBits; - match_offset, - i,j,k : dword; - lb: tlzx_bits; - togo, - this_run, - main_element, - aligned_bits: LongInt; - match_length, - length_footer, - extra, - verbatim_bits: LongInt; - data, - dataend: PByte; - curpos, - filesize, - abs_off, - rel_off: LongInt; - function READ_LENGTHS(Len: PByte; first: dword; last: dword): Longint; - begin - Result := 0; - lb.bb := bits.bitbuf; - lb.bl := bits.bitsleft; - lb.ip := inpos; - if (lzx_read_lens(pState, Len,first,last,@lb)) > 0 then begin - Result := DECR_ILLEGALDATA; - Exit; - end; - bits.bitbuf := lb.bb; - bits.bitsleft := lb.bl; - inpos := lb.ip; - end; - - procedure HandleBlockTypeAligned; - var - i, j: dword; - begin - for i := 0 to 7 do begin - j:= bits.read(3, inpos); - pState^.AlignedTAble.Len[i] := Word(j); - end; - if make_decode_table(LZX_ALIGNED_MAXSYMBOLS, LZX_ALIGNED_TABLEBITS, - @pState^.AlignedTAble.Len[0],@pState^.AlignedTAble.Table[0]) >0 then - begin - Result := DECR_ILLEGALDATA; - Exit; - end; - end; - - procedure HandleBlockTypeVerbatim; - begin - if ( - READ_LENGTHS(@pState^.MainTreeTable.Len[0], 0, 256) = DECR_ILLEGALDATA) - or ( - READ_LENGTHS(@pState^.MainTreeTable.Len[0], 256, pState^.main_elements) = DECR_ILLEGALDATA) - then begin - Result := DECR_ILLEGALDATA; - Exit; - end; - if make_decode_table(LZX_MAINTREE_MAXSYMBOLS, LZX_MAINTREE_TABLEBITS, - @pState^.MainTreeTable.Len[0], @pState^.MainTreeTable.Table[0]) >0 then - begin - Result := DECR_ILLEGALDATA; - Exit; - end; - - if pState^.MainTreeTable.Len[$E8] <> 0 then - pState^.intel_started := 1; - - if READ_LENGTHS(@pState^.LengthTable.Len[0], 0, LZX_NUM_SECONDARY_LENGTHS) = DECR_ILLEGALDATA then begin - Result := DECR_ILLEGALDATA; - Exit; - end; - if make_decode_table(LZX_LENGTH_MAXSYMBOLS, LZX_LENGTH_TABLEBITS, - @pState^.LengthTable.Len[0],@pState^.LengthTable.Table[0]) >0 then - begin - Result := DECR_ILLEGALDATA; - Exit; - end; - end; - -begin - endinp := inpos + inlen; - window := pState^.window; - - window_posn := pState^.window_posn; - window_size := pState^.window_size; - R0 := pState^.R0; - R1 := pState^.R1; - R2 := pState^.R2; - - togo := outlen;//, this_run, main_element, aligned_bits; - bits := TBufBits.Create; - bits.Init; - //* read header if necessary */ - if (pState^.header_read) = 0 then begin - i := 0; - j := 0; - k := bits.read(1, inpos); - if (k) > 0 then begin - i := bits.read(16, inpos); - j := bits.read(16, inpos); - end; - pState^.intel_filesize := (i shl 16) or j; ///* or 0 if not encoded */ - pState^.header_read := 1; - end; - - ///* main decoding loop */ - while (togo > 0) do begin - ///* last block finished, new block expected */ - if (pState^.block_remaining = 0) then begin - if (pState^.block_type = LZX_BLOCKTYPE_UNCOMPRESSED) then begin - if (pState^.block_length and 1) > 0 then Inc(inpos); //* realign bitstream to word */ - bits.Init; - end; - - pState^.block_type := Word(bits.read(3, inpos)); - i := bits.read(16, inpos); - j := bits.read(8, inpos); - - pState^.block_length := (i shl 8) or j; - pState^.block_remaining := pState^.block_length; - - case (pState^.block_type) of - LZX_BLOCKTYPE_ALIGNED: - begin - HandleBlockTypeAligned; - //* rest of aligned header is same as verbatim */ - HandleBlockTypeVerbatim; - end; - LZX_BLOCKTYPE_VERBATIM: - begin - HandleBlockTypeVerbatim; - end; - LZX_BLOCKTYPE_UNCOMPRESSED: - begin - pState^.intel_started := 1; //* because we can't assume otherwise */ - bits.ensure(16, inpos); //* get up to 16 pad bits into the buffer */ - if (bits.bitsleft > 16) then Dec(inpos ,2); //* and align the bitstream! */ - R0 := inpos[0] or (inpos[1]shl 8)or(inpos[2]shl 16)or(inpos[3]shl 24); - Inc(inpos,4); - R1 := inpos[0] or (inpos[1]shl 8)or(inpos[2]shl 16)or(inpos[3]shl 24); - Inc(inpos,4); - R2 := inpos[0] or (inpos[1]shl 8)or(inpos[2]shl 16)or(inpos[3]shl 24); - Inc(inpos,4); - end; - else - Result := DECR_ILLEGALDATA; - bits.Free; - Exit; - end; - end; - - //* buffer exhaustion check */ - if (inpos > endinp) then begin - {* it's possible to have a file where the next run is less than - * 16 bits in size. In this case, the READ_HUFFSYM() macro used - * in building the tables will exhaust the buffer, so we should - * allow for this, but not allow those accidentally read bits to - * be used (so we check that there are at least 16 bits - * remaining - in this boundary case they aren't really part of - * the compressed data) - *} - if (inpos > (endinp+2)) or (bits.bitsleft < 16) then begin - Result := DECR_ILLEGALDATA; - bits.Free; - Exit; - end; - end; - - this_run := pState^.block_remaining; - while (this_run > 0) and (togo > 0) do begin - - if (this_run > togo) then this_run := togo; - Dec(togo, this_run); - Dec(pState^.block_remaining, this_run); - - //* apply 2^x-1 mask */ - window_posn := window_posn and (window_size - 1); - //* runs can't straddle the window wraparound */ - if ((window_posn + this_run) > window_size) then begin - Result := DECR_DATAFORMAT; - bits.Free; - Exit; - end; - case (pState^.block_type) of - - LZX_BLOCKTYPE_VERBATIM: - begin - while (this_run > 0) do begin - if READ_HUFFSYM(@pState^.MainTreeTable.Table[0], @pState^.MainTreeTable.Len[0], - bits, inpos, i, j, LZX_MAINTREE_TABLEBITS, LZX_MAINTREE_MAXSYMBOLS, - main_element) <> 0 then - begin - Result := DECR_ILLEGALDATA; - bits.Free; - Exit; - end; - - if (main_element < LZX_NUM_CHARS) then begin - //* literal: 0 to LZX_NUM_CHARS-1 */ - window[window_posn] := Byte(main_element); - Inc(window_posn); - Dec(this_run); - end - else begin - //* match: LZX_NUM_CHARS + ((slot<<3) | length_header (3 bits)) */ - Dec(main_element, LZX_NUM_CHARS); - - match_length := main_element and LZX_NUM_PRIMARY_LENGTHS; - if (match_length = LZX_NUM_PRIMARY_LENGTHS) then begin - if READ_HUFFSYM(@pState^.LengthTable.Table[0], @pState^.LengthTable.Len[0], - bits, inpos, i, j, LZX_LENGTH_TABLEBITS, LZX_LENGTH_MAXSYMBOLS, - length_footer) <> 0 then - begin - Result := DECR_ILLEGALDATA; - bits.Free; - Exit; - end; - Inc(match_length, length_footer); - end; - Inc(match_length, LZX_MIN_MATCH); - - match_offset := main_element shr 3; - - if (match_offset > 2) then begin - //* not repeated offset */ - if (match_offset <> 3) then begin - extra := extra_bits[match_offset]; - verbatim_bits := bits.read(extra, inpos); - match_offset := position_base[match_offset] - 2 + verbatim_bits; - end - else begin - match_offset := 1; - end; - - //* update repeated offset LRU queue */ - R2 := R1; - R1 := R0; - R0 := match_offset; - end - else if (match_offset = 0) then begin - match_offset := R0; - end - else if (match_offset = 1) then begin - match_offset := R1; - R1 := R0; - R0 := match_offset; - end - else begin //* match_offset == 2 */ - match_offset := R2; - R2 := R0; - R0 := match_offset; - end; - - rundest := window + window_posn; - runsrc := rundest - match_offset; - Inc(window_posn, match_length); - if (window_posn > window_size) then begin - Result := DECR_ILLEGALDATA; - bits.Free; - Exit; - end; - Dec(this_run, match_length); - - ///* copy any wrapped around source data */ - while ((runsrc < window) and (match_length > 0)) do begin - Dec(match_length); - rundest^ := (runsrc + window_size)^; - Inc(rundest); - Inc(runsrc); - end; - //* copy match data - no worries about destination wraps */ - while (match_length > 0) do begin - Dec(match_length); - rundest^ := runsrc^; - Inc(rundest); - Inc(runsrc); - end; - - end - end; - end; - LZX_BLOCKTYPE_ALIGNED: - begin - while (this_run > 0) do begin - if READ_HUFFSYM(@pState^.MainTreeTable.Table[0], @pState^.MainTreeTable.Len[0], bits, - inpos, i, j, LZX_MAINTREE_TABLEBITS, LZX_MAINTREE_MAXSYMBOLS, main_element) <> 0 then - begin - Result := DECR_ILLEGALDATA; - bits.Free; - Exit; - end; - - if (main_element < LZX_NUM_CHARS) then begin - //* literal: 0 to LZX_NUM_CHARS-1 */ - window[window_posn] := Byte(main_element); - Inc(window_posn); - Dec(this_run); - end - else begin - //* match: LZX_NUM_CHARS + ((slot<<3) | length_header (3 bits)) */ - Dec(main_element, LZX_NUM_CHARS); - - match_length := main_element and LZX_NUM_PRIMARY_LENGTHS; - if (match_length = LZX_NUM_PRIMARY_LENGTHS) then begin - if READ_HUFFSYM(@pState^.LengthTable.Table[0], @pState^.LengthTable.Len[0], - bits, inpos, i, j, LZX_LENGTH_TABLEBITS, - LZX_LENGTH_MAXSYMBOLS, length_footer) <> 0 then - begin - Result := DECR_ILLEGALDATA; - bits.Free; - Exit; - end; - Inc(match_length, length_footer); - end; - Inc(match_length, LZX_MIN_MATCH); - - match_offset := main_element shr 3; - - if (match_offset > 2) then begin - //* not repeated offset */ - extra := extra_bits[match_offset]; - match_offset := position_base[match_offset] - 2; - if (extra > 3) then begin - //* verbatim and aligned bits */ - Dec(extra, 3); - verbatim_bits := bits.read(extra, inpos); - Inc(match_offset, (verbatim_bits shl 3)); - if READ_HUFFSYM(@pState^.AlignedTAble.Table[0], @pState^.AlignedTAble.Len[0], - bits, inpos, i, j, LZX_ALIGNED_TABLEBITS, LZX_ALIGNED_MAXSYMBOLS, - aligned_bits) <> 0 then - begin - Result := DECR_ILLEGALDATA; - bits.Free; - Exit; - end; - Inc(match_offset, aligned_bits); - end - else if (extra = 3) then begin - //* aligned bits only */ - if READ_HUFFSYM(@pState^.AlignedTAble.Table[0], @pState^.AlignedTAble.Len[0], - bits, inpos, i, j, LZX_ALIGNED_TABLEBITS, LZX_ALIGNED_MAXSYMBOLS, - aligned_bits) <> 0 then - begin - Result := DECR_ILLEGALDATA; - bits.Free; - Exit; - end; - Inc(match_offset, aligned_bits); - end - else if (extra > 0) then begin //* extra==1, extra==2 */ - //* verbatim bits only */ - verbatim_bits := bits.read(extra, inpos); - Inc(match_offset, verbatim_bits); - end - else begin //* extra == 0 */ - //* ??? */ - match_offset := 1; - end; - - //* update repeated offset LRU queue */ - R2 := R1; - R1 := R0; - R0 := match_offset; - end - else if (match_offset = 0) then begin - match_offset := R0; - end - else if (match_offset = 1) then begin - match_offset := R1; - R1 := R0; - R0 := match_offset; - end - else begin //* match_offset == 2 */ - match_offset := R2; - R2 := R0; - R0 := match_offset; - end; - - rundest := window + window_posn; - runsrc := rundest - match_offset; - Inc(window_posn, match_length); - if (window_posn > window_size) then begin - Result := DECR_ILLEGALDATA; - bits.Free; - Exit; - end; - Dec(this_run, match_length); - - //* copy any wrapped around source data */ - while ((runsrc < window) and (match_length > 0)) do begin - Dec(match_length); - rundest^ := (runsrc + window_size)^; - Inc(rundest); - Inc(runsrc); - end; - //* copy match data - no worries about destination wraps */ - while (match_length > 0) do begin - Dec(match_length); - rundest^ := runsrc^; - Inc(rundest); - Inc(runsrc); - end; - end; - end; - end; - LZX_BLOCKTYPE_UNCOMPRESSED: - begin - if ((inpos + this_run) > endinp) then begin - Result := DECR_ILLEGALDATA; - bits.Free; - Exit; - end; - Move(inpos^, (window + window_posn)^, this_run); - Inc(inpos, this_run); - Inc(window_posn, this_run); - end; - else - Result := DECR_ILLEGALDATA; ///* might as well */ - bits.Free; - Exit; - end; - this_run := pState^.block_remaining; - end; - end; - - if (togo <> 0) then begin - Result := DECR_ILLEGALDATA; - bits.Free; - Exit; - end; - if window_posn = 0 then - Move((window + window_size - outlen)^, outpos^, outlen) - else - Move((window + window_posn - outlen)^, outpos^, outlen); - - pState^.window_posn := window_posn; - pState^.R0 := R0; - pState^.R1 := R1; - pState^.R2 := R2; - - //* intel E8 decoding */ - if ((pState^.frames_read < 32768) and (pState^.intel_filesize <> 0)) then begin - if (outlen <= 6 or not pState^.intel_started) then begin - Inc(pState^.intel_curpos, outlen); - end - else begin - data := outpos; - dataend := data + outlen - 10; - curpos := pState^.intel_curpos; - filesize := pState^.intel_filesize; - - pState^.intel_curpos := curpos + outlen; - - while (data < dataend) do begin - if data^ <> $E8 then begin - Inc(curpos); - Inc(Data); - continue; - end; - Inc(Data); - abs_off := data[0] or (data[1]shl 8) or (data[2]shl 16) or (data[3]shl 24); - - if (abs_off >= curpos-1) and (abs_off < filesize) then begin - if (abs_off >= 0) then - rel_off := abs_off - curpos - else - rel_off := abs_off + filesize; - {$IFDEF ENDIAN_BIG} - PLongWord(data)^ := Swap(rel_off); - {$ELSE} - PLongword(data)^ := rel_off; - {$ENDIF} - end; - Inc(data, 4); - Inc(curpos, 5); - end; - end; - end; - Inc(pState^.frames_read); - bits.Free; - Result := DECR_OK; -end; - -{ TBufBits } - -procedure TBufBits.Init; -begin - bitsleft := 0; - bitbuf := 0; -end; - -procedure TBufBits.ensure(num: LongInt; var inpos:PByte); -begin - while (bitsleft < num) do begin - bitbuf := bitbuf or (((inpos[1]shl 8) or inpos[0]) shl (ULONG_BITS-16 - bitsleft)); - Inc(bitsleft, 16); - Inc(inpos, 2); - end; -end; - -function TBufBits.peek(numbits: LongInt): dword; -begin - Result := bitbuf shr (ULONG_BITS - numbits); -end; - -function TBufBits.remove(numbits: LongInt): dword; -begin - bitbuf := bitbuf shl numbits; - Result := bitbuf; - Dec(bitsleft, numbits); -end; - -function TBufBits.read(numbits: LongInt; var inpos: PByte): dword; -begin - ensure(numbits, inpos); - Result := peek(numbits); - remove(numbits); -end; - -end. - - -