paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 11:09:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

* extracttoc/extractbinary

Browse Source 
git-svn-id: trunk@15897 -
This commit is contained in:
marco 2010-08-24 20:27:30 +00:00
parent 74a4b4cafc
commit a8600c5bed
2 changed files with 70 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
packages/chm/src/chmls.lpr
View File

@ -28,7 +28,7 @@ program chmls;
uses
Classes, GetOpts, SysUtils, Types,
chmreader, chmbase;
chmreader, chmbase, chmsitemap;
type
@ -50,10 +50,10 @@ type
end;
TCmdEnum = (cmdList,cmdExtract,cmdExtractall,cmdUnblock,cmdextractalias,cmdNone); // One dummy element at the end avoids rangecheck errors.
TCmdEnum = (cmdList,cmdExtract,cmdExtractall,cmdUnblock,cmdextractalias,cmdextracttoc,cmdextractindex,cmdNone); // One dummy element at the end avoids rangecheck errors.
Const
CmdNames : array [TCmdEnum] of String = ('LIST','EXTRACT','EXTRACTALL','UNBLOCK','EXTRACTALIAS','');
CmdNames : array [TCmdEnum] of String = ('LIST','EXTRACT','EXTRACTALL','UNBLOCK','EXTRACTALIAS','EXTRACTTOC','EXTRACTINDEX','');
var
theopts : array[1..4] of TOption;
@ -85,7 +85,10 @@ begin
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)');
Halt(1);
end;
@ -450,11 +453,48 @@ begin
Files.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);
@ -564,6 +604,18 @@ begin
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;
end; {case cmd of}
end
else

13
packages/chm/src/chmsitemap.pas
View File

@ -135,6 +135,7 @@ type
destructor Destroy; override;
procedure LoadFromFile(AFileName: String);
procedure LoadFromStream(AStream: TStream);
procedure SaveToFile(AFileName:String);
procedure SaveToStream(AStream: TStream);
property Items: TChmSiteMapItems read FItems write SetItems;
property SiteMapType: TSiteMapType read FSiteMapType;
@ -334,6 +335,18 @@ begin
end;
end;
procedure TChmSiteMap.SaveToFile(AFileName:String);
var
fs : TFileStream;
begin
fs:=TFileStream.Create(AFileName,fmcreate);
try
SaveToStream(fs);
finally
fs.free;
end;
end;
procedure TChmSiteMap.SaveToStream(AStream: TStream);
var
Indent: Integer;