paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 12:39:38 +01:00
Code Issues Packages Projects Releases Wiki Activity
bd69204343
fpc/ide/wwinhelp.pas
pierre d1c220f87d * fix Previous Help Topic
2001-09-18 11:33:53 +00:00

1703 lines
48 KiB
ObjectPascal
Raw Blame History

{
$Id$
This file is part of the Free Pascal Integrated Development Environment
Copyright (c) 2000 by Berczi Gabor
Help support for Windows Help (.HLP) files
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
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.
**********************************************************************}
{$R-}
unit WWinHelp;
interface
uses Objects,
WUtils,WHelp;
const
WinHelpMagicNo = $00035F3F;
WinHelpBTreeHeaderMagicNo = $293B;
WinHelpSystemHeaderMagicNo = $036c;
{ WinHelp Btree dataformat descriptors }
wh_bdf_Long = 'L';
wh_bdf_ASCIIZ = 'F';
wh_bdf_ASCIIZ2 = 'i';
wh_bdf_Short = '2';
wh_bdf_Long2 = '4';
wh_bdf_ASCIIZ3 = 'z';
{ WinHelp system record type }
wh_srt_Title = 1;
wh_srt_Copyright = 2;
wh_srt_Contents = 3;
wh_srt_Config = 4;
wh_srt_Icon = 5;
wh_srt_Window = 6;
wh_srt_Citation = 8;
wh_srt_LangID = 9;
wh_srt_Content = 10;
wh_srt_DefFont = 11;
wh_srt_FtIndex = 12;
wh_srt_Groups = 13;
wh_srt_KeyIndex = 14;
wh_srt_Language = 18;
wh_srt_DLLMaps = 19;
type
PInteger = ^integer;
TWinHelpHeader = packed record
MagicNo : longint;
DirectoryStart : longint;
NonDirectoryStart: longint;
EntireFileSize : longint;
end;
TWinHelpFileEntryHeader = packed record
ReservedSpace : longint;
UsedSpace : longint;
FileFlags : byte;
end;
TWinHelpRecordHeader = packed record
RecordType : word;
DataSize : word;
end;
TWinHelpBTreeHeader = packed record
Magic : word;
Flags : word; { 0x0002 always set, 0x0400 set if directory }
PageSize : word;
DataFormat : array[1..16] of char;
MustBeZero : word; { $0000 }
PageSplits : word;
RootPage : word;
MustBeNegOne : integer; { $ffff }
TotalPages : word;
NumLevels : word;
TotalEntries : word;
Pages : record end;
end;
TWinHelpBTreeIndexHeader = packed record
Unknown : longint;
NumEntries : word; { no of index-entries }
PrevPage : integer;
end;
{
TWinHelpBTreeIndexEntry = packed record
FileName : STRINGZ;
PageNumber : word;
end;
}
TWinHelpBTreeNodeHeader = packed record
Unknown : longint;
NumEntries : word; { no of index-entries }
PrevPage : integer;
NextPage : integer;
end;
TWinHelpSystemHeader = packed record
Magic : word;
Version : word;
Always1 : word;
GenDate : longint;
Flags : word;
end;
TWinHelpPhrIndexHeader = packed record
Magic : longint;
NumEntries : longint;
CompressedSize : longint;
PhrImageSize : longint;
PhrImageCompressedSize: longint;
Always0 : longint;
BitCount_Unk : word; { BitCount = lower 4 bits }
Dunno : word;
end;
TWinHelpTopicBlockHeader = packed record
LastTopicLink : longint;
FirstTopicLink : longint;
LastTopicHeader : longint;
end;
TWinHelpTopicBlock = packed record
Header : TWinHelpTopicBlockHeader;
Data : record end;
end;
TWinHelpTopicHeader = packed record
BlockSize : longint;
PrevOffset : longint; { prev topic }
NextOffset : longint; { next topic }
TopicNumber : longint;
NonScrollRgnOfs : longint; { start of non-scrolling region (topic ofs) }
ScrollRgnOfs : longint; { topic ofs }
NextTopic : longint; { next type 2 record }
end;
TWinHelpTopicLink = packed record
BlockSize : longint;
DataLen2 : longint;
PrevBlock : longint;
NextBlock : longint;
DataLen1 : longint;
RecordType : byte;
end;
TTopicBlock = object
Header : TWinHelpTopicBlockHeader;
DataSize : longint;
DataPtr : PByteArray;
private
CurOfs: longint;
procedure Seek(Pos: longint);
function GetPos: longint;
function GetSize: longint;
procedure Read(var Buf; Count: longint);
end;
PTopicEnumData = ^TTopicEnumData;
TTopicEnumData = record
TB : TTopicBlock;
BlockNo : longint;
TopicPos: longint;
TopicOfs: longint;
TL : TWinHelpTopicLink;
LinkData1Size: longint;
LinkData1: PByteArray;
LinkData2Size: longint;
LinkData2: PByteArray;
end;
PWinHelpFile = ^TWinHelpFile;
TWinHelpFile = object(THelpFile)
constructor Init(AFileName: string; AID: word);
destructor Done; virtual;
public
function LoadIndex: boolean; virtual;
function ReadTopic(T: PTopic): boolean; virtual;
private
F: PStream;
Header: TWinHelpHeader;
SysHeader: TWinHelpSystemHeader;
Title: string;
CNTFileName: string;
PhrasesStart: longint;
TTLBTreeStart: longint;
TopicFileStart: longint;
PhrIndexStart: longint;
PhrImageStart: longint;
Phrases: PUnsortedStringCollection;
TreeDone: boolean;
IndexLoaded: boolean;
function ReadHeader: boolean;
function ReadInternalDirectory: boolean;
function ProcessLeafPage(PagesBase: longint; PageSize,PageNo,TotalPages: word;
ReadLeafEntryMethod: pointer; ScannedPages: PIntCollection): boolean;
function ProcessIndexPage(CurLevel,MaxLevel: integer; PagesBase: longint; PageSize: word; PageNo,
TotalPages: word; ReadIndexEntryMethod, ReadLeafEntryMethod: pointer;
ScannedPages: PIntCollection): boolean;
function ProcessTree(ReadIndexEntryMethod, ReadLeafEntryMethod: pointer; NoDuplicates: boolean): boolean;
function IDIRReadIndexEntry(SubPageNo: PInteger): boolean;
function IDIRReadLeafEntry(P: pointer): boolean;
function IDIRProcessFile(const FileName: string; FileOfs: longint): boolean;
function TTLBReadIndexEntry(SubPageNo: PInteger): boolean;
function TTLBReadLeafEntry(P: pointer): boolean;
function TTLBProcessTopicEntry(const TopicTitle: string; FileOfs: longint): boolean;
function ReadSystemFile: boolean;
function ReadPhraseFile: boolean;
function ReadTTLBTree: boolean;
function ReadPhrIndexFile(PhraseOfs: PIntCollection; var IH: TWinHelpPhrIndexHeader): boolean;
function ReadPhrImageFile(PhraseOfs: PIntCollection; const IH: TWinHelpPhrIndexHeader): boolean;
function TopicBlockSize: word;
function LZ77Compressed: boolean;
function UsesHallCompression: boolean;
procedure ExtractTopicOffset(TopicOffset: longint; var TopicBlockNo, TopicBlockOffset: word);
function ReadTopicBlock(BlockNo: word; var T: TTopicBlock; ReadData: boolean): boolean;
function ProcessTopicBlock(BlockNo: longint; EnumProc: pointer): boolean;
procedure PhraseDecompress(SrcBufP: pointer; SrcBufSize: longint; DestBufP: pointer; DestBufSize: longint);
procedure HallDecompress(SrcBufP: pointer; SrcBufSize: longint; DestBufP: pointer; DestBufSize: longint);
end;
procedure RegisterHelpType;
implementation
uses {Crt,}Strings,CallSpec;
function ReadString(F: PStream): string;
var S: string;
C: char;
begin
S:='';
if Assigned(F) then
repeat
F^.Read(C,sizeof(C));
if (F^.Status=stOK) and (C<>#0) then
S:=S+C;
until (C=#0) or (F^.Status<>stOK);
ReadString:=S;
end;
function TTopicBlock.GetPos: longint;
begin
GetPos:=CurOfs;
end;
function TTopicBlock.GetSize: longint;
begin
GetSize:=DataSize;
end;
procedure TTopicBlock.Seek(Pos: longint);
begin
CurOfs:=Pos;
end;
procedure TTopicBlock.Read(var Buf; Count: longint);
begin
FillChar(Buf,Sizeof(Buf),Count);
if Count>(DataSize-CurOfs) then
begin
Count:=Max(0,DataSize-CurOfs);
end;
Move(DataPtr^[CurOfs],Buf,Count);
Inc(CurOfs,Count);
end;
constructor TWinHelpFile.Init(AFileName: string; AID: word);
var OK: boolean;
begin
if inherited Init(AID)=false then Fail;
New(Phrases, Init(1000,1000));
F:=New(PFastBufStream, Init(AFileName, stOpenRead, HelpStreamBufSize));
OK:=F<>nil;
if OK then OK:=(F^.Status=stOK);
if OK then
begin
OK:=ReadHeader;
end;
if OK=false then
begin
Done;
Fail;
end;
end;
function TWinHelpFile.ReadHeader: boolean;
var OK: boolean;
begin
F^.Read(Header,sizeof(Header));
OK:=(F^.Status=stOK);
OK:=OK and (Header.MagicNo=WinHelpMagicNo);
if OK then
begin
F^.Seek(Header.DirectoryStart);
OK:=(F^.Status=stOK);
end;
if OK then
OK:=ReadInternalDirectory;
ReadHeader:=OK;
end;
function TWinHelpFile.TopicBlockSize: word;
var Size: word;
begin
if (SysHeader.Version<=16) then
Size:=2048 else
if (SysHeader.Flags in[0,4]) then
Size:=4096
else
Size:=2048;
TopicBlockSize:=Size;
end;
function TWinHelpFile.LZ77Compressed: boolean;
begin
LZ77Compressed:=(SysHeader.Version>16) and (SysHeader.Flags<>0);
end;
function TWinHelpFile.UsesHallCompression: boolean;
begin
UsesHallCompression:=(PhrIndexStart<>0) and (PhrImageStart<>0);
end;
function TWinHelpFile.ReadSystemFile: boolean;
var OK: boolean;
FH: TWinHelpFileEntryHeader;
RH: TWinHelpRecordHeader;
StartOfs,RecStartOfs: longint;
begin
F^.Read(FH,sizeof(FH));
OK:=(F^.Status=stOK);
StartOfs:=F^.GetPos;
F^.Read(SysHeader,sizeof(SysHeader));
OK:=OK and (F^.Status=stOK);
OK:=OK and (SysHeader.Magic=WinHelpSystemHeaderMagicNo);
if OK then
if SysHeader.Version>16 then
begin
repeat
F^.Read(RH,sizeof(RH));
OK:=(F^.Status=stOK);
RecStartOfs:=F^.GetPos;
if OK then
begin
case RH.RecordType of
wh_srt_Title : Title:=ReadString(F);
wh_srt_Content : CNTFileName:=ReadString(F);
end;
if F^.GetPos<>RecStartOfs+RH.DataSize then
F^.Seek(RecStartOfs+RH.DataSize);
OK:=(F^.Status=stOK);
end;
until (OK=false) or (F^.GetPos>=StartOfs+FH.UsedSpace);
end
else
Title:=ReadString(F);
OK:=OK and (F^.Status=stOK);
ReadSystemFile:=OK;
end;
function LZ77Decompress(SrcBufP: pointer; SrcSize: longint; DestBufP: pointer; DestSize: longint): longint;
var SrcBuf: PByteArray absolute SrcBufP;
DestBuf: PByteArray absolute DestBufP;
var SrcOfs: longint;
function GetByte: byte;
begin
GetByte:=PByteArray(SrcBuf)^[SrcOfs];
Inc(SrcOfs);
end;
var DestOfs: longint;
procedure PutByte(B: byte);
begin
PByteArray(DestBuf)^[DestOfs]:=B;
Inc(DestOfs);
end;
var B,Mask: byte;
Len,J: word;
I: integer;
const N = 4096; F=16;
begin
SrcOfs:=0; DestOfs:=0; I:=N-F;
while (SrcOfs<SrcSize) do
begin
B:=GetByte;
for Mask:=0 to 7 do
begin
if SrcOfs=SrcSize then Break;
if (B and (1 shl Mask))<>0 then
begin
J:=GetByte;
Len:=GetByte;
J:=J+(Len and $0f) shl 8;
Len:=(Len and $f0) shr 4+3;
while (Len>0) do
begin
PutByte(PByteArray(DestBuf)^[DestOfs-J-1]);
{Inc(J); }Inc(I);
Dec(Len);
end;
end
else
begin
PutByte(GetByte);
I:=(I+1) and (N-1);
end;
end;
end;
LZ77Decompress:=DestOfs;
end;
function TWinHelpFile.ReadPhraseFile: boolean;
var OK: boolean;
FH: TWinHelpFileEntryHeader;
NumPhrases: word;
DecompSize: longint;
W: word;
PhraseOfss: PWordArray;
PhraseOfssSize: word;
PhraseBuf: PByteArray;
TempBuf: pointer;
TempSize: longint;
I,PhraseBufSize,PhraseOfs,PhraseSize: longint;
S: string;
begin
F^.Read(FH,sizeof(FH));
OK:=(F^.Status=stOK);
F^.Read(NumPhrases,sizeof(NumPhrases));
F^.Read(W,sizeof(W));
OK:=(F^.Status=stOK) and (W=$0100);
if OK then
begin
PhraseOfssSize:=(NumPhrases+1)*sizeof(word);
GetMem(PhraseOfss,PhraseOfssSize);
F^.Read(W,sizeof(W));
if W=2*(NumPhrases+1) then
begin
{ uncompressed data }
PhraseOfss^[0]:=W;
F^.Read(PhraseOfss^[1],PhraseOfssSize-sizeof(word)*1);
DecompSize:=FH.UsedSpace-(PhraseOfssSize+2+2+2);
PhraseBufSize:=DecompSize;
GetMem(PhraseBuf,PhraseBufSize);
F^.Read(PhraseBuf^,DecompSize);
end
else
begin
DecompSize:=W;
F^.Read(W,sizeof(W));
DecompSize:=DecompSize+longint(W) shl 16;
Inc(DecompSize);
PhraseOfss^[0]:=DecompSize;
F^.Read(PhraseOfss^[1],PhraseOfssSize);
PhraseBufSize:=DecompSize+10;
GetMem(PhraseBuf,PhraseBufSize); FillChar(PhraseBuf^,DecompSize,0);
TempSize:=FH.UsedSpace-(PhraseOfssSize+2+2+2);
GetMem(TempBuf,TempSize);
F^.Read(TempBuf^,TempSize);
LZ77Decompress(TempBuf,TempSize,PhraseBuf,DecompSize);
FreeMem(TempBuf,TempSize);
end;
for I:=1 to NumPhrases do
begin
PhraseOfs:=PhraseOfss^[I]-PhraseOfss^[1];
if I=NumPhrases then
PhraseSize:=DecompSize-PhraseOfs
else
PhraseSize:=PhraseOfss^[I+1]-PhraseOfss^[I];
S:=MemToStr(PhraseBuf^[PhraseOfs],PhraseSize);
Phrases^.InsertStr(S);
end;
FreeMem(PhraseOfss,PhraseOfssSize);
FreeMem(PhraseBuf,PhraseBufSize);
end;
ReadPhraseFile:=OK;
end;
function TWinHelpFile.ProcessLeafPage(PagesBase: longint; PageSize,PageNo,TotalPages: word;
ReadLeafEntryMethod: pointer; ScannedPages: PIntCollection): boolean;
var OK: boolean;
BNH: TWinHelpBTreeNodeHeader;
Count: longint;
PageOfs: longint;
CurPage: longint;
begin
CurPage:=PageNo;
repeat
PageOfs:=PagesBase+longint(PageSize)*CurPage;
F^.Seek(PageOfs);
OK:=(F^.Status=stOK);
if OK then
begin
F^.Read(BNH,sizeof(BNH));
OK:=(F^.Status=stOK);
end;
if OK then
if (ScannedPages<>nil) and ScannedPages^.Contains(CurPage) then
Break
else
begin
if Assigned(ScannedPages) then ScannedPages^.Add(CurPage);
Count:=0;
repeat
TreeDone:=not (longint(CallPointerMethod(ReadLeafEntryMethod,@Self,nil))<>0);
Inc(Count);
until (OK=false) or (F^.Status<>stOK) or TreeDone or (Count>=BNH.NumEntries){ or
(F^.GetPos>=PageOfs+PageSize-BNH.NumEntries)};
end;
if (BNH.PrevPage<>-1) and (TreeDone=false) then
CurPage:=BNH.PrevPage;
until (OK=false) or TreeDone or (BNH.PrevPage=-1);
ProcessLeafPage:=OK;
end;
function TWinHelpFile.ProcessIndexPage(CurLevel,MaxLevel: integer; PagesBase: longint; PageSize: word; PageNo,
TotalPages: word; ReadIndexEntryMethod, ReadLeafEntryMethod: pointer; ScannedPages: PIntCollection): boolean;
var BIH: TWinHelpBTreeIndexHeader;
I: integer;
SubPageNo: integer;
OK: boolean;
OldPos: longint;
CurPage: longint;
begin
CurPage:=PageNo;
repeat
F^.Seek(PagesBase+longint(PageSize)*CurPage);
OK:=(F^.Status=stOK);
if OK then
begin
F^.Read(BIH,sizeof(BIH));
OK:=(F^.Status=stOK);
end;
if OK then
if (ScannedPages<>nil) and ScannedPages^.Contains(CurPage) then
Break
else
begin
if Assigned(ScannedPages) then ScannedPages^.Add(CurPage);
for I:=1 to BIH.NumEntries do
begin
SubPageNo:=-1;
OK:=(longint(CallPointerMethod(ReadIndexEntryMethod,@Self,@SubPageNo))<>0);
OK:=OK and (F^.Status=stOK);
if OK then
if CurLevel<MaxLevel-1 then
begin
if (0<=SubPageNo) then
if (ScannedPages=nil) or (ScannedPages^.Contains(SubPageNo)=false) then
begin
OldPos:=F^.GetPos;
OK:=ProcessIndexPage(CurLevel+1,MaxLevel,PagesBase,PageSize,SubPageNo,TotalPages,
ReadIndexEntryMethod,ReadLeafEntryMethod,ScannedPages);
if F^.GetPos<>OldPos then
F^.Seek(OldPos);
end
end
else
{ process leaf page }
if (0<=SubPageNo) then
if (ScannedPages=nil) or (ScannedPages^.Contains(SubPageNo)=false) then
begin
OldPos:=F^.GetPos;
OK:=ProcessLeafPage(PagesBase,PageSize,SubPageNo,TotalPages,ReadLeafEntryMethod,ScannedPages);
if F^.GetPos<>OldPos then
F^.Seek(OldPos);
end;
if TreeDone then
Break;
end;
end;
if (BIH.PrevPage>0) and (TreeDone=false) then
CurPage:=BIH.PrevPage
else
Break;
until (OK=false) or TreeDone;
ProcessIndexPage:=OK;
end;
function TWinHelpFile.ProcessTree(ReadIndexEntryMethod, ReadLeafEntryMethod: pointer; NoDuplicates: boolean): boolean;
var BTH: TWinHelpBTreeHeader;
OK: boolean;
PagesBase: longint;
ScannedPages: PIntCollection;
begin
ScannedPages:=nil;
TreeDone:=false;
F^.Read(BTH,sizeof(BTH));
OK:=(F^.Status=stOK);
PagesBase:=F^.GetPos;
if OK then
begin
OK:=(BTH.Magic=WinHelpBTreeHeaderMagicNo) and
(BTH.MustBeZero=0) and
(BTH.MustBeNegOne=-1);
end;
if OK then
begin
if NoDuplicates then
New(ScannedPages, Init(500,100));
if BTH.NumLevels>1 then
begin
OK:=ProcessIndexPage(1,BTH.NumLevels,PagesBase,BTH.PageSize,BTH.RootPage,BTH.TotalPages,
ReadIndexEntryMethod,ReadLeafEntryMethod,ScannedPages);
end
else
OK:=ProcessLeafPage(PagesBase,BTH.PageSize,BTH.RootPage,BTH.TotalPages,ReadLeafEntryMethod,ScannedPAges);
if Assigned(ScannedPages) then
Dispose(ScannedPages, Done);
end;
ProcessTree:=OK;
end;
(*function TWinHelpFile.IDIRProcessFile(const FileName: string; FileOfs: longint): boolean;
var OK: boolean;
begin
OK:=true;
if FileName='|SYSTEM' then
begin
F^.Seek(FileOfs); OK:=(F^.Status=stOK);
if OK then OK:=ReadSystemFile;
end else
if (FileName='|Phrases') then
begin
PhrasesStart:=FileOfs;
end else
;
IDIRProcessFile:=OK;
end;
function TWinHelpFile.IDIRProcessLeafPage(PagesBase: longint; PageSize,PageNo,TotalPages: word): boolean;
var OK: boolean;
BNH: TWinHelpBTreeNodeHeader;
FileOfs: longint;
Count: integer;
S: string;
CurOfs,PageOfs,OldPos: longint;
begin
PageOfs:=PagesBase+PageSize*PageNo;
F^.Seek(PageOfs);
OK:=(F^.Status=stOK);
repeat
if OK then
begin
F^.Read(BNH,sizeof(BNH));
OK:=(F^.Status=stOK);
end;
if OK then
begin
Count:=0;
repeat
S:=ReadString(F);
F^.Read(FileOfs,sizeof(FileOfs)); { longint }
OK:=OK and (F^.Status=stOK);
if OK then
begin
OldPos:=F^.GetPos;
OK:=IDIRProcessFile(S,FileOfs);
if F^.GetPos<>OldPos then
F^.Seek(OldPos);
end;
Inc(Count);
until (OK=false) or (Count=BNH.NumEntries){ or (F^.GetPos>=PageOfs+PageSize-BNH.NumEntries)};
end;
if BNH.PrevPage<>-1 then
begin
F^.Seek(PagesBase+PageSize*BNH.PrevPage);
OK:=(F^.Status=stOK);
end;
until (OK=false) or (BNH.PrevPage=-1);
IDIRProcessLeafPage:=OK;
end;
function TWinHelpFile.IDIRProcessIndexPage(CurLevel,MaxLevel: integer; PagesBase: longint; PageSize: word; PageNo,
TotalPages: word): boolean;
var BIH: TWinHelpBTreeIndexHeader;
I: integer;
SubPageNo: integer;
OK: boolean;
S: string;
OldPos: longint;
begin
F^.Seek(PagesBase+PageSize*PageNo);
OK:=(F^.Status=stOK);
repeat
if OK then
begin
F^.Read(BIH,sizeof(BIH));
OK:=(F^.Status=stOK);
end;
if OK then
for I:=1 to BIH.NumEntries do
begin
S:=ReadString(F);
F^.Read(SubPageNo,sizeof(SubPageNo)); { word }
OK:=OK and (F^.Status=stOK);
if OK then
if CurLevel<MaxLevel-1 then
begin
if (0<=SubPageNo) then
begin
OldPos:=F^.GetPos;
OK:=IDIRProcessIndexPage(CurLevel+1,MaxLevel,PagesBase,PageSize,SubPageNo,TotalPages);
if F^.GetPos<>OldPos then
F^.Seek(OldPos);
end
end
else
{ process leaf page }
if (0<=SubPageNo) then
OK:=IDIRProcessLeafPage(PagesBase,PageSize,SubPageNo,TotalPages);
end;
if (BIH.PrevPage>0) then
begin
F^.Seek(PagesBase+PageSize*BIH.PrevPage);
OK:=(F^.Status=stOK);
end
else
Break;
until (OK=false);
IDIRProcessIndexPage:=OK;
end;
function TWinHelpFile.ReadInternalDirectory: boolean;
var BTH: TWinHelpBTreeHeader;
OK: boolean;
PagesBase: longint;
begin
F^.Read(BTH,sizeof(BTH));
OK:=(F^.Status=stOK);
PagesBase:=F^.GetPos;
if OK then
begin
OK:=(BTH.Magic=WinHelpBTreeHeaderMagicNo) and
(BTH.MustBeZero=0) and
(BTH.MustBeNegOne=-1);
end;
if BTH.NumLevels>1 then
OK:=IDIRProcessIndexPage(1,BTH.NumLevels,PagesBase,BTH.PageSize,BTH.RootPage,BTH.TotalPages)
else
OK:=IDIRProcessLeafPage(PagesBase,BTH.PageSize,BTH.RootPage,BTH.TotalPages);
ReadInternalDirectory:=OK;
end;
*)
function TWinHelpFile.IDIRProcessFile(const FileName: string; FileOfs: longint): boolean;
var OK: boolean;
begin
OK:=true;
if FileName='|SYSTEM' then
begin
F^.Seek(FileOfs); OK:=(F^.Status=stOK);
if OK then OK:=ReadSystemFile;
end else
if (FileName='|Phrases') then begin PhrasesStart:=FileOfs; end else
if (FileName='|TOPIC') then begin TopicFileStart:=FileOfs; end else
if (FileName='|TTLBTREE') then begin TTLBTreeStart:=FileOfs; end else
if (FileName='|PhrIndex') then begin PhrIndexStart:=FileOfs; end else
if (FileName='|PhrImage') then begin PhrImageStart:=FileOfs; end else
;
IDIRProcessFile:=OK;
end;
function TWinHelpFile.IDIRReadIndexEntry(SubPageNo: PInteger): boolean;
var {S: string;}
OK: boolean;
begin
{S:=}ReadString(F);
F^.Read(SubPageNo^,sizeof(SubPageNo^));
OK:=(F^.Status=stOK);
IDIRReadIndexEntry:=OK;
end;
function TWinHelpFile.IDIRReadLeafEntry(P: pointer): boolean;
var OK: boolean;
S: string;
FileOfs,OldPos: longint;
begin
S:=ReadString(F);
F^.Read(FileOfs,sizeof(FileOfs)); { longint }
OK:=(F^.Status=stOK);
if OK then
begin
OldPos:=F^.GetPos;
OK:=IDIRProcessFile(S,FileOfs);
if F^.GetPos<>OldPos then
F^.Seek(OldPos);
OK:=OK and (F^.Status=stOK);
end;
IDIRReadLeafEntry:=OK;
end;
function TWinHelpFile.ReadInternalDirectory: boolean;
var OK: boolean;
FH: TWinHelpFileEntryHeader;
begin
F^.Read(FH,sizeof(FH));
OK:=(F^.Status=stOK);
if OK then
OK:=ProcessTree(@TWinHelpFile.IDIRReadIndexEntry,@TWinHelpFile.IDIRReadLeafEntry,true);
ReadInternalDirectory:=OK;
end;
function TWinHelpFile.TTLBReadIndexEntry(SubPageNo: PInteger): boolean;
var TopicOffset: longint;
OK: boolean;
begin
F^.Read(TopicOffset,sizeof(TopicOffset));
F^.Read(SubPageNo^,sizeof(SubPageNo^));
OK:=(F^.Status=stOK);
TTLBReadIndexEntry:=OK;
end;
function TWinHelpFile.TTLBReadLeafEntry(P: pointer): boolean;
var OK: boolean;
S: string;
TopicOfs,OldPos: longint;
begin
F^.Read(TopicOfs,sizeof(TopicOfs)); { longint }
S:=ReadString(F);
OK:=(F^.Status=stOK);
if OK then
begin
OldPos:=F^.GetPos;
OK:=TTLBProcessTopicEntry(S,TopicOfs);
if F^.GetPos<>OldPos then
F^.Seek(OldPos);
OK:=OK and (F^.Status=stOK);
end;
TTLBReadLeafEntry:=OK;
end;
function TWinHelpFile.TTLBProcessTopicEntry(const TopicTitle: string; FileOfs: longint): boolean;
var OK: boolean;
{const Count: longint = 0;}
begin
{ Inc(Count);
if (Count mod 100)=1 then
begin
gotoxy(1,1); write(Count,' - ',IndexEntries^.Count,' - ',Topics^.Count);
end;}
OK:=(IndexEntries^.Count<MaxCollectionSize-10);
if OK then
begin
if (TopicTitle<>'') and (FileOfs>=0) then
begin
AddIndexEntry(TopicTitle,FileOfs);
AddTopic(FileOfs,FileOfs,'',nil,0);
end;
end;
TTLBProcessTopicEntry:=OK;
end;
function TWinHelpFile.ReadTTLBTree: boolean;
var OK: boolean;
FH: TWinHelpFileEntryHeader;
begin
F^.Read(FH,sizeof(FH));
OK:=(F^.Status=stOK);
if OK then
OK:=ProcessTree(@TWinHelpFile.TTLBReadIndexEntry,@TWinHelpFile.TTLBReadLeafEntry,true);
ReadTTLBTree:=OK;
end;
function TWinHelpFile.ReadPhrIndexFile(PhraseOfs: PIntCollection; var IH: TWinHelpPhrIndexHeader): boolean;
var OK: boolean;
FH: TWinHelpFileEntryHeader;
TotalBitPos,BufBitPos: longint;
BitBuf: array[0..1023] of byte;
CurFrag: word;
function GetBit: integer;
begin
BufBitPos:=(TotalBitPos mod ((High(BitBuf)-Low(BitBuf)+1)*8));
if (BufBitPos=0) then
begin
CurFrag:=Min(sizeof(BitBuf),FH.UsedSpace-(TotalBitPos div 8));
F^.Read(BitBuf,CurFrag);
OK:=OK and (F^.Status=stOK);
end;
if (BitBuf[Low(BitBuf)+BufBitPos div 8] and (1 shl (BufBitPos mod 8)))<>0 then
GetBit:=1
else
GetBit:=0;
Inc(TotalBitPos);
end;
var Delta: longint;
I,J,LastOfs: longint;
BitCount: integer;
begin
F^.Read(FH,sizeof(FH));
OK:=(F^.Status=stOK);
if OK then
begin
F^.Read(IH,sizeof(IH));
OK:=(F^.Status=stOK) and (IH.Magic=1);
end;
if OK then
begin
PhraseOfs^.Add(0);
TotalBitPos:=0; LastOfs:=0; BitCount:=(IH.BitCount_Unk and $0f);
for I:=1 to IH.NumEntries do
begin
Delta:=1;
while GetBit=1 do
Delta:=Delta+(1 shl BitCount);
for J:=0 to BitCount-1 do
Delta:=Delta+(1 shl J)*GetBit;
Inc(LastOfs,Delta);
PhraseOfs^.Add(LastOfs);
end;
end;
ReadPhrIndexFile:=OK;
end;
function TWinHelpFile.ReadPhrImageFile(PhraseOfs: PIntCollection; const IH: TWinHelpPhrIndexHeader): boolean;
var OK: boolean;
FH: TWinHelpFileEntryHeader;
PhraseBufSize: longint;
PhraseBuf: PByteArray;
TempBufSize: longint;
TempBuf: pointer;
CurOfs,NextOfs: longint;
I: longint;
begin
F^.Read(FH,sizeof(FH));
OK:=(F^.Status=stOK);
OK:=OK and (IH.PhrImageCompressedSize=FH.UsedSpace);
if OK then
begin
PhraseBufSize:=IH.PhrImageSize;
GetMem(PhraseBuf,PhraseBufSize);
if IH.PhrImageSize=IH.PhrImageCompressedSize then
begin
F^.Read(PhraseBuf^,PhraseBufSize);
end
else
begin
TempBufSize:=IH.PhrImageCompressedSize;
GetMem(TempBuf,TempBufSize);
F^.Read(TempBuf^,TempBufSize);
OK:=(F^.Status=stOK);
if OK then LZ77Decompress(TempBuf,TempBufSize,PhraseBuf,PhraseBufSize);
FreeMem(TempBuf,TempBufSize);
end;
if OK then
begin
for I:=1 to IH.NumEntries do
begin
CurOfs:=PhraseOfs^.AtInt(I-1);
NextOfs:=PhraseOfs^.AtInt(I);
Phrases^.InsertStr(MemToStr(PhraseBuf^[CurOfs],NextOfs-CurOfs));
end;
end;
FreeMem(PhraseBuf,PhraseBufSize);
end;
ReadPhrImageFile:=OK;
end;
function TWinHelpFile.LoadIndex: boolean;
var OK: boolean;
PO: PIntCollection;
IH: TWinHelpPhrIndexHeader;
begin
if IndexLoaded then OK:=true else
begin
if PhrasesStart<>0 then
begin
F^.Seek(PhrasesStart); OK:=(F^.Status=stOK);
if OK then OK:=ReadPhraseFile;
end else
if (PhrIndexStart<>0) and (PhrImageStart<>0) then
begin
New(PO, Init(1000,1000));
F^.Seek(PhrIndexStart); OK:=(F^.Status=stOK);
if OK then OK:=ReadPhrIndexFile(PO,IH);
if OK then begin F^.Seek(PhrImageStart); OK:=(F^.Status=stOK); end;
if OK then OK:=ReadPhrImageFile(PO,IH);
Dispose(PO, Done);
end;
if TTLBTreeStart<>0 then
begin
F^.Seek(TTLBTreeStart); OK:=(F^.Status=stOK);
if OK then OK:=ReadTTLBTree;
end;
IndexLoaded:=OK;
end;
LoadIndex:=OK;
end;
procedure TWinHelpFile.ExtractTopicOffset(TopicOffset: longint; var TopicBlockNo, TopicBlockOffset: word);
var {OfsBitCount: longint;
OfsMask: longint;}
BS: longint;
begin
{ if LZ77Compressed then
BS:=32768
else
BS:=TopicBlockSize;}
BS:=32768;
{ for OfsBitCount:=0 to 31 do
if (1 shl OfsBitCount)=BS then
Break;
OfsMask:=(1 shl OfsBitCount)-1;
TopicBlockNo:=(TopicOffset and not OfsMask) shr OfsBitCount;
TopicBlockOffset:=(TopicOffset and OfsMask);}
TopicBlockNo:=TopicOffset div BS;
TopicBlockOffset:=TopicOffset mod BS;
end;
function TWinHelpFile.ReadTopicBlock(BlockNo: word; var T: TTopicBlock; ReadData: boolean): boolean;
var TempBuf: pointer;
BlockBuf: ^TWinHelpTopicBlock;
OK: boolean;
RS,DecompSize: longint;
const TempBufSize = 16384;
begin
F^.Reset;
FillChar(T,sizeof(T),0);
F^.Seek(TopicFileStart+sizeof(TWinHelpFileEntryHeader)+longint(BlockNo)*TopicBlockSize);
OK:=(F^.Status=stOK);
if OK then
if ReadData=false then
begin
F^.Read(T.Header,sizeof(T.Header));
OK:=(F^.Status=stOK);
end
else
begin
GetMem(BlockBuf, TopicBlockSize);
F^.Read(BlockBuf^,TopicBlockSize);
OK:=(F^.Status=stOK);
if OK then
begin
Move(BlockBuf^.Header,T.Header,sizeof(T.Header));
if LZ77Compressed then
begin
GetMem(TempBuf,TempBufSize);
DecompSize:=LZ77Decompress(@BlockBuf^.Data,TopicBlockSize-sizeof(BlockBuf^.Header),TempBuf,TempBufSize);
T.DataSize:=DecompSize;
GetMem(T.DataPtr,T.DataSize);
Move(TempBuf^,T.DataPtr^,T.DataSize);
FreeMem(TempBuf,TempBufSize);
end
else
begin
T.DataSize:=TopicBlockSize-sizeof(BlockBuf^.Header);
GetMem(T.DataPtr,T.DataSize);
Move(BlockBuf^.Data,T.DataPtr^,T.DataSize);
end;
end;
FreeMem(BlockBuf,TopicBlockSize);
end;
ReadTopicBlock:=OK;
end;
procedure FreeTopicBlock(T: TTopicBlock);
begin
if (T.DataSize>0) and (T.DataPtr<>nil) then
begin
FreeMem(T.DataPtr,T.DataSize);
T.DataPtr:=nil;
end;
end;
procedure TWinHelpFile.PhraseDecompress(SrcBufP: pointer; SrcBufSize: longint; DestBufP: pointer; DestBufSize: longint);
var SrcBuf: PByteArray absolute SrcBufP;
DestBuf: PByteArray absolute DestBufP;
var SrcOfs: longint;
function GetByte: byte;
begin
GetByte:=SrcBuf^[SrcOfs];
Inc(SrcOfs);
end;
var DestOfs: longint;
procedure PutByte(B: byte);
begin
if DestOfs<DestBufSize then
DestBuf^[DestOfs]:=B;
Inc(DestOfs);
end;
var B: byte;
I,Index: longint;
S: string;
begin
SrcOfs:=0; DestOfs:=0;
while (SrcOfs<SrcBufSize) do
begin
B:=GetByte;
if (B=0) or (B>15) then
PutByte(B)
else
begin
Index:=longint(B)*256-256+GetByte;
S:=GetStr(Phrases^.At(Index div 2));
if (Index mod 2)=1 then S:=S+' ';
for I:=1 to length(S) do
PutByte(ord(S[I]));
end;
end;
end;
procedure TWinHelpFile.HallDecompress(SrcBufP: pointer; SrcBufSize: longint; DestBufP: pointer; DestBufSize: longint);
var SrcBuf: PByteArray absolute SrcBufP;
DestBuf: PByteArray absolute DestBufP;
var SrcOfs: longint;
function GetByte: byte;
begin
GetByte:=SrcBuf^[SrcOfs];
Inc(SrcOfs);
end;
var DestOfs: longint;
procedure PutByte(B: byte);
begin
if DestOfs<DestBufSize then
DestBuf^[DestOfs]:=B;
Inc(DestOfs);
end;
procedure EmitStr(const S: string);
var I: longint;
begin
for I:=1 to length(S) do
PutByte(ord(S[I]));
end;
procedure EmitStrIndex(Index: longint);
begin
EmitStr(GetStr(Phrases^.At(Index)));
end;
var B: longint;
I,Index: longint;
S: string;
begin
SrcOfs:=0; DestOfs:=0;
while (SrcOfs<SrcBufSize) do
begin
B:=GetByte;
if (B and 1)=0 then
EmitStrIndex(B div 2)
else
if (B and 3)=1 then
EmitStrIndex(B*64+64+GetByte)
else
if (B and 7)=3 then
for I:=1 to (B div 8)+1 do
PutByte(GetByte)
else
if (B and 15)=7 then
EmitStr(CharStr(' ',B div 16+1))
else
EmitStr(CharStr(#0,B div 16+1));
end;
end;
function TWinHelpFile.ProcessTopicBlock(BlockNo: longint; EnumProc: pointer): boolean;
var TB: TTopicBlock;
TL: TWinHelpTopicLink;
BlockFileOfs: longint;
LinkData1Size: longint;
LinkData1: PByteArray;
LinkData2Size: longint;
LinkData2: PByteArray;
TempBufSize: longint;
TempBuf: PByteArray;
CurBlockOfs,LastLinkOfs: longint;
TopicPos,TopicOfs: longint;
OK: boolean;
TEN: TTopicEnumData;
DoCont: boolean;
begin
OK:=ReadTopicBlock(BlockNo,TB,true);
if OK then
begin
TopicOfs:=0; DoCont:=true;
BlockFileOfs:=longint(BlockNo)*TopicBlockSize;
if TB.Header.FirstTopicLink>0 then
TB.Seek((TB.Header.FirstTopicLink and $3fff)-sizeof(TB.Header));
if TB.Header.LastTopicLink=-1 then
LastLinkOfs:=TB.DataSize-1-sizeof(TL)
else
LastLinkOfs:={(TB.Header.LastTopicLink-BlockFileOfs-sizeof(TB.Header))}TB.GetSize-1;
while (DoCont) and OK and (TB.GetPos<=LastLinkOfs) do
begin
CurBlockOfs:=TB.GetPos;
TopicPos:=TB.GetPos+sizeof(TB.Header);
TB.Read(TL,sizeof(TL));
if (TL.BlockSize=0) or (TL.DataLen1=0) or (TB.GetPos>LastLinkOfs) or
(TB.GetSize-TB.GetPos<TL.BlockSize) then
Break;
LinkData1Size:=TL.DataLen1-sizeof(TL);
GetMem(LinkData1,LinkData1Size);
TB.Read(LinkData1^,LinkData1Size);
LinkData2Size:=TL.DataLen2;
GetMem(LinkData2,LinkData2Size);
if TL.DataLen2>TL.BlockSize-TL.DataLen1 then
begin
TempBufSize:=TL.BlockSize-TL.DataLen1;
GetMem(TempBuf,TempBufSize);
TB.Read(TempBuf^,TempBufSize);
if UsesHallCompression then
HallDecompress(TempBuf,TempBufSize,LinkData2,LinkData2Size)
else
PhraseDecompress(TempBuf,TempBufSize,LinkData2,LinkData2Size);
FreeMem(TempBuf,TempBufSize);
end
else
TB.Read(LinkData2^,TL.DataLen2);
FillChar(TEN,sizeof(TEN),0);
TEN.TB:=TB;
TEN.BlockNo:=BlockNo;
TEN.TopicPos:=TopicPos;
TEN.TopicOfs:=TopicOfs;
TEN.TL:=TL;
TEN.LinkData1Size:=LinkData1Size;
TEN.LinkData1:=LinkData1;
TEN.LinkData2Size:=LinkData2Size;
TEN.LinkData2:=LinkData2;
DoCont:=(longint(CallPointerLocal(EnumProc,PreviousFramePointer,@TEN)) and $ff)<>0;
case TL.RecordType of
$02: ;
$20,$23:
begin
Inc(TopicOfs,TL.DataLen2);
end;
end;
FreeMem(LinkData1,LinkData1Size);
FreeMem(LinkData2,LinkData2Size);
end;
FreeTopicBlock(TB);
end;
ProcessTopicBlock:=OK;
end;
function TWinHelpFile.ReadTopic(T: PTopic): boolean;
var OK: boolean;
BlockNo,BlockOfs: word;
TopicStartPos: longint;
GotIt: boolean;
TH: TWinHelpTopicHeader;
CurLine: string;
Lines: PUnsortedStringCollection;
EmitSize: longint;
LastEmittedChar: integer;
procedure FlushLine;
begin
Lines^.InsertStr(CurLine); CurLine:='';
end;
procedure EmitText(const S: string);
begin
Inc(EmitSize,length(S));
if length(CurLine)+length(S)>High(S) then
FlushLine;
CurLine:=CurLine+S;
if length(S)>0 then
LastEmittedChar:=ord(S[length(S)]);
end;
procedure EmitTextC(C: PChar);
var RemSize,CurOfs,CurFrag: longint;
S: string;
begin
if C=nil then Exit;
RemSize:=StrLen(C); CurOfs:=0;
while (RemSize>0) do
begin
CurFrag:=Min(RemSize,255);
S[0]:=chr(CurFrag);
Move(PByteArray(C)^[CurOfs],S[1],CurFrag);
EmitText(S);
Dec(RemSize,CurFrag); Inc(CurOfs,CurFrag);
end;
end;
function SearchTopicStart(P: PTopicEnumData): boolean; {$ifndef FPC}far;{$endif}
begin
case P^.TL.RecordType of
$02 : TopicStartPos:=P^.TopicPos;
end;
GotIt:=(P^.TL.RecordType in [$20,$23]) and (P^.TopicOfs<=BlockOfs) and (BlockOfs<P^.TopicOfs+P^.LinkData2Size);
SearchTopicStart:=not GotIt;
end;
function RenderTopicProc(P: PTopicEnumData): boolean; {$ifndef FPC}far;{$endif}
var LinkData1Ofs: longint;
LinkData2Ofs: longint;
function ReadUCHAR: byte;
begin
ReadUCHAR:=P^.LinkData1^[LinkData1Ofs];
Inc(LinkData1Ofs);
end;
function ReadCHAR: shortint;
var B: byte;
U: shortint absolute B;
begin
B:=ReadUCHAR;
ReadCHAR:=U;
end;
function ReadUSHORT: word;
begin
ReadUSHORT:=ReadUCHAR+longint(ReadUCHAR)*256;
end;
function ReadSHORT: integer;
var W: word;
I: integer absolute W;
begin
W:=ReadUSHORT;
ReadSHORT:=I;
end;
function ReadComprUSHORT: word;
var B: byte;
begin
B:=ReadUCHAR;
if (B mod 2)=0 then
ReadComprUSHORT:=(B div 2)
else
ReadComprUSHORT:=(B div 2)+longint(ReadUCHAR)*128;
end;
{$Q-}
function ReadLONG: longint;
begin
ReadLONG:=ReadUSHORT+longint(ReadUSHORT)*65536;
end;
function ReadULONG: longint;
begin
ReadULONG:=ReadLONG;
end;
{$Q+}
function ReadComprSHORT: integer;
var B: byte;
begin
B:=ReadUCHAR;
if (B mod 2)=0 then
ReadComprSHORT:=longint(B div 2)-64
else
ReadComprSHORT:=((B div 2)+longint(ReadUCHAR)*128)-16384;
end;
function ReadComprULONG: longint;
var W: word;
begin
W:=ReadUSHORT;
if (W mod 2)=0 then
ReadComprULONG:=(W div 2)
else
ReadComprULONG:=(W div 2)+longint(ReadUSHORT)*32768;
end;
function ReadComprLONG: longint;
var W: word;
begin
W:=ReadUSHORT;
if (W mod 2)=0 then
ReadComprLONG:=longint(W div 2)-16384
else
ReadComprLONG:=(W div 2)+longint(ReadUSHORT)*32768-67108864;
end;
function ReadString: string;
var S: string;
B: byte;
begin
S:='';
repeat
B:=ReadUCHAR;
if B<>0 then
S:=S+chr(B);
until B=0;
ReadString:=S;
end;
procedure EmitDebugText(const S: string);
begin
{$ifdef DEBUGMSG}
EmitText(S);
{$endif}
end;
var Finished: boolean;
S: string;
{ ---- }
Cmd: integer;
I,TopicSize: longint;
NumberOfCols,TableType: byte;
MinTableWidth: integer;
Flags: longint;
NumberOfTabStops: integer;
TabStop: longint;
PType: integer;
Len: word;
SLen,LinkOfs: longint;
SPtr: pointer;
SBuf: PChar;
PictureSize,PictureStartOfs: longint;
FontNumber: integer;
begin
Finished:=((P^.TopicPos>TopicStartPos) or (P^.BlockNo>BlockNo)) and
(P^.TL.RecordType=$02); { next topic header found }
if (Finished=false) and (P^.TopicPos>=TopicStartPos) then
case P^.TL.RecordType of
$02 :
begin
S[0]:=chr(Min(StrLen(pointer(P^.LinkData2)),P^.LinkData2Size));
Move(P^.LinkData2^,S[1],ord(S[0]));
if S<>'' then
begin
EmitText(' '+S+' <20>'+hscLineBreak);
EmitText(' '+CharStr('<27>',length(S)+3)+hscLineBreak);
end;
end;
$20,$23 :
begin
EmitDebugText(hscLineBreak+'<------ new record ------>'+hscLineBreak);
LinkData1Ofs:=0; LinkData2Ofs:=0; EmitSize:=0;
{ ---- }
MinTableWidth:=0;
TopicSize:=ReadComprULONG;
if P^.TL.RecordType in[$20,$23] then
{TopicLen:=}ReadComprUSHORT;
if P^.TL.RecordType=$23 then
begin
NumberOfCols:=ReadUCHAR; TableType:=ReadUCHAR;
if TableType in[0,2] then
MinTableWidth:=ReadSHORT;
for I:=1 to NumberOfCols do
begin
{GapWidth:=}ReadSHORT;
{ColWidth:=}ReadSHORT;
end;
end;
if P^.TL.RecordType=$23 then
begin
{Column:=}ReadSHORT; {-1 = end of topic}
{Unknown:=}ReadSHORT; {Always0:=}ReadCHAR;
end;
{Unknown:=}ReadUCHAR; {Uknown:=}ReadCHAR;
ID:=ReadUSHORT;
Flags:=ReadUSHORT;
if (Flags and 1)<>0 then
{Unknown:=}ReadComprLONG;
if (Flags and 2)<>0 then
{SpacingAbove:=}ReadComprSHORT;
if (Flags and 4)<>0 then
{SpacingBelow:=}ReadComprSHORT;
if (Flags and 8)<>0 then
{SpacingLines:=}ReadComprSHORT;
if (Flags and 16)<>0 then
{LeftIndent:=}ReadComprSHORT;
if (Flags and 32)<>0 then
{RightIndent:=}ReadComprSHORT;
if (Flags and 64)<>0 then
{FirstLineIndent:=}ReadComprSHORT;
if (Flags and 256)<>0 then {BorderInfo}
begin
{BorderFlags:=}ReadUCHAR;
{BorderWidth:=}ReadSHORT;
end;
if (Flags and 512)<>0 then {TabInfo}
begin
NumberOfTabStops:=ReadComprSHORT;
for I:=1 to NumberOfTabStops do
begin
TabStop:=ReadComprUSHORT;
if (TabStop and $4000)<>0 then
{TabType:=}ReadComprUSHORT;
end;
end;
for I:=10 to 14 do
if (Flags and (1 shl I))<>0 then
ReadUCHAR;
if (TH.NonScrollRgnOfs<>-1) then
if (P^.TopicPos=(TH.ScrollRgnOfs and $3fff)) then
begin
EmitText(hscLineBreak);
EmitText(CharStr('<27>',80));
EmitText(hscLineBreak);
end;
while (LinkData2Ofs<P^.LinkData2Size) do
begin
LinkOfs:=-1;
SPtr:=@(P^.LinkData2^[LinkData2Ofs]);
SLen:=StrLen(SPtr);
if SLen>0 then
SBuf:=SPtr
else
SBuf:=nil;
Inc(LinkData2Ofs,SLen+1);
Cmd:=-1;
if (LinkData1Ofs<P^.LinkData1Size) then
begin
Cmd:=ReadUCHAR;
case Cmd of
$ff : { End of formatting }
EmitDebugText('[blockend]');
$20 : begin
EmitDebugText('[vfld]');
{vfldNumber:=}ReadLONG;
end;
$21 : begin
EmitDebugText('[dtype]');
{dtypeNumber:=}ReadSHORT;
end;
$3a,
$3c : {????}
begin
if LastEmittedChar<>ord(hscLineBreak) then
EmitText(hscLineBreak);
EmitDebugText('[tag0x'+IntToHex(Cmd,2)+']');
end;
$80 : begin
FontNumber:=ReadSHORT;
EmitDebugText('[font'+IntToStr(FontNumber)+']');
end;
$81 : {LineBreak}
begin
EmitDebugText('[br]');
EmitText(hscLineBreak);
end;
$82 : {End Of Paragraph}
begin
EmitDebugText('[eop]');
EmitText(hscLineBreak);
end;
$83 : {TAB}
begin
EmitDebugText('[tab]');
EmitText(' ');
end;
$86,
$87,
$88 : { ewc or bmc or bmcwd or bmct or button or mci }
begin
PType:=ReadUCHAR;
PictureSize:=ReadComprLONG;
if PType=$22 then
{NumberOfHotSpots:=}ReadComprSHORT;
PictureStartOfs:=LinkData1Ofs;
PictureSize:=Min(PictureSize,P^.LinkData1Size-LinkData1Ofs);
if PType in[$03,$22] then
begin
{PictureIsEmbedded:=}ReadSHORT;
{PictureNumber:=}ReadSHORT;
for I:=1 to PictureSize-4 do
{PictureData[I-1]:=}ReadCHAR;
end;
if PType=$05 then
begin
{Unknown1:=}ReadSHORT;
{Unknown2:=}ReadSHORT;
{Unknown3:=}ReadSHORT;
{ +??? }
end;
while (LinkData1Ofs<PictureStartOfs+PictureSize) do
{}ReadCHAR;
EmitText('[img]');
end;
$89 : { end of hotspot }EmitDebugText('[ehs]');
$8b : { non-break space }; { does not appear in LinkData2 !!!! }
$8c : { non-break hypen };
$c6 : {????}
ReadLONG;
$c8, { macro }
$cc : { macro without font change }
begin
Len:=ReadSHORT;
for I:=1 to longint(Len)-3 do
{C:=}ReadUCHAR; { string }
end;
$e0, { popup jump } { start with underlined green }
$e1 : { topic jump } { start with underlined green }
begin
EmitDebugText('[linkgr]');
LinkOfs:=ReadLONG;
if LinkOfs>0 then
begin
EmitText(hscLink);
AddLinkToTopic(T,ID,LinkOfs);
end;
end;
$e2, { popup jump }
$e3, { topic jump }
$e6, { popup jump without font change }
$e7 : { topic jump without font change }
begin
EmitDebugText('[link]');
LinkOfs:=ReadLONG;
if LinkOfs>0 then
begin
EmitText(hscLink);
AddLinkToTopic(T,ID,LinkOfs);
end;
end;
$ea, { popup jump into external file }
$eb, { popup jump into external file without font change }
$ee, { popup jump into external file / secondary window }
$ef : { popup jump into external file / secondary window }
begin
EmitDebugText('[linkext]');
Len:=ReadSHORT;
PType:=ReadUCHAR;
LinkOfs:=ReadLONG;
{WindowNo:=}ReadUCHAR;
{NameOfExternalFile:=}ReadString;
{WindowName:=}ReadString;
if LinkOfs>0 then
begin
EmitText(hscLink);
AddLinkToTopic(T,ID,LinkOfs);
end;
end;
else EmitDebugText('[tag0x'+IntToHex(Cmd,2)+']');
end;
end;
if SLen>0 then
EmitTextC(SPtr);
{ case Cmd of
$81 : EmitText(hscLineBreak);
$82 : EmitText(hscLineBreak);
end;}
if LinkOfs>0 then
begin
EmitText(hscLink);
EmitDebugText('[eol]');
end;
end;
end;
end;
RenderTopicProc:=not Finished;
end;
begin
F^.Reset;
OK:=(TopicFileStart<>0) and (T<>nil);
if OK then
begin
ExtractTopicOffset(T^.FileOfs,BlockNo,BlockOfs);
TopicStartPos:=-1; GotIt:=false;
OK:=ProcessTopicBlock(BlockNo,@SearchTopicStart);
OK:=OK and GotIt and (TopicStartPos<>-1);
if OK then
begin
CurLine:='';
New(Lines, Init(1000,1000));
LastEmittedChar:=-1;
OK:=ProcessTopicBlock(BlockNo,@RenderTopicProc);
FlushLine;
BuildTopic(Lines,T);
Dispose(Lines, Done);
end;
end;
ReadTopic:=OK;
end;
destructor TWinHelpFile.Done;
begin
if Assigned(F) then Dispose(F, Done); F:=nil;
if Assigned(Phrases) then Dispose(Phrases, Done); Phrases:=nil;
inherited Done;
end;
function CreateProc(const FileName,Param: string;Index : longint): PHelpFile; {$ifndef FPC}far;{$endif}
begin
CreateProc:=New(PWinHelpFile, Init(FileName,Index));
end;
procedure RegisterHelpType;
begin
RegisterHelpFileType({$ifdef FPC}@{$endif}CreateProc);
end;
END.
{
$Log$
Revision 1.2 2001-09-18 11:33:54 pierre
* fix Previous Help Topic
Revision 1.1 2001/08/04 11:30:26 peter
* ide works now with both compiler versions
Revision 1.1.2.2 2000/11/27 12:06:52 pierre
New bunch of Gabor fixes
Revision 1.1.2.1 2000/09/18 13:20:56 pierre
New bunch of Gabor changes
Revision 1.1 2000/07/13 09:48:37 michael
+ Initial import
Revision 1.2 2000/07/03 08:54:54 pierre
* Some enhancements for WinHelp support by G abor
Revision 1.1 2000/06/26 07:29:23 pierre
* new bunch of Gabor's changes
}
Reference in New Issue View Git Blame Copy Permalink