diff options
| author | marco <marco@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2010-07-11 12:55:56 +0000 |
|---|---|---|
| committer | marco <marco@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2010-07-11 12:55:56 +0000 |
| commit | c03217f1840cbe9e9f5160c1413a29697e1406f8 (patch) | |
| tree | b805a8cefb9eb53b6952cd13528f33858f968c62 /packages/chm | |
| parent | c9a1ab9b655b896f53d460a438aee90398e45eab (diff) | |
| download | fpc-c03217f1840cbe9e9f5160c1413a29697e1406f8.tar.gz | |
* initial #windows, defaultwindow support
* initially working .hhp support in chmcmd
* index and toc are not always named default.hh[k/c] anymore, but use the names in the project xml if specified.
* callback to allow basic output for filewriter/chmcmd
git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@15550 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'packages/chm')
| -rw-r--r-- | packages/chm/src/chmcmd.lpr | 36 | ||||
| -rw-r--r-- | packages/chm/src/chmfilewriter.pas | 139 | ||||
| -rw-r--r-- | packages/chm/src/chmreader.pas | 151 | ||||
| -rw-r--r-- | packages/chm/src/chmtypes.pas | 82 | ||||
| -rw-r--r-- | packages/chm/src/chmwriter.pas | 151 |
5 files changed, 483 insertions, 76 deletions
diff --git a/packages/chm/src/chmcmd.lpr b/packages/chm/src/chmcmd.lpr index 9fd680a4df..66262a8840 100644 --- a/packages/chm/src/chmcmd.lpr +++ b/packages/chm/src/chmcmd.lpr @@ -23,7 +23,7 @@ program chmcmd; {$mode objfpc}{$H+} uses - Classes, chmfilewriter; + Classes, Sysutils, chmfilewriter; Procedure Usage; @@ -32,24 +32,40 @@ begin Halt(1); end; +procedure OnError (Project: TChmProject;errorkind:TChmProjectErrorKind;msg:String); +begin + writeln(ChmErrorKindText[errorkind],': ',msg); +end; var OutStream: TFileStream; Project: TChmProject; + name : string; + xmlname: string; + ishhp : boolean; begin - if (Paramcount=1) and (ParamStr(1)<>'-h') and (ParamStr(1)<>'-?') then + if (Paramcount=1) and (ParamStr(1)<>'-h') and (ParamStr(1)<>'-?') then begin - Project := TChmProject.Create; - Project.LoadFromFile(ParamStr(1)); - OutStream := TFileStream.Create(Project.OutputFileName, fmCreate, fmOpenWrite); - Project.WriteChm(OutStream); - OutStream.Free; - Project.Free; + name:=paramstr(1); + ishhp:=uppercase(extractfileext(name))='.HHP'; + Project := TChmProject.Create; + if ishhp then + begin + xmlname:=changefileext(name,'.hhp.xml'); + Project.LoadFromHHP(name,false) ; // we need a param for this second param later + Project.SaveToFile(xmlname); + end + else + Project.LoadFromFile(name); + OutStream := TFileStream.Create(Project.OutputFileName, fmCreate, fmOpenWrite); + Project.WriteChm(OutStream); + OutStream.Free; + Project.Free; end else begin - Usage; - end; + Usage; + end; end. diff --git a/packages/chm/src/chmfilewriter.pas b/packages/chm/src/chmfilewriter.pas index 27e4a951ab..35e7d70f30 100644 --- a/packages/chm/src/chmfilewriter.pas +++ b/packages/chm/src/chmfilewriter.pas @@ -25,12 +25,15 @@ unit chmfilewriter; interface uses - Classes, SysUtils, chmwriter, inifiles, contnrs; + Classes, SysUtils, chmwriter, inifiles, contnrs, + {for html scanning } dom,SAX_HTML,dom_html; type TChmProject = class; + TChmProjectErrorKind = (chmerror,chmwarning,chmhint,chmnote); TChmProgressCB = procedure (Project: TChmProject; CurrentFile: String) of object; + TChmErrorCB = procedure (Project: TChmProject;errorkind:TChmProjectErrorKind;msg:String); { TChmProject } @@ -46,16 +49,19 @@ type FMakeSearchable: Boolean; FFileName: String; FOnProgress: TChmProgressCB; + FOnError : TChmErrorCB; FOutputFileName: String; FTableOfContentsFileName: String; FTitle: String; FWindows : TObjectList; FMergeFiles : TStringlist; fDefaultWindow : string; + fScanHtmlContents : Boolean; protected function GetData(const DataName: String; out PathInChm: String; out FileName: String; var Stream: TStream): Boolean; procedure LastFileAdded(Sender: TObject); procedure readIniOptions(keyvaluepairs:tstringlist); + procedure ScanHtml; public constructor Create; virtual; destructor Destroy; override; @@ -65,6 +71,7 @@ type procedure WriteChm(AOutStream: TStream); virtual; function ProjectDir: String; procedure AddFileWithContext(contextid:integer;filename:ansistring;contextname:ansistring=''); + procedure Error(errorkind:TChmProjectErrorKind;msg:String); // though stored in the project file, it is only there for the program that uses the unit // since we actually write to a stream property OutputFileName: String read FOutputFileName write FOutputFileName; @@ -82,7 +89,9 @@ type property Windows :TObjectList read FWindows write FWindows; property MergeFiles :TStringlist read FMergeFiles write FMergefiles; property OnProgress: TChmProgressCB read FOnProgress write FOnProgress; + property OnError : TChmErrorCB read FOnError write FOnError; property DefaultWindow : String read FDefaultWindow write FDefaultWindow; + property ScanHtmlContents : Boolean read fScanHtmlContents write fScanHtmlContents; end; TChmContextNode = Class @@ -91,6 +100,11 @@ type ContextName : AnsiString; End; + + +Const + ChmErrorKindText : array[TCHMProjectErrorKind] of string = ('Error','Warning','Hint','Note'); + implementation uses XmlCfg, chmsitemap, CHMTypes; @@ -162,6 +176,7 @@ begin FFiles := TStringList.Create; FWindows:=TObjectList.Create(True); FMergeFiles:=TStringlist.Create; + ScanHtmlContents:=False; end; destructor TChmProject.Destroy; @@ -334,6 +349,8 @@ begin OutputFileName := Cfg.GetValue('Settings/OutputFileName/Value', ''); DefaultFont := Cfg.GetValue('Settings/DefaultFont/Value', ''); DefaultWindow:= Cfg.GetValue('Settings/DefaultWindow/Value', ''); + ScanHtmlContents:= Cfg.GetValue('Settings/ScanHtmlContents/Value', False); + Cfg.Free; end; @@ -538,6 +555,7 @@ begin secs.free; strs.free; fini.free; + ScanHtmlContents:=true; end; procedure TChmProject.AddFileWithContext(contextid:integer;filename:ansistring;contextname:ansistring=''); @@ -598,10 +616,10 @@ begin Cfg.SetValue('MergeFiles/FileName'+IntToStr(I)+'/value',FMergeFiles[i]); // delete legacy keys. - Cfg.SetValue('Files/IndexFile/Value',''); - Cfg.SetValue('Files/TOCFile/Value', ''); - Cfg.SetValue('Files/MakeBinaryTOC/Value',''); - Cfg.SetValue('Files/MakeBinaryIndex/Value',''); + Cfg.DeleteValue('Files/IndexFile/Value'); + Cfg.DeleteValue('Files/TOCFile/Value'); + Cfg.DeleteValue('Files/MakeBinaryTOC/Value'); + Cfg.DeleteValue('Files/MakeBinaryIndex/Value'); Cfg.SetValue('Settings/IndexFile/Value', IndexFileName); Cfg.SetValue('Settings/TOCFile/Value', TableOfContentsFileName); Cfg.SetValue('Settings/MakeBinaryTOC/Value',MakeBinaryTOC); @@ -615,6 +633,7 @@ begin Cfg.SetValue('Settings/DefaultFont/Value', DefaultFont); Cfg.SetValue('Settings/DefaultWindow/Value', DefaultWindow); + Cfg.SetValue('Settings/ScanHtmlContents/Value', ScanHtmlContents); Cfg.Flush; @@ -626,6 +645,108 @@ begin Result := ExtractFilePath(FileName); end; +procedure TChmProject.Error(errorkind:TChmProjectErrorKind;msg:String); +begin + if assigned(OnError) then + OnError(self,errorkind,msg); +end; + +procedure TChmProject.ScanHtml; + +procedure checkattributes(node:TDomNode;attributename:string;filelist :TStringList); +var + Attributes: TDOMNamedNodeMap; + atnode : TDomNode; + fn : String; +begin + if assigned(node) then + begin + Attributes:=node.Attributes; + if assigned(attributes) then + begin + atnode :=attributes.GetNamedItem(attributename); + if assigned(atnode) then + begin + fn:=atnode.nodevalue; + if (fn<>'') then + filelist.add(fn); + end; + end; + end; +end; + + +function scantags(prnt:TDomNode;filelist:TStringlist):TDomNode; +// Seach first matching tag in siblings +var chld: TDomNode; +begin + result:=nil; + if assigned(prnt ) then + begin + chld:=prnt.firstchild; + while assigned(chld) do + begin + scantags(chld,filelist); // depth first. + if (chld is TDomElement) then + begin + // writeln(tdomelement(chld).tagname,' ',chld.classname ); + if tdomelement(chld).tagname='link'then + begin + //printattributes(chld,''); + checkattributes(chld,'href',filelist); + end; + if tdomelement(chld).tagname='img'then + begin + //printattributes(chld,''); + checkattributes(chld,'src',filelist); + end; + + end; + chld:=chld.nextsibling; + end; + end; +end; + +var + filelist, localfilelist: TStringList; + domdoc : THTMLDocument; + i,j : Integer; + fn,s : string; +begin + filelist:= TStringList.create; + localfilelist:= TStringList.create; + + for j:=0 to Files.count-1 do + begin + fn:=files[j]; + writeln(fn); + localfilelist.clear; + if fileexists(fn) then + begin + ReadHtmlFile(domdoc,fn); + scantags(domdoc,localfilelist); + for i:=0 to localFilelist.count-1 do + begin + s:=localfilelist[i]; + if fileexists(s) then // correct for relative path .html file? + begin + filelist.add(s); + Error(ChmNote,'Found file '+s+' while scanning '+fn); + end + else + begin + Error(ChmWarning,'Found file '+s+' while scanning '+fn+', but couldn''t find it on disk'); + end + end; + domdoc.free; + end; + end; + files.addstrings(filelist); + filelist.free; + localfilelist.free; +end; + + procedure TChmProject.WriteChm(AOutStream: TStream); var Writer : TChmWriter; @@ -653,14 +774,22 @@ begin Writer.FullTextSearch := MakeSearchable; Writer.HasBinaryTOC := MakeBinaryTOC; Writer.HasBinaryIndex := MakeBinaryIndex; + Writer.IndexName := IndexFileName; + Writer.TocName := TableOfContentsFileName; for i:=0 to files.count-1 do begin nd:=TChmContextNode(files.objects[i]); + if not fileexists(files[i]) then + Error(chmWarning,'File '+Files[i]+' does not exist'); if assigned(nd) and (nd.contextnumber<>0) then Writer.AddContext(nd.ContextNumber,files[i]); end; + if FWIndows.Count>0 then + Writer.Windows:=FWIndows; + If ScanHtmlContents Then + ScanHtml; // Since this is slowing we opt to skip this step, and only do this on html load. // and write! Writer.Execute; diff --git a/packages/chm/src/chmreader.pas b/packages/chm/src/chmreader.pas index dc55d628be..f901cac1c6 100644 --- a/packages/chm/src/chmreader.pas +++ b/packages/chm/src/chmreader.pas @@ -28,18 +28,18 @@ unit chmreader; interface uses - Classes, SysUtils, chmbase, paslzx, chmFIftiMain, chmsitemap; - + Classes, SysUtils, Contnrs, chmbase, paslzx, chmFIftiMain, chmsitemap; + type TLZXResetTableArr = array of QWord; - + PContextItem = ^TContextItem; TContextItem = record Context: THelpContext; Url: String; end; - + TContextList = class(TList) public procedure AddContext(Context: THelpContext; Url: String); @@ -89,7 +89,7 @@ type function GetObject(Name: String): TMemoryStream; virtual; // YOU must Free the stream property CachedEntry: TPMGListChunkEntry read fCachedEntry; end; - + { TChmReader } TChmReader = class(TITSFReader) @@ -105,12 +105,16 @@ type fURLTBLStream, fStringsStream: TMemoryStream; fLocaleID: DWord; + fWindows : TObjectList; + fDefaultWindow: String; private FSearchReader: TChmSearchReader; procedure ReadCommonData; function ReadStringsEntry(APosition: DWord): String; + function ReadStringsEntryFromStream ( strm:TStream ) : String; function ReadURLSTR(APosition: DWord): String; function CheckCommonStreams: Boolean; + procedure ReadWindows(mem:TMemoryStream); public constructor Create(AStream: TStream; FreeStreamOnDestroy: Boolean); override; destructor Destroy; override; @@ -128,6 +132,8 @@ type property LocaleID: dword read fLocaleID; property SearchReader: TChmSearchReader read FSearchReader write FSearchReader; property contextlist : tcontextlist read fcontextlist; + property Windows : TObjectlist read fwindows; + property DefaultWindow : string read fdefaultwindow; end; { TChmFileList } @@ -157,7 +163,7 @@ type property FileName[Index: Integer]: String read GetFileName; property OnOpenNewFile: TChmFileOpenEvent read fOnOpenNewFile write SetOnOpenNewFile; end; - + //ErrorCodes const ERR_NO_ERR = 0; @@ -165,7 +171,7 @@ const ERR_NOT_SUPPORTED_VERSION = 2; ERR_NOT_VALID_FILE = 3; ERR_UNKNOWN_ERROR = 10; - + function ChmErrorToStr(Error: Integer): String; implementation @@ -209,12 +215,12 @@ begin fITSFHeader.TimeStamp := BEtoN(fITSFHeader.TimeStamp);//bigendian fITSFHeader.LanguageID := LEtoN(fITSFHeader.LanguageID); {$ENDIF} - + if fITSFHeader.Version < 4 then fStream.Seek(SizeOf(TGuid)*2, soCurrent); if not IsValidFile then Exit; - + ReadHeaderEntries; end; @@ -416,6 +422,7 @@ procedure TChmReader.ReadCommonData; fDefaultPage := '/'+ReadString(fStrings); end; end; + ReadWindows(FWindows); end; procedure ReadContextIds; var @@ -447,7 +454,7 @@ begin ReadFromSystem; ReadFromWindows; ReadContextIds; - {$IFDEF CHM_DEBUG} + {$IFDEF CHM_DEBUG} WriteLn('TOC=',fTocfile); WriteLn('DefaultPage=',fDefaultPage); {$ENDIF} @@ -466,6 +473,13 @@ begin end; end; +function TChmReader.ReadStringsEntryFromStream ( strm:TStream ) : String; +var APosition : DWord; +begin + APosition:=LEtoN(strm.ReadDWord); + result:=ReadStringsEntry(APosition); +end; + function TChmReader.ReadURLSTR ( APosition: DWord ) : String; var URLStrURLOffset: DWord; @@ -497,6 +511,74 @@ begin and (fURLTBLStream <> nil); end; +procedure TChmReader.ReadWindows(mem:TMemoryStream); + +var + i,cnt, + version : integer; + x : TChmWindow; +begin + fWindows.Clear; + mem.Position:=0; + cnt := LEtoN(mem.ReadDWord); + version := LEtoN(mem.ReadDWord); + while (cnt>0) do + begin + x:=TChmWindow.Create; + version := LEtoN(mem.ReadDWord); // 0 size of entry. + mem.readDWord; // 4 unknown (bool Unicodestrings?) + x.window_type :=ReadStringsEntryFromStream(mem); // 8 Arg 0, name of window + x.flags := TValidWindowFields(LEtoN(mem.ReadDWord)); // C valid fields + x.nav_style := LEtoN(mem.ReadDWord); // 10 arg 10 navigation pane style + x.title_bar_text :=ReadStringsEntryFromStream(mem); // 14 Arg 1, title bar text + x.styleflags := LEtoN(mem.ReadDWord); // 18 Arg 14, style flags + x.xtdstyleflags := LEtoN(mem.ReadDWord); // 1C Arg 15, xtd style flags + x.left := LEtoN(mem.ReadDWord); // 20 Arg 13, rect.left + x.right := LEtoN(mem.ReadDWord); // 24 Arg 13, rect.top + x.top := LEtoN(mem.ReadDWord); // 28 Arg 13, rect.right + x.bottom := LEtoN(mem.ReadDWord); // 2C Arg 13, rect.bottom + x.window_show_state:= LEtoN(mem.ReadDWord); // 30 Arg 16, window show state + mem.readdword; // 34 - , HWND hwndhelp OUT: window handle" + mem.readdword; // 38 - , HWND hwndcaller OUT: who called this window" + mem.readdword; // 3C - , HH_INFO_TYPE paINFO_TYPES IN: Pointer to an array of Information Types" + mem.readdword; // 40 - , HWND hwndtoolbar OUT: toolbar window in tri-pane window" + mem.readdword; // 44 - , HWND hwndnavigation OUT: navigation window in tri-pane window" + mem.readdword; // 48 - , HWND hwndhtml OUT: window displaying HTML in tri-pane window" + x.navpanewidth := LEtoN(mem.ReadDWord); // 4C Arg 11, width of nav pane + mem.readdword; // 50 - , rect.left, OUT:Specifies the coordinates of the Topic pane + mem.readdword; // 54 - , rect.top , OUT:Specifies the coordinates of the Topic pane + mem.readdword; // 58 - , rect.right, OUT:Specifies the coordinates of the Topic pane + mem.readdword; // 5C - , rect.bottom, OUT:Specifies the coordinates of the Topic pane + x.toc_file :=ReadStringsEntryFromStream(mem); // 60 Arg 2, toc file + x.index_file :=ReadStringsEntryFromStream(mem); // 64 Arg 3, index file + x.default_file :=ReadStringsEntryFromStream(mem); // 68 Arg 4, default file + x.home_button_file :=ReadStringsEntryFromStream(mem); // 6c Arg 5, home button file. + x.buttons := LEtoN(mem.ReadDWord); // 70 arg 12, + x.navpane_initially_closed := LEtoN(mem.ReadDWord); // 74 arg 17 + x.navpane_default := LEtoN(mem.ReadDWord); // 78 arg 18, + x.navpane_location := LEtoN(mem.ReadDWord); // 7C arg 19, + x.wm_notify_id := LEtoN(mem.ReadDWord); // 80 arg 20, + for i:=0 to 4 do + mem.ReadDWord; // 84 - byte[20] unknown - "BYTE tabOrder[HH_MAX_TABS + 1]; // IN/OUT: tab order: Contents, Index, Search, History, Favorites, Reserved 1-5, Custom tabs" + mem.ReadDWord; // 94 - int cHistory; // IN/OUT: number of history items to keep (default is 30) + x.jumpbutton_1_text:=ReadStringsEntryFromStream(mem); // 9C Arg 7, The text of the Jump 1 button. + x.jumpbutton_2_text:=ReadStringsEntryFromStream(mem); // A0 Arg 9, The text of the Jump 2 button. + x.jumpbutton_1_file:=ReadStringsEntryFromStream(mem); // A4 Arg 6, The file shown for Jump 1 button. + x.jumpbutton_2_file:=ReadStringsEntryFromStream(mem); // A8 Arg 8, The file shown for Jump 1 button. + for i:=0 to 3 do + mem.ReadDWord; + dec(version,188); // 1.1 specific onesf + while (version>=4) do + begin + mem.readdword; + dec(version,4); + end; + + fWindows.Add(x); + dec(cnt); + end; +end; + constructor TChmReader.Create(AStream: TStream; FreeStreamOnDestroy: Boolean); begin inherited Create(AStream, FreeStreamOnDestroy); @@ -504,11 +586,14 @@ begin fContextList := TContextList.Create; ReadCommonData; + fWindows := TObjectlist.Create(True); + fDefaultWindow:=''; end; destructor TChmReader.Destroy; begin - fContextList.Free; + FreeAndNil(fContextList); + FreeAndNil(FWindows); FreeAndNil(FSearchReader); FreeAndNil(fTOPICSStream); FreeAndNil(fURLSTRStream); @@ -600,7 +685,7 @@ begin buf[NameLength] := #0; PMGIEntry.Name := buf; - + PMGIEntry.ListingChunk := GetCompressedInteger(Stream); if NameLength = 0 then Exit; // failed GetCompressedInteger sanity check Result := True; @@ -717,7 +802,7 @@ var OldPosn := ChunkStream.Position; Posn := ChunkStream.Size-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)); @@ -745,10 +830,10 @@ var var PMGLChunk: TPMGListChunk; PMGIChunk: TPMGIIndexChunk; - //ChunkStream: TMemoryStream; declared above + //ChunkStream: TMemoryStream; declared above Entry: TPMGListChunkEntry; NextIndex: Integer; - EntryName: String; + EntryName: String; CRes: Integer; I: Integer; begin @@ -764,10 +849,10 @@ begin 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; @@ -783,7 +868,7 @@ begin end; ctPMGI: // we must follow the PMGI tree until we reach a PMGL block begin - LookupPMGIchunk(ChunkStream, PMGIChunk); + LookupPMGIchunk(ChunkStream, PMGIChunk); //QuickRefIndex[0] := ChunkStream.Position; @@ -794,13 +879,13 @@ begin 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! + // no more need of this block. onto the next! NextIndex := GetCompressedInteger(ChunkStream); Break; end; if CRes < 0 then begin if I = 0 then Break; // File doesn't exist - // file is in previous entry + // file is in previous entry Break; end; NextIndex := GetCompressedInteger(ChunkStream); @@ -813,7 +898,7 @@ begin QuickRefIndex[0] := ChunkStream.Position; I := 0; while ChunkStream.Position <= ChunkStream.Size - PMGLChunk.UnusedSpace do begin - // we consume the entry by reading it + // we consume the entry by reading it Entry.Name := ReadString; if Entry.Name = '' then break; if ChunkStream.Position >= ChunkStream.Size - PMGLChunk.UnusedSpace then break; @@ -825,7 +910,7 @@ begin CRes := ChmCompareText(Name, Entry.Name); if CRes = 0 then begin fCachedEntry := Entry; - Result := Entry.DecompressedLength; + Result := Entry.DecompressedLength; Break; end; Inc(I); @@ -944,7 +1029,7 @@ function TChmReader.GetIndexSitemap(ForceXML:boolean=false): TChmSiteMap; var Index : TMemoryStream; sitemap : TChmSiteMap; Item : TChmSiteMapItem; - + function AbortAndTryTextual:tchmsitemap; begin @@ -995,7 +1080,7 @@ begin litem.local:=topic; litem.text :=Title; // recursively split this? No examples. end; - end; + end; end; procedure parselistingblock(p:pbyte); @@ -1021,7 +1106,7 @@ begin tail:=p+(2048-hdr^.length); head:=p+sizeof(TBtreeBlockHeader); - + {$ifdef binindex} writeln('previndex : ',hdr^.IndexOfPrevBlock); writeln('nextindex : ',hdr^.IndexOfNextBlock); @@ -1101,12 +1186,12 @@ begin Exit; end; SiteMap:=TChmSitemap.Create(StIndex); - Item :=Nil; // cached last created item, in case we need to make + Item :=Nil; // cached last created item, in case we need to make // a child. TryTextual:=True; BHdr.LastLstBlock:=0; if LoadBtreeHeader(index,BHdr) and (BHdr.LastLstBlock>0) Then - begin + begin if BHdr.BlockSize=defblocksize then begin for i:=0 to BHdr.lastlstblock do @@ -1118,8 +1203,8 @@ begin end; end; trytextual:=false; - result:=sitemap; - end; + result:=sitemap; + end; end; if trytextual then begin @@ -1239,7 +1324,7 @@ begin //WriteLn('Failed to get ::DataSpace/NameList!'); exit; end; - + Stream.Position := 2; EntryCount := LEtoN(Stream.ReadWord); for X := 0 to EntryCount -1 do begin @@ -1355,7 +1440,7 @@ begin ReadCount := ResetTable[X+1] - ResetTable[X]; BlockWriteLength := BlockSize; - + if FirstBlock = LastBlock then begin WriteCount := BlockLength; end @@ -1381,7 +1466,7 @@ begin 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 and 1 = 1) then LZXreset(LZXState); @@ -1501,7 +1586,7 @@ end; function TChmFileList.CheckOpenFile(AFileName: String): Boolean; var X: Integer; - + begin Result := False; for X := 0 to Count-1 do begin diff --git a/packages/chm/src/chmtypes.pas b/packages/chm/src/chmtypes.pas index 30f2eec4c7..16b982fdba 100644 --- a/packages/chm/src/chmtypes.pas +++ b/packages/chm/src/chmtypes.pas @@ -91,6 +91,22 @@ type end; + TValidWindowFieldsEnum = (valid_Unknown1 {:=1}, + valid_Navigation_pane_style {:= 2}, + valid_Window_style_flags {:= 4}, + valid_Window_extended_style_flags {:= 8}, + valid_Initial_window_position {:= $10}, + valid_Navigation_pane_width {:= $20}, + valid_Window_show_state {:= $40}, + valid_Info_types {:= $80}, + valid_Buttons {:= $100}, + valid_Navigation_Pane_initially_closed_state {:= $200}, + valid_Tab_position {:= $400}, + valid_Tab_order {:= $800}, + valid_History_count{ := $1000}, + valid_Default_Pane {:= $2000}); + + TValidWindowFields = Set Of TValidWindowFieldsEnum; TCHMWindow = Class window_type, Title_bar_text, @@ -116,10 +132,13 @@ type navpane_default, navpane_location, wm_notify_id : integer; + flags : TValidWindowFields; // bitset that keeps track of which fields are filled. + // of certain fields. Needs to be inserted into #windows stream Constructor create(s:string=''); procedure load_from_ini(txt:string); procedure savetoxml(cfg:TXMLConfig;key:string); procedure loadfromxml(cfg:TXMLConfig;key:string); + procedure assign(obj : TCHMWindow); end; @@ -446,11 +465,17 @@ begin i:=ind+1; // skip , end; -function getnextint(const txt:string;var ind: integer;len:integer):integer; +function getnextint(const txt:string;var ind: integer;len:integer;var flags : TValidWindowFields;x:TValidWindowFieldsEnum):integer; var s : string; + i:integer; begin + + i:=ind; s:=getnext(txt,ind,len); + // set a flag if the field was empty (,,) + if (ind=(i+1)) and (x<>valid_unknown1) then + include(flags,x); result:=strtointdef(s,0); // I think this does C style hex, if not fixup here. end; @@ -460,6 +485,7 @@ var ind,len, arr : array[0..3] of integer; s2 : string; begin + flags:=[]; j:=pos('=',txt); if j>0 then txt[j]:=','; @@ -475,15 +501,17 @@ begin Jumpbutton_2_File :=getnext(txt,ind,len); Jumpbutton_2_Text :=getnext(txt,ind,len); - nav_style :=getnextint(txt,ind,len); - navpanewidth :=getnextint(txt,ind,len); - buttons :=getnextint(txt,ind,len); + nav_style :=getnextint(txt,ind,len,flags,valid_navigation_pane_style); + navpanewidth :=getnextint(txt,ind,len,flags,valid_navigation_pane_width); + buttons :=getnextint(txt,ind,len,flags,valid_buttons); k:=0; repeat s2:=getnext(txt,ind,len); if (length(s2)>0) and (s2[1]='[') then delete(s2,1,1); j:=pos(']',s2); if j>0 then delete(s2,j,1); + if length(trim(s2))>0 then + include(flags,valid_tab_position); arr[k]:=strtointdef(s2,0); inc(k); until (j<>0) or (ind>len); @@ -491,13 +519,13 @@ begin top :=arr[1]; right :=arr[2]; bottom:=arr[3]; - styleflags :=getnextint(txt,ind,len); - xtdstyleflags :=getnextint(txt,ind,len); - window_show_state :=getnextint(txt,ind,len); - navpane_initially_closed :=getnextint(txt,ind,len); - navpane_default :=getnextint(txt,ind,len); - navpane_location :=getnextint(txt,ind,len); - wm_notify_id :=getnextint(txt,ind,len); + styleflags :=getnextint(txt,ind,len,flags,valid_buttons); + xtdstyleflags :=getnextint(txt,ind,len,flags,valid_window_style_flags); + window_show_state :=getnextint(txt,ind,len,flags,valid_window_extended_style_flags); + navpane_initially_closed :=getnextint(txt,ind,len,flags,valid_navigation_pane_initially_closed_state); + navpane_default :=getnextint(txt,ind,len,flags,valid_default_pane); + navpane_location :=getnextint(txt,ind,len,flags,valid_tab_position); + wm_notify_id :=getnextint(txt,ind,len,flags,valid_unknown1); end; procedure TCHMWindow.savetoxml(cfg:TXMLConfig;key:string); @@ -534,7 +562,7 @@ begin window_type :=cfg.getvalue(key+'window_type',''); Title_bar_text :=cfg.getvalue(key+'title_bar_text',''); Toc_file :=cfg.getvalue(key+'toc_file',''); - Index_file :=cfg.getvalue(key+'index_file',''); + Index_file :=cfg.getvalue(key+'index_file',''); Default_File :=cfg.getvalue(key+'default_file',''); Home_button_file :=cfg.getvalue(key+'home_button_file',''); Jumpbutton_1_File :=cfg.getvalue(key+'jumpbutton_1_file',''); @@ -564,4 +592,34 @@ begin load_from_ini(s); end; + +procedure TCHMWindow.assign(obj : TCHMWindow); + +begin + window_type :=obj.window_type; + Title_bar_text :=obj.Title_bar_text; + Toc_file :=obj.Toc_file; + Index_file :=obj.Index_file; + Default_File :=obj.Default_File; + Home_button_file :=obj.Home_button_file; + Jumpbutton_1_File:=obj.Jumpbutton_1_File; + Jumpbutton_1_Text:=obj.Jumpbutton_1_Text; + Jumpbutton_2_File:=obj.Jumpbutton_2_File; + Jumpbutton_2_Text:=obj.Jumpbutton_2_Text; + nav_style :=obj.nav_style; + navpanewidth :=obj.navpanewidth; + buttons :=obj.buttons; + left :=obj.left; + top :=obj.top; + right :=obj.right; + bottom :=obj.bottom; + styleflags :=obj.styleflags; + xtdstyleflags :=obj.xtdstyleflags; + window_show_state:=obj.window_show_state; + navpane_initially_closed :=obj.navpane_initially_closed; + navpane_default :=obj.navpane_default; + navpane_location :=obj.navpane_location; + wm_notify_id :=obj.wm_notify_id; +end; + end. diff --git a/packages/chm/src/chmwriter.pas b/packages/chm/src/chmwriter.pas index 96f13aeffa..0eb44ce207 100644 --- a/packages/chm/src/chmwriter.pas +++ b/packages/chm/src/chmwriter.pas @@ -23,10 +23,13 @@ unit chmwriter; { $DEFINE LZX_USETHREADS} interface -uses Classes, ChmBase, chmtypes, chmspecialfiles, HtmlIndexer, chmsitemap, Avl_Tree{$IFDEF LZX_USETHREADS}, lzxcompressthread{$ENDIF}; +uses Classes, ChmBase, chmtypes, chmspecialfiles, HtmlIndexer, chmsitemap, contnrs, Avl_Tree{$IFDEF LZX_USETHREADS}, lzxcompressthread{$ENDIF}; -type +Const + DefaultHHC = 'Default.hhc'; + DefaultHHK = 'Default.hhk'; +Type TGetDataFunc = function (const DataName: String; out PathInChm: String; out FileName: String; var Stream: TStream): Boolean of object; // DataName : A FileName or whatever so that the getter can find and open the file to add // PathInChm: This is the absolute path in the archive. i.e. /home/user/helpstuff/ @@ -149,6 +152,10 @@ Type FAvlURLStr : TAVLTree; // dedupe urltbl + binindex must resolve URL to topicid SpareString : TStringIndex; SpareUrlStr : TUrlStrIndex; + FWindows : TObjectList; + FDefaultWindow: String; + FTocName : String; + FIndexName : String; protected procedure FileAdded(AStream: TStream; const AEntry: TFileEntryRec); override; private @@ -163,13 +170,14 @@ Type procedure WriteURL_STR_TBL; procedure WriteOBJINST; procedure WriteFiftiMain; + procedure WriteWindows; function AddString(AString: String): LongWord; function AddURL(AURL: String; TopicsIndex: DWord): LongWord; procedure CheckFileMakeSearchable(AStream: TStream; AFileEntry: TFileEntryRec); function AddTopic(ATitle,AnUrl:AnsiString):integer; function NextTopicIndex: Integer; - + procedure Setwindows (AWindowList:TObjectList); public constructor Create(AOutStream: TStream; FreeStreamOnDestroy: Boolean); override; @@ -190,7 +198,10 @@ Type property HasBinaryIndex: Boolean read FHasBinaryIndex write FHasBinaryIndex; property DefaultFont: String read FDefaultFont write FDefaultFont; property DefaultPage: String read FDefaultPage write FDefaultPage; - + property Windows : TObjectlist read fwindows write setwindows; + property TOCName : String read FTocName write FTocName; + property IndexName : String read FIndexName write FIndexName; + property DefaultWindow : string read fdefaultwindow write fdefaultwindow; end; implementation @@ -1006,7 +1017,10 @@ begin // 0 Table of contents filename if FHasTOC then begin - TmpStr := 'default.hhc'; + if fTocName ='' then + TmpStr := DefaultHHC + else + TmpStr := fTocName; FSection0.WriteWord(0); FSection0.WriteWord(NToLE(Word(Length(TmpStr)+1))); FSection0.Write(TmpStr[1], Length(TmpStr)); @@ -1015,17 +1029,25 @@ begin // 1 // hhk Index if FHasIndex then begin - TmpStr := 'default.hhk'; + if fIndexName='' then + TmpStr := DefaultHHK + else + TmpStr := fIndexName; FSection0.WriteWord(NToLE(Word(1))); FSection0.WriteWord(NToLE(Word(Length(TmpStr)+1))); FSection0.Write(TmpStr[1], Length(TmpStr)); FSection0.WriteByte(0); end; - // 5 Default Window. - // Not likely needed -// } - Entry.DecompressedSize := FSection0.Position - Entry.DecompressedOffset; - FInternalFiles.AddEntry(Entry); + // 5 Default Window + + if FDefaultWindow<>'' then + begin + FSection0.WriteWord(NTOLE(Word(5))); + tmpstr:=FDefaultWindow; + FSection0.WriteWord(NToLE(Word(Length(TmpStr)+1))); + FSection0.Write(TmpStr[1], Length(TmpStr)); + FSection0.WriteByte(0); + end; // 7 Binary Index if FHasBinaryIndex then @@ -1045,6 +1067,10 @@ begin FSection0.WriteWord(NToLE(Word(4))); FSection0.WriteDWord(DWord(0)); // what is this number to be? end; + + + Entry.DecompressedSize := FSection0.Position - Entry.DecompressedOffset; + FInternalFiles.AddEntry(Entry); end; procedure TChmWriter.WriteITBITS; @@ -1240,14 +1266,77 @@ begin PostAddStreamToArchive('$FIftiMain', '/', FFiftiMainStream); end; +procedure TChmWriter.WriteWindows; +Var WindowStream : TMemoryStream; + i,j : Integer; + win : TChmWindow; +begin + if FWindows.Count>0 then + begin + WindowStream:=TMemoryStream.Create; + WindowStream.WriteDword(NToLE(dword(FWindows.Count))); + WindowStream.WriteDword(NToLE(dword(196))); // 1.1 or later. 188 is old style. + for i:=0 to FWindows.Count-1 Do + begin + Win:=TChmWindow(FWindows[i]); + WindowStream.WriteDword(NToLE(dword(196 ))); // 0 size of entry. + WindowStream.WriteDword(NToLE(dword(0 ))); // 4 unknown (bool Unicodestrings?) + WindowStream.WriteDword(NToLE(addstring(win.window_type ))); // 8 Arg 0, name of window + WindowStream.WriteDword(NToLE(dword(win.flags ))); // C valid fields + WindowStream.WriteDword(NToLE(dword(win.nav_style))); // 10 arg 10 navigation pane style + WindowStream.WriteDword(NToLE(addstring(win.title_bar_text))); // 14 Arg 1, title bar text + WindowStream.WriteDword(NToLE(dword(win.styleflags))); // 18 Arg 14, style flags + WindowStream.WriteDword(NToLE(dword(win.xtdstyleflags))); // 1C Arg 15, xtd style flags + WindowStream.WriteDword(NToLE(dword(win.left))); // 20 Arg 13, rect.left + WindowStream.WriteDword(NToLE(dword(win.top))); // 24 Arg 13, rect.top + WindowStream.WriteDword(NToLE(dword(win.right))); // 28 Arg 13, rect.right + WindowStream.WriteDword(NToLE(dword(win.bottom))); // 2C Arg 13, rect.bottom + WindowStream.WriteDword(NToLE(dword(win.window_show_state))); // 30 Arg 16, window show state + WindowStream.WriteDword(NToLE(dword(0))); // 34 - , HWND hwndhelp OUT: window handle" + WindowStream.WriteDword(NToLE(dword(0))); // 38 - , HWND hwndcaller OUT: who called this window" + WindowStream.WriteDword(NToLE(dword(0))); // 3C - , HH_INFO_TYPE paINFO_TYPES IN: Pointer to an array of Information Types" + WindowStream.WriteDword(NToLE(dword(0))); // 40 - , HWND hwndtoolbar OUT: toolbar window in tri-pane window" + WindowStream.WriteDword(NToLE(dword(0))); // 44 - , HWND hwndnavigation OUT: navigation window in tri-pane window" + WindowStream.WriteDword(NToLE(dword(0))); // 48 - , HWND hwndhtml OUT: window displaying HTML in tri-pane window" + WindowStream.WriteDword(NToLE(dword(win.navpanewidth))); // 4C Arg 11, width of nav pane + WindowStream.WriteDword(NToLE(dword(0))); // 50 - , rect.left, OUT:Specifies the coordinates of the Topic pane + WindowStream.WriteDword(NToLE(dword(0))); // 54 - , rect.top , OUT:Specifies the coordinates of the Topic pane + WindowStream.WriteDword(NToLE(dword(0))); // 58 - , rect.right, OUT:Specifies the coordinates of the Topic pane + WindowStream.WriteDword(NToLE(dword(0))); // 5C - , rect.bottom, OUT:Specifies the coordinates of the Topic pane + WindowStream.WriteDword(NToLE(addstring(win.toc_file))); // 60 Arg 2, toc file + WindowStream.WriteDword(NToLE(addstring(win.index_file))); // 64 Arg 3, index file + WindowStream.WriteDword(NToLE(addstring(win.default_file))); // 68 Arg 4, default file + WindowStream.WriteDword(NToLE(addstring(win.home_button_file))); // 6c Arg 5, home button file. + WindowStream.WriteDword(NToLE(dword(win.buttons))); // 70 arg 12, + WindowStream.WriteDword(NToLE(dword(win.navpane_initially_closed))); // 74 arg 17 + WindowStream.WriteDword(NToLE(dword(win.navpane_default))); // 78 arg 18, + WindowStream.WriteDword(NToLE(dword(win.navpane_location))); // 7C arg 19, + WindowStream.WriteDword(NToLE(dword(win.wm_notify_id))); // 80 arg 20, + for j:=0 to 4 do + WindowStream.WriteDword(NToLE(dword(0))); // 84 - byte[20] unknown - "BYTE tabOrder[HH_MAX_TABS + 1]; // IN/OUT: tab order: Contents, Index, Search, History, Favorites, Reserved 1-5, Custom tabs" + WindowStream.WriteDword(NToLE(dword(0))); // 94 - int cHistory; // IN/OUT: number of history items to keep (default is 30) + WindowStream.WriteDword(NToLE(addstring(win.Jumpbutton_1_Text))); // 9C Arg 7, The text of the Jump 1 button. + WindowStream.WriteDword(NToLE(addstring(win.Jumpbutton_2_Text))); // A0 Arg 9, The text of the Jump 2 button. + WindowStream.WriteDword(NToLE(addstring(win.Jumpbutton_1_File))); // A4 Arg 6, The file shown for Jump 1 button. + WindowStream.WriteDword(NToLE(addstring(win.Jumpbutton_2_File))); // A8 Arg 8, The file shown for Jump 1 button. + for j:=0 to 3 do + WindowStream.WriteDword(NToLE(dword(0))); // AA - byte[16] (TRECT) "RECT rcMinSize; // Minimum size for window (ignored in version 1)" + // 1.1+ fields + WindowStream.WriteDword(NToLE(dword(0))); // BC - int cbInfoTypes; // size of paInfoTypes; + WindowStream.WriteDword(NToLE(dword(0))); // C0 - LPCTSTR pszCustomTabs; // multiple zero-terminated strings + end; + WindowStream.Position := 0; + AddStreamToArchive('#WINDOWS', '/', WindowStream, True); + WindowStream.Free; + end; +end; + procedure TChmWriter.WriteInternalFilesAfter; begin // This creates and writes the #ITBITS (empty) file to section0 WriteITBITS; // This creates and writes the #SYSTEM file to section0 WriteSystem; - - end; procedure TChmWriter.WriteFinalCompressedFiles; @@ -1256,6 +1345,7 @@ begin WriteTOPICS; WriteURL_STR_TBL; WriteSTRINGS; + WriteWINDOWS; WriteFiftiMain; end; @@ -1287,6 +1377,8 @@ begin SpareString := TStringIndex.Create; // We need an object to search in avltree SpareUrlStr := TUrlStrIndex.Create; // to avoid create/free circles we keep one in spare // for searching purposes + FWindows := TObjectlist.Create(True); + FDefaultWindow:= ''; end; destructor TChmWriter.Destroy; @@ -1304,6 +1396,7 @@ begin FAvlUrlStr.Free; FAvlStrings.FreeAndClear; FAvlStrings.Free; + FWindows.Free; inherited Destroy; end; @@ -1462,9 +1555,15 @@ begin end; procedure TChmWriter.AppendTOC(AStream: TStream); + +var tmpstr : string; begin - FHasTOC := True; - PostAddStreamToArchive('default.hhc', '/', AStream, True); + fHasTOC := True; + if fTocName = '' then + tmpstr := defaulthhc + else + tmpstr := fTocName; + PostAddStreamToArchive(tmpstr, '/', AStream, True); end; procedure TChmWriter.AppendBinaryTOCFromSiteMap(ASiteMap: TChmSiteMap); @@ -2079,9 +2178,14 @@ begin end; procedure TChmWriter.AppendIndex(AStream: TStream); +var tmpstr : string; begin FHasIndex := True; - PostAddStreamToArchive('default.hhk', '/', AStream, True); + if fIndexName = '' then + tmpstr:=defaulthhk + else + tmpstr:=fIndexName; + PostAddStreamToArchive(tmpstr, '/', AStream, True); end; procedure TChmWriter.AppendSearchDB(AName: String; AStream: TStream); @@ -2106,5 +2210,20 @@ begin FContextStream.WriteDWord(Offset); end; +procedure TChmWriter.SetWindows(AWindowList:TObjectList); + +var i : integer; + x : TCHMWindow; +begin + FWindows.Clear; + for i:=0 to AWindowList.count -1 do + begin + x:=TChmWindow.Create; + x.assign(TChmWindow(AWindowList[i])); + Fwindows.Add(x); + end; +end; + + end. |
