Why Gemfury?
Push, build, and install
RubyGems
npm packages
Python packages
Maven artifacts
PHP packages
Go Modules
Debian packages
RPM packages
NuGet packages
Repository URL to install this package:
|
Version:
3.0.0 ▾
|
{ Copyright (C) <2005> <Andrew Haines> chmls.lpr
Mostly rewritten by Marco van de Voort 2009-2012
An util that concentrates on listing and decompiling various sections
of a CHM.
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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
See the file COPYING, included in this distribution,
for details about the copyright.
}
program chmls;
{$IFDEF MSWINDOWS}
{$apptype console}
{$ENDIF}
{$mode objfpc}{$H+}
uses
Classes, GetOpts, SysUtils, Types,
StreamEx,
chmreader, chmbase, chmsitemap;
{$R-} // CHM spec puts "-1" in dwords etc.
type
{ TListObject }
TListObject = class
Section : Integer;
count : integer;
donotpage: boolean;
nameonly : boolean;
procedure OnFileEntry(Name: String; Offset, UncompressedSize, ASection: Integer);
end;
TExtractAllObject = class
basedir : string;
r : TChmReader;
lastone_was_point : boolean;
procedure OnFileEntry(Name: String; Offset, UncompressedSize, ASection: Integer);
end;
Type
TCmdEnum = (cmdList,cmdExtract,cmdExtractall,cmdUnblock,cmdextractalias,cmdextracttoc,cmdextractindex,cmdprintidxhdr,cmdprintsystem,cmdprintwindows,cmdprinttopics,cmdNone); // One dummy element at the end avoids rangecheck errors.
Const
CmdNames : array [TCmdEnum] of String = ('LIST','EXTRACT','EXTRACTALL','UNBLOCK','EXTRACTALIAS','EXTRACTTOC','EXTRACTINDEX','PRINTIDXHDR','PRINTSYSTEM','PRINTWINDOWS','PRINTTOPICS','');
var
theopts : array[1..4] of TOption;
Procedure Usage;
begin
Writeln(StdErr,'Usage: chmls [switches] [command] [command specific parameters]');
writeln(stderr);
writeln(stderr,'Switches : ');
writeln(stderr,' -h, --help : this screen');
writeln(stderr,' -p, --no-page : do not page list output');
writeln(stderr,' -n,--name-only : only show "name" column in list output');
writeln(stderr);
writeln(stderr,'Where command is one of the following or if omitted, equal to LIST.');
writeln(stderr,' list <filename> [section number] ');
writeln(stderr,' Shows contents of the archive''s directory');
writeln(stderr,' extract <chm filename> <filename to extract> [saveasname]');
writeln(stderr,' Extracts file "filename to get" from archive "filename",');
writeln(stderr,' and, if specified, saves it to [saveasname]');
writeln(stderr,' extractall <chm filename> [directory]');
writeln(stderr,' Extracts all files from archive "filename" to directory ');
writeln(stderr,' "directory"');
writeln(stderr,' unblockchm <filespec1> [filespec2] ..' );
writeln(stderr,' Mass unblocks (XPsp2+) the relevant CHMs. Multiple files');
writeln(stderr,' and wildcards allowed');
writeln(stderr,' extractalias <chmfilename> [basefilename] [symbolprefix]' );
writeln(stderr,' Extracts context info from file "chmfilename" ');
writeln(stderr,' to a "basefilename".h and "basefilename".ali,');
writeln(stderr,' using symbols "symbolprefix"contextnr');
writeln(stderr,' extracttoc <chmfilename> [filename]');
writeln(stderr,' Extracts the toc (mainly to check binary TOC)');
writeln(stderr,' extractindex <chmfilename> [filename]');
writeln(stderr,' Extracts the index (mainly to check binary index)');
writeln(stderr,' printidxhdr <chmfilename>');
writeln(stderr,' prints #IDXHDR in readable format ');
writeln(stderr,' printsystem <chmfilename>');
writeln(stderr,' prints #SYSTEM in readable format ');
writeln(stderr,' printwindows <chmfilename>');
writeln(stderr,' prints #WINDOWS in readable format ');
writeln(stderr,' printtopics <chmfilename>');
writeln(stderr,' prints #TOPICS in readable format ');
Halt(1);
end;
procedure WrongNrParam(cmd:string;number:integer);
begin
writeln(stderr,' Wrong number of parameters for ',cmd,' ',number);
usage;
halt(1);
end;
procedure InitOptions;
begin
with theopts[1] do
begin
name:='help';
has_arg:=0;
flag:=nil;
value:=#0;
end;
with theopts[2] do
begin
name:='name-only';
has_arg:=0;
flag:=nil;
end;
with theopts[3] do
begin
name:='no-page';
has_arg:=0;
flag:=nil;
end;
with theopts[4] do
begin
name:='';
has_arg:=0;
flag:=nil;
end;
end;
procedure WriteStrAdj(Str: String; CharWidth: Integer);
// Changed to WriteStrADJ (for adjust), since 2.4.0 writestr is a builtin
// Why doesn't Write() allow left aligned columns?, sigh.
var
OutString: String;
Len: Integer;
begin
Len := Length(Str);
SetLength(OutString, CharWidth-Len);
FillChar(OutString[1], CharWidth-Len, ' ');
Write(OutString + Str); // to stdout
end;
function craftpath(pth:string;filename:String):string;
var lenpth,lenfn:integer;
pthends,filenameends : Boolean;
begin
lenpth:=length(pth); lenfn :=length(filename);
if lenpth=0 then
exit(filename);
pthends:=false; filenameends:=false;
if (lenpth>0) and (pth[lenpth] in ['/','\']) then
pthends:=true;
if (lenfn>0) and (filename[1] in ['/','\']) then
filenameends:=true;
if pthends and filenameends then
result:=copy(pth,1,lenpth-1)+filename
else
if pthends or filenameends then
result:=pth+filename
else
result:=pth+pathsep+filename;
end;
procedure TListObject.OnFileEntry(Name: String; Offset, UncompressedSize,
ASection: Integer);
begin
Inc(Count);
if (Section > -1) and (ASection <> Section) then Exit;
if (Count = 1) or ((Count mod 40 = 0) and not donotpage) then
WriteLn(StdErr, '<Section> <Offset> <UnCompSize> <Name>');
if not nameonly then
begin
Write(' ');
Write(ASection);
Write(' ');
WriteStrAdj(IntToStr(Offset), 10);
Write(' ');
WriteStrAdj(IntToStr(UncompressedSize), 11);
Write(' ');
end;
WriteLn(Name);
end;
procedure TExtractAllObject.OnFileEntry(Name: String; Offset, UncompressedSize,
ASection: Integer);
var mem : TMemoryStream;
s : String;
len : integer;
procedure wrpoint;
begin
if lastone_was_point then
writeln;
lastone_was_point:=false;
end;
begin
len:=Length(Name);
if ((Len>0) and (name[len]='/')) then
exit; // directory or empty file
if (UncompressedSize=0) Then
begin
WrPoint;
Writeln(stderr,'Skipping empty file ',Name);
exit;
end;
if ((Len>0) and (name[1]=':')) then
begin
WrPoint;
Writeln(stderr,'Skipping internal file : ',Name);
exit;
end;
mem:=r.getobject(name);
if assigned(mem) then
begin
s:=craftpath(basedir,name);
ForceDirectories(extractfiledir(s));
try
mem.savetofile(s);
write('.');
lastone_was_point:=true;
except
on e : exception do
begin
WrPoint;
Writeln(Stderr,'Error saving ',name,' to ',s,'.' );
end;
end;
end
else
begin
Writeln(Stderr,'Can''t extract ',name);
end;
end;
var donotpage:boolean=false;
name_only :boolean=false;
procedure ListChm(Const Name:string;Section:Integer);
var
ITS: TITSFReader;
Stream: TFileStream;
JunkObject: TListObject;
begin
if not Fileexists(name) then
begin
writeln(stderr,' Can''t find file ',name);
halt(1);
end;
Stream := TFileStream.Create(name, fmOpenRead);
JunkObject := TListObject.Create;
JunkObject.Section:=Section;
JunkObject.Count:=0;
JunkObject.DoNotPage:=DoNotPage;
JunkObject.NameOnly:=Name_Only;
ITS:= TITSFReader.Create(Stream, True);
ITS.GetCompleteFileList(@JunkObject.OnFileEntry);
WriteLn('Total Files in chm: ', JunkObject.Count);
ITS.Free;
JunkObject.Free;
end;
procedure ExtractFile(chm,readfrom,saveto:string);
var
fs: TFileStream;
m : TMemoryStream;
r : TChmReader;
begin
if not Fileexists(chm) then
begin
writeln(stderr,' Can''t find file ',chm);
halt(1);
end;
if (length(readfrom)>1) and (readfrom[1]<>'/') then
readfrom:='/'+readfrom;
fs:=TFileStream.create(chm,fmOpenRead or fmShareDenyNone);
r:=TChmReader.Create(fs,True);
m:=r.getobject(readfrom);
if assigned(m) then
begin
try
Writeln('Extracting ms-its:/',chm,'::',readfrom,' to ',saveto);
m.savetofile(saveto);
except
on e : exception do
writeln('Can''t write to file ',saveto);
end;
end
else
begin
writeln(stderr,'Can''t find file ',readfrom,' in ',chm);
halt(1);
end;
end;
procedure ExtractFileAll(chm,dirto2:string);
var
fs: TFileStream;
m : TMemoryStream;
r : TChmReader;
fl : boolean;
ListAll : TExtractAllObject;
begin
if not Fileexists(chm) then
begin
writeln(stderr,' Can''t find file ',chm);
halt(1);
end;
if not directoryexists(dirto2) then
begin
fl:=false;
try
mkdir(dirto2);
fl:=directoryexists(dirto2);
except
on e : exception do ;
end;
if not fl then
begin
writeln(stderr,'Directory ',dirto2,' doesn''t exist, and trying to create it fails');
halt(1);
end;
end;
fs:=TFileStream.create(chm,fmOpenRead);
r:=TCHMReader.create(fs,true);
Listall:= TExtractAllObject.Create;
ListAll.basedir:=dirto2;
ListAll.r:=r;
ListAll.lastone_was_point:=false;
r.GetCompleteFileList(@ListAll.OnFileEntry);
r.free;
end;
procedure ExtractAlias(filespec:TStringDynArray);
var s,
chm,
prefixfn,
symbolname : string;
i,cnt: integer;
cl : TList;
x : PcontextItem;
f : textfile;
fs: TFileStream;
r : TChmReader;
begin
symbolname:='helpid';
chm:=filespec[0];
prefixfn:=changefileext(chm,'');
if length(filespec)>1 then
prefixfn:=filespec[1];
if length(filespec)>2 then
symbolname:=filespec[2];
if not Fileexists(chm) then
begin
writeln(stderr,' Can''t find file ',chm);
halt(1);
end;
fs:=TFileStream.create(chm,fmOpenRead);
r:=TCHMReader.create(fs,true);
cl:=r.contextlist;
if assigned(cl) and (cl.count>0) then
begin
cnt:=cl.count;
assignfile(f,changefileext(chm,'.ali'));
rewrite(f);
for i:=0 to cnt-1 do
begin
x:=pcontextitem(cl[i]);
s:=x^.url;
if (length(s)>0) and (s[1]='/') then
delete(s,1,1);
writeln(f,symbolname,x^.context,'=',s);
end;
closefile(f);
assignfile(f,changefileext(chm,'.h'));
rewrite(f);
for i:=0 to cnt-1 do
begin
x:=pcontextitem(cl[i]);
writeln(f,'#define ',symbolname,x^.context,' ',x^.context);
end;
closefile(f);
end;
r.free;
end;
procedure unblockchm(s:string);
var f : file;
begin
writeln('unblocking ',s);
assignfile(f,s+':Zone.Identifier');
rewrite(f,1);
truncate(f);
closefile(f);
end;
procedure populatefiles(files:TStringlist;filespec:string);
var
searchResult : TSearchRec;
begin
if FindFirst(filespec, faAnyFile, searchResult) = 0 then
begin
repeat
files.add(searchresult.name);
until FindNext(searchResult) <> 0;
// Must free up resources used by these successful finds
FindClose(searchResult);
end;
end;
procedure unblockchms(filespec:TStringDynArray);
var files : TStringList;
i : Integer;
begin
files :=TStringList.create;
try
for i:=0 to length(filespec)-1 do
populatefiles(files,filespec[i]);
except
writeln(stderr,'Error while scanning directory ',filespec[i]);
writeln(stderr,'Exiting....');
halt(1);
end;
if files.count>0 then
for i:=0 to files.count-1 do
unblockchm(files[i]);
Files.Free;
end;
procedure readchunk13(m:TMemoryStream;r:TChmReader);
var i,cnt,cnt2: integer;
s : ansistring;
procedure fetchstring;
begin
cnt:=m.ReadDWordLE;
s:='';
if (cnt>0) then
s:=r.readstringsentry(cnt);
end;
begin
setlength(s,4);
for i:=1 to 4 do
s[i]:=ansichar(m.readbyte);
Writeln('Identifier tag :',s);
Writeln('Unknown timestamp/checksum :',leton(m.readdword));
Writeln('Always 1 :',leton(m.readdword));
Writeln('Number of topic nodes incl. contents & index :',leton(m.readdword));
Writeln(' The following are mostly parameters of the "text/site properties" object of the sitemap contents');
Writeln('0 (meaning unknown) :',leton(m.readdword));
fetchstring;
Writeln('Imagelist param index in #strings (0,-1=none) :',cnt);
if (cnt>0) then
writeln(' = ',s);
Writeln('0 (meaning unknown) :',leton(m.readdword));
cnt:=m.ReadDWordLE;
if cnt=1 then
s:='Folder'
else
if cnt=0 then
s:='None'
else
s:='unknown value!';
Writeln('imagetype param text/site. :',cnt,' = ',s);
Writeln('Background value :',inttohex(leton(m.readdword),8));
Writeln('Foreground value :',inttohex(leton(m.readdword),8));
fetchstring;
Writeln('Font param index in #strings (0,-1=none) :',cnt);
if (cnt>0) then
writeln(' = ',s);
Writeln('Windows Styles :',inttohex(leton(m.readdword),8));
Writeln('ExWindows Styles :',inttohex(leton(m.readdword),8));
Writeln('Unknown, often -1 or 0 :',leton(m.readdword));
FetchString;
Write ('Framename :',cnt);
if (cnt>0) then
write(' = ',s);
Writeln;
FetchString;
Writeln('Windowname :',cnt);
if (cnt>0) then
writeln(' = ',s);
Writeln('Number of Information Types :',leton(m.readdword));
Writeln('Unknown. Often 1. Also 0, 3. :',leton(m.readdword));
cnt2:=m.ReadDWordLE;
Writeln('Number of files in the [MERGE FILES] list :',cnt2);
Writeln('Unknown. Often 0. :',leton(m.readdword),'(Non-zero mostly in files with some files in the merge files list)');
if cnt2>0 then
for i:=0 to cnt2-1 do
begin
fetchstring;
Writeln(' Offset ', cnt, ' = ',s);
end;
end;
procedure PrintIDXHDR(filespec:TStringDynArray);
var s,
chm,
prefixfn,
symbolname : ansistring;
i,cnt,cnt2: integer;
cl : TList;
x : PcontextItem;
f : textfile;
fs: TFileStream;
r : TChmReader;
m : TMemorystream;
begin
symbolname:='helpid';
chm:=filespec[0];
prefixfn:=changefileext(chm,'');
if not Fileexists(chm) then
begin
writeln(stderr,' Can''t find file ',chm);
halt(1);
end;
fs:=TFileStream.create(chm,fmOpenRead);
r:=TCHMReader.create(fs,true);
m:=r.getobject('/#IDXHDR');
if not assigned(m) then
begin
writeln(stderr,'This CHM doesn''t contain a #IDXHDR internal file');
halt(1);
end;
m.position:=0;
Writeln(' --- #IDXHDR ---');
readchunk13(m,r);
m.free;
r.free;
end;
procedure PrintWindows(filespec:TStringDynArray);
var s,
chm,
prefixfn,
symbolname : ansistring;
i,cnt,cnt2: integer;
x : PcontextItem;
f : textfile;
fs: TFileStream;
r : TChmReader;
m : TMemorystream;
function fetchstring:string;
var xx : longint;
begin
xx:=m.ReadDWordLE;
if (xx>0) then
result:=r.readstringsentry(xx)+ ' (index value = '+inttostr(xx)+')'
else
result:='(0)';
end;
function printstructsize(sz:integer):string;
begin
case sz of
188 : result:='Compatibility 1.0';
196 : result:='Compatibility 1.1 or later';
else
result:='unknown';
end;
end;
begin
chm:=filespec[0];
prefixfn:=changefileext(chm,'');
if not Fileexists(chm) then
begin
writeln(stderr,' Can''t find file ',chm);
halt(1);
end;
fs:=TFileStream.create(chm,fmOpenRead);
r:=TCHMReader.create(fs,true);
m:=r.getobject('/#WINDOWS');
if not assigned(m) then
begin
writeln(stderr,'This CHM doesn''t contain a #WINDOWS internal file. Odd.');
halt(1);
end;
m.position:=0;
cnt:=m.ReadDWordLE;
Writeln('Entries in #Windows : ',Cnt);
cnt2:=m.ReadDWordLE;
Writeln('Structure size : ',cnt2, ' = ',printstructsize(Cnt2));
writeln;
i:=0;
while (i<cnt) do
begin
cnt2:=m.ReadDWordLE;
Writeln('00 Structure size : ',cnt2, ' = ',printstructsize(Cnt2));
Writeln('04 htmlhelp.h indicates "BOOL fUniCodeStrings: ',m.ReadDWordLE);
Writeln('08 WindowType : ',fetchstring);
cnt2:=m.ReadDWordLE;
Write ('0C Which window properties are valid : ');
if (cnt2 and $00002)>0 then Write(' "Navigation pane style"');
if (cnt2 and $00004)>0 then Write(' "Window style flags"');
if (cnt2 and $00008)>0 then Write(' "Window extended style flags"');
if (cnt2 and $00010)>0 then Write(' "Initial window position"');
if (cnt2 and $00020)>0 then Write(' "Navigation pane width"');
if (cnt2 and $00040)>0 then Write(' "Window show state"');
if (cnt2 and $00080)>0 then Write(' "Info types"');
if (cnt2 and $00100)>0 then Write(' "Buttons"');
if (cnt2 and $00200)>0 then Write(' "Navigation Pane initially closed state"');
if (cnt2 and $00400)>0 then Write(' "Tab position"');
if (cnt2 and $00800)>0 then Write(' "Tab order"');
if (cnt2 and $01000)>0 then Write(' "History count"');
if (cnt2 and $02000)>0 then Write(' "Default Pane"');
writeln(' ( = ',inttohex(cnt2,8),')');
Writeln('10 A bit field of navigation pane styles : ',inttohex(m.readdwordLE,8));
Writeln('14 Title Bar Text : ',fetchstring);
Writeln('18 Style Flags : ',inttohex(m.readdwordLE,8));
Writeln('1C Extended Style Flags : ',inttohex(m.readdwordLE,8));
Writeln('20 Initial position (left,top,right,bottom : ',m.readdwordLE,' ' ,m.readdwordLE,' ',m.readdwordLE,' ',m.readdwordLE);
Writeln('30 Window ShowState : ',inttohex(m.readdwordLE,8));
Writeln('34 HWND hwndHelp; OUT: window handle" : ',inttohex(m.readdwordLE,8));
Writeln('38 HWND hwndCaller; OUT: who called window" : ',inttohex(m.readdwordLE,8));
Writeln('3C HH_INFOTYPE* paInfoTypes : ',inttohex(m.readdwordLE,8));
Writeln('40 HWND hwndToolBar; : ',inttohex(m.readdwordLE,8));
Writeln('44 HWND hwndNavigation; : ',inttohex(m.readdwordLE,8));
Writeln('48 HWND hwndHTML; : ',inttohex(m.readdwordLE,8));
Writeln('4C Width of the navigation pane in pixels : ',inttohex(m.readdwordLE,8));
Writeln('50 Topic panel coordinates left,top,right,bottom : ',m.readdwordLE,' ' ,m.readdwordLE,' ',m.readdwordLE,' ',m.readdwordLE);
Writeln('60 TOC File : ',fetchstring);
Writeln('64 Index File : ',fetchstring);
Writeln('68 Default File : ',fetchstring);
Writeln('6C File when Home button is pressed : ',fetchstring);
inc(i);
end;
m.free;
r.free;
end;
procedure PrintTopics(filespec:TStringDynArray);
var s,
chm,
prefixfn,
symbolname : ansistring;
i,cnt,cnt2: integer;
cl : TList;
x : PcontextItem;
f : textfile;
fs: TFileStream;
r : TChmReader;
m : TMemorystream;
chunktype,
chunksize : Word;
entries : integer;
begin
chm:=filespec[0];
prefixfn:=changefileext(chm,'');
if not Fileexists(chm) then
begin
writeln(stderr,' Can''t find file ',chm);
halt(1);
end;
fs:=TFileStream.create(chm,fmOpenRead);
r:=TCHMReader.create(fs,true);
m:=r.getobject('/#TOPICS');
if not assigned(m) then
begin
writeln(stderr,'This CHM doesn''t contain a #SYSTEM internal file. Odd.');
halt(1);
end;
m.position:=0;
entries:=m.size div 16;
if entries>0 then
for i:=0 to entries-1 do
begin
writeln('#TOPICS entry : ',i);
cnt:=m.ReadDWordLE;
writeln(' TOCIDX index:',cnt,5);
write (' Tag name :');
cnt2:=m.ReadDWordLE;
if cnt2=-1 then
writeln(cnt2)
else
begin
s:=r.ReadStringsEntry(cnt2);
writeln(s,'(',cnt2,')');
end;
write (' Tag value :');
cnt2:=m.ReadDWordLE;
if cnt2=-1 then
writeln(cnt2)
else
begin
s:=r.ReadUrlStr(cnt2);
writeln(s,'(',cnt2,')');
end;
cnt2:=m.ReadWordLE;
writeln(' contents val:',cnt2, '(2=not in contents, 6 in contents, 0/4 unknown)');
cnt2:=m.ReadWordLE;
writeln(' unknown val :',cnt2, '(0,2,4,8,10,12,16,32)');
end;
m.free;
r.free;
end;
procedure PrintSystem(filespec:TStringDynArray);
var s,
chm,
prefixfn,
symbolname : ansistring;
i,cnt,cnt2: integer;
cl : TList;
x : PcontextItem;
f : textfile;
fs: TFileStream;
r : TChmReader;
m : TMemorystream;
chunktype,
chunksize : Word;
procedure fetchstring;
begin
cnt:=m.ReadDWordLE;
s:='';
if (cnt>0) then
s:=r.readstringsentry(cnt);
end;
function printnulterminated(sz:word):string;
begin
setlength(result,sz);
if sz>0 then
begin
m.read(result[1],sz);
end;
end;
procedure printentry4(m:TMemoryStream;chsz:dword);
var q : QWord;
ts : TFileTime;
begin
writeln('(4)');
if chsz<32 then
begin
Writeln(' is too small', chsz, ' bytes instead of 32');
m.position:=m.position+chsz;
exit;
end;
writeln(' LCID from HHP file : ',m.readdwordLE );
writeln(' One if DBCS in use : ',m.readdwordLE );
writeln(' one if fullttext search is on : ',m.readdwordLE );
writeln(' Non zero if there are KLinks : ',m.readdwordLE );
writeln(' Non zero if there are ALinks : ',m.readdwordLE );
ts.dwlowdatetime:=m.readdwordLE;
ts.dwhighdatetime:=m.readdwordLE;
writeln(' Timestamp : ',ts.dwhighdatetime,':', ts.dwlowdatetime );
writeln(' 0/1 except in dsmsdn.chi has 1 : ',m.readdwordLE );
writeln(' 0 (unknown) : ',m.readdwordLE );
end;
procedure printentry8(m:TMemoryStream;chsz:dword);
var q : QWord;
ts : TFileTime;
begin
writeln('(8)');
if chsz<16 then
begin
Writeln(' is too small', chsz, ' bytes instead of 16');
m.position:=m.position+chsz;
exit;
end;
writeln(' 0 (or 4 in some) : ',m.readdwordLE );
fetchstring;
writeln(' Abbreviation : ',cnt,' = ',s);
writeln(' 3 or 5 depending on 1st field : ',m.readdwordLE );
fetchstring;
writeln(' Abbreviation explanation : ',cnt,' = ',s);
if chsz>16 then
writeln(' x size is larger than 16');
m.position:=m.position+chsz-16;
end;
begin
symbolname:='helpid';
chm:=filespec[0];
prefixfn:=changefileext(chm,'');
if not Fileexists(chm) then
begin
writeln(stderr,' Can''t find file ',chm);
halt(1);
end;
fs:=TFileStream.create(chm,fmOpenRead);
r:=TCHMReader.create(fs,true);
m:=r.getobject('/#SYSTEM');
if not assigned(m) then
begin
writeln(stderr,'This CHM doesn''t contain a #SYSTEM internal file. Odd.');
halt(1);
end;
m.position:=0;
cnt:=m.ReadDWordLE;
case cnt of
2 : s:='Compatibility 1.0';
3 : s:='Compatibility 1.1 or later';
else
s:='unknown';
end;
Writeln(' --- #SYSTEM---');
while (m.size-m.position)>=8 do
begin
chunktype := m.readwordle;
Chunksize := m.readwordle;
if (m.size-m.position)>=chunksize then
begin
case chunktype of
0 : Writeln('(0) Contents file from [options] :',printnulterminated(chunksize));
1 : Writeln('(1) Index file from [options] :',printnulterminated(chunksize));
2 : Writeln('(2) Default topic from [options] :',printnulterminated(chunksize));
3 : Writeln('(3) Title from [options] :',printnulterminated(chunksize));
4 : printentry4(m,chunksize);
5 : Writeln('(5) Default Window from [options] :',printnulterminated(chunksize));
6 : Writeln('(6) Compiled file from [options] :',printnulterminated(chunksize));
7 : Writeln('(7) DWord when Binary Index is on :',m.readdwordle, '(= entry in #urltbl has same first dword');
8 : printentry8(m,chunksize);
9 : Writeln('(9) CHM compiler version :',printnulterminated(chunksize));
10: begin
writeln('(10) Timestamp (32-bit?) :',m.readdwordle);
m.position:=m.position+chunksize-4;
end;
11: Writeln('(11) DWord when Binary TOC is on :',m.readdwordle, '(= entry in #urltbl has same first dword');
12: begin
writeln('(12) Number of Information files :',m.readdwordle);
m.position:=m.position+chunksize-4;
end;
13: begin
cnt:=m.position;
Writeln('(13)');
readchunk13(m,r);
m.position:=chunksize+cnt;
end;
14: begin
writeln('(14) MS Office related windowing constants ', chunksize,' bytes');
m.position:=m.position+chunksize;
end;
15: Writeln('(15) Information type checksum :',m.readdwordle,' (Unknown algorithm & data source)');
16: Writeln('(16) Default Font from [options] :',printnulterminated(chunksize));
else
begin
writeln('Not (yet) handled chunk, type ',chunktype,' of size ',chunksize);
m.position:=m.position+chunksize;
end;
end;
end;
end;
m.free;
r.free;
end;
const
siteext : array[TSiteMapType] of string = ('.hhc','.hhk');
procedure extracttocindex(filespec:TStringDynArray;sttype:TSiteMapType);
var s,
chm,
extractfn : string;
i,cnt: integer;
cl : TList;
f : textfile;
fs: TFileStream;
r : TChmReader;
x : TCHMSitemap;
begin
chm:=filespec[0];
extractfn:=changefileext(chm,siteext[sttype]);
if length(filespec)>1 then
extractfn:=filespec[1];
if not Fileexists(chm) then
begin
writeln(stderr,' Can''t find file ',chm);
halt(1);
end;
fs:=TFileStream.create(chm,fmOpenRead);
r:=TCHMReader.create(fs,true);
case sttype of
stindex: x:=r.GetIndexSitemap(false);
sttoc : x:=r.gettocsitemap(false);
end;
if assigned(x) then
begin
x.savetofile( extractfn);
x.free;
end;
r.free;
end;
procedure buildarglist(var params: TStringDynArray;var cmd :TCmdEnum);
var s : ansistring;
j,k : Integer;
begin
s:=uppercase(paramstr(optind));
cmd:=Low(TCMDEnum);
While (cmd<>high(TCmdEnum)) and (s<>CmdNames[cmd]) do
inc(cmd);
if cmd=CmdNone then
begin
writeln(stderr,' Using cmdls without command is deprecated, this may be removed in a future version');
writeln(stderr,' Please consider using the "list" command');
cmd:=CmdList; // no cmd found -> list In the future we can also do a name check here for the default (symlink on unix)
k:=optind;
end
else
begin
k:=optind+1;
end;
setlength(params,paramcount-k+1);
for j:=k to paramcount do
params[j-k]:=paramstr(j);
end;
Var
LocalParams : TStringDynArray;
c: char;
i,
Params,
OptionIndex : Longint;
cmd : TCmdEnum;
section : Integer = -1;
// Start of program
begin
InitOptions;
Writeln(stderr,'chmls, a CHM utility. (c) 2010 Free Pascal core.');
Writeln(Stderr);
repeat
c:=getlongopts('hnp',@theopts[1],optionindex);
case c of
#0 : begin
case optionindex-1 of
0 : begin;
Usage;
Halt;
end;
1 : name_only:=true;
2 : donotpage:=true;
end;
end;
'p' : donotpage:=true;
'n' : name_only:=true;
'?','h' :
begin
writeln('unknown option',optopt);
usage;
halt;
end;
end; { case }
until c=endofoptions;
params:=Paramcount-optind+1;
if params>0 then
begin
BuildArgList(localparams,cmd);
case cmd of
cmdlist : begin
case length(localparams) of
1 : ListChm(localparams[0],Section);
2 : begin
if not TryStrToInt(localparams[1],section) then
begin
writeln(stderr,' Invalid value for section ',localparams[2]);
usage;
halt(1);
end;
ListChm(localparams[0],Section);
end;
else
WrongNrParam(cmdnames[cmd],length(localparams));
end; {case}
end; { cmdlist}
cmdextract : begin
case length(localparams) of
2: ExtractFile(localparams[0],localparams[1],extractfilename(localparams[1]));
3: ExtractFile(localparams[0],localparams[1],localparams[2]);
else
WrongNrParam(cmdnames[cmd],length(localparams));
end;
end;
cmdextractall: begin
if length(localparams)=1 then //extract into current directory
ExtractFileAll(localparams[0],GetCurrentDir)
else if length(localparams)=2 then //extract into specified dir
ExtractFileall(localparams[0],localparams[1])
else
WrongNrParam(cmdnames[cmd],length(localparams));
end;
cmdunblock : begin
if length(localparams)>0 then
Unblockchms(localparams)
else
WrongNrParam(cmdnames[cmd],length(localparams));
end;
cmdextractalias: begin
if length(localparams)>0 then
extractalias(localparams)
else
WrongNrParam(cmdnames[cmd],length(localparams));
end;
cmdextracttoc : begin
if length(localparams)>0 then
extracttocindex(localparams,sttoc)
else
WrongNrParam(cmdnames[cmd],length(localparams));
end;
cmdextractindex: begin
if length(localparams)>0 then
extracttocindex(localparams,stindex)
else
WrongNrParam(cmdnames[cmd],length(localparams));
end;
cmdprintidxhdr: begin
if length(localparams)=1 then
printidxhdr(localparams)
else
WrongNrParam(cmdnames[cmd],length(localparams));
end;
cmdprintsystem : begin
if length(localparams)=1 then
printsystem(localparams)
else
WrongNrParam(cmdnames[cmd],length(localparams));
end;
cmdprintwindows : begin
if length(localparams)=1 then
printwindows(localparams)
else
WrongNrParam(cmdnames[cmd],length(localparams));
end;
cmdprinttopics : begin
if length(localparams)=1 then
printtopics(localparams)
else
WrongNrParam(cmdnames[cmd],length(localparams));
end;
end; {case cmd of}
end
else
begin
Usage;
halt;
end;
end.