// tochm.dpr
// Format : tochm path attrib level exclude
// 绝对路径 文件类型 chm层次级别 剔除的文件
// 例：tochm D:/work/公文/中国白皮书 *.txt 2
// txt做出的chm不能全文检索，最好是htm
program tochm;
{$APPTYPE CONSOLE}
uses
SysUtils,classes,FileCtrl;
var
attr:string;
basedir : array of string;
baseL:array of integer;
hhpF,hhcF: array of TextFile;
exclude:string;
chmLevel:integer;
chmdir:string;
batF:TStringList;
function SlashSep(const Path, S: String): String;
begin
if AnsiLastChar(Path)^ <> '/' then
Result := Path + '/' + S
else
Result := Path + S;
end;
function ReadDirectoryNames(const ParentDirectory: string;const DirType:string;
DirectoryList: TStringList): Integer;
var
Status: Integer;
SearchRec: TSearchRec;
begin
Result := 0;
Status := FindFirst(SlashSep(ParentDirectory, DirType), faDirectory, SearchRec);
try
while Status = 0 do
begin
if ((SearchRec.Attr and faDirectory) = faDirectory) then
begin
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
DirectoryList.Add(SearchRec.Name);
Inc(Result);
end;
end;
Status := FindNext(SearchRec);
end;
finally
SysUtils.FindClose(SearchRec);
end;
end;
function ReadFileNames(const ParentDirectory: string;const FileType:String;
FileList: TStringList): Integer;
var
Status: Integer;
SearchRec: TSearchRec;
begin
Result := 0;
Status := FindFirst(SlashSep(ParentDirectory, FileType), faDirectory, SearchRec);
try
while Status = 0 do
begin
// if((SearchRec.Attr and (faReadOnly or faHidden or faSysFile or faArchive))>0) or (SearchRec.Attr=0) then
if (SearchRec.Attr and (faVolumeID or faDirectory )) =0 then
begin
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
FileList.Add(SearchRec.Name);
Inc(Result);
end;
end;
Status := FindNext(SearchRec);
end;
finally
SysUtils.FindClose(SearchRec);
end;
end;
procedure _PathToChm(dir:string;
Level:integer=0 );
var
FileList:TStringList;
fName:string;
rdir:string;
i:integer;
prj:string;
outlevel:boolean;
begin
if level <= chmlevel then
begin
basedir[level]:=copy(dir,1,length(dir)-1);
prj:=ExtractFileName(basedir[level]);
assignFile(hhpF[level],basedir[level]+'.hhp');
assignFile(hhcF[level],basedir[level]+'.hhc');
BatF.Insert(0,'move '+basedir[level]+'.chm '+chmdir);
BatF.Insert(0,'hhc '+basedir[level]+'.hhp');
basedir[level]:=SlashSep(basedir[level],'');
rewrite(hhcF[level]);rewrite(hhpF[level]);
writeln(hhcF[level], '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">');
writeln(hhcF[level], '<HTML>');
writeln(hhcF[level], '<HEAD>');
writeln(hhcF[level], '<meta name="GENERATOR" content="Microsoft®
HTML Help Workshop 4.1">');
writeln(hhcF[level], '<!-- Sitemap 1.0 -->');
writeln(hhcF[level], '</HEAD><BODY>');
writeln(hhcF[level], '<OBJECT type="text/site properties">');
writeln(hhcF[level], ' <param name="Window Styles" value="0x800025">');
writeln(hhcF[level], ' <param name="ImageType" value="Folder">');
writeln(hhcF[level], '</OBJECT>');
writeln(hhpF[level],'[OPTIONS]');
writeln(hhpF[level],'Contents file='+prj+'.hhc');
writeln(hhpF[level],'Compatibility=1.1 or later');
writeln(hhpF[level],'Compiled file='+prj+'.chm');
writeln(hhpF[level],'Contents file='+prj+'.hhc');
writeln(hhpF[level],'Default Font=宋体,9,134');
writeln(hhpF[level],'Default Window=search');
writeln(hhpF[level],'Default topic=index.htm');
writeln(hhpF[level],'Display compile progress=No');
writeln(hhpF[level],'Enhanced decompilation=Yes');
writeln(hhpF[level],'Full-text search=Yes');
if level >= chmlevel then
writeln(hhpF[level],'Binary TOC=Yes');
writeln(hhpF[level],'Language=0x804 中文(中国)');
writeln(hhpF[level],'');
writeln(hhpF[level],'[WINDOWS]');
writeln(hhpF[level],'search=,"'+prj+'.hhc",,"index.htm","index.htm",,,,,0x23520,,0x307e,,0x1000000,,,,,,0');
writeln(hhpF[level],'');
writeln(hhpF[level],'[FILES]');
writeln(hhpF[level],'');
writeln(hhpF[level],'[MERGE FILES]');
BaseL[level]:=Length(basedir[level])-Length(prj)-1;
outlevel:=false;
end
else
begin
level:=chmlevel;
outlevel:=true;
end;
writeln(hhcF[level],'<UL>');
FileList:=TstringList.Create;
// rdir:=SlashSep(Dir,'');
// if rdir<>SlashSep(basedir[level],'') then
{ begin
setLength(rdir,Length(rdir)-1);
rdir:=ExtractFileName(rdir);
writeln(hhcF[level],'<LI> <OBJECT type="text/sitemap">'
+'<param name="Name" value="'+rdir+'">'
// +'<param name="Local" value="">'
+'</OBJECT>');
end;
}
FileList.Clear;
ReadDirectoryNames(Dir,'*.*',FileList);
if FileList.Count >0 then
begin
FileList.Sort;
for i:= 0 to FileList.Count -1 do
begin
if paramcount>2 then
if pos(exclude,FileList.Strings
)=0 then
begin
//增加一个合并文件
rdir:=ExtractFileName(copy(dir,1,length(dir)-1));
writeln(hhcF[level],'<LI> <OBJECT type="text/sitemap">'#13#10
+'<param name="Name" value="'+FileList.Strings+'">'#13#10
+'</OBJECT>');
// writeln(hhcF[level],'<UL>');
if level < chmlevel then
begin
writeln(hhcF[level],'<OBJECT type="text/sitemap">'#13#10
+'<param name="Merge" value="'+FileList.Strings+'.chm::/'+FileList.Strings+'.hhc">'#13#10
+'</OBJECT>');
writeln(hhpF[level],FileList.Strings+'.chm');
_PathToChm(SlashSep(Dir+FileList.Strings,''),level+1);
end
else
_PathToChm(SlashSep(Dir+FileList.Strings,''),level+1);
// writeln(hhcF[level],'</UL>');
end;
end;
end;
FileList.Clear;
ReadFileNames(Dir,attr,FileList);
if FileList.Count >0 then
begin
FileList.Sort;
for i:= 0 to FileList.Count -1 do
begin
fName:=FileList.Strings;
rdir:=copy(SlashSep(Dir,fName),BaseL[level]+1,1000);
setlength(fName,Length(fName)-length(ExtractFileExt(fname)));
writeln(hhcF[level], '<LI> <OBJECT type="text/sitemap">'#13#10
+'<param name="Name" value="'+fName+'">'#13#10
+'<param name="Local" value="'+rdir+'">'#13#10
+'</OBJECT>');
// writeln(hhpF[level],rdir);
不是必须的。
end;
end;
writeln(hhcF[level],'</UL>');
if (level <= chmlevel) and not outlevel then
begin
CloseFile(hhpF[level]);
CloseFile(hhcF[level]);
end;
end;
procedure PathToChm;
begin
_PathToChm(BaseDir[0]);
end;
begin
if ParamCount=0 then
begin
Writeln(' Format : tochm path attrib level exclude ');
exit;
end
else
begin
if paramcount>1 then
attr:=paramstr(2)
else
attr:='*.htm';
if paramcount>2 then
chmLevel:=StrToInt(paramstr(3))
else
chmlevel:=1;
begin
setlength(hhpF,chmlevel);
setlength(hhcF,chmlevel);
setlength(basedir,chmlevel);
setlength(baseL,chmlevel);
dec(chmlevel);
end;
if paramcount>3 then
exclude:=paramstr(4);
BaseDir[0]:=ParamStr(1);
end;
BaseDir[0]:=SlashSep(trim(basedir[0]),'');
SetLength(BaseDir[0],Length(BaseDir[0])-1);
forceDirectories(BaseDir[0]+'.chms');
chmdir:=BaseDir[0]+'.chms';
BatF:=TStringList.Create;
BaseDir[0]:=SlashSep(basedir[0],'');
pathtochm;
BatF.SaveToFile(chmdir+'/buildchm.bat');
// Insert user code here
end.
