enset.pas

chm制作工具

{∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑
◎→
◎→                      Tresss Studio
◎→  Project: UPCHM
◎→  Start Date:2006/1/14
◎→  Change Date:2006/1/16
◎→  System: Delphi6+WinXP
◎→  Author: Tresss
◎→  E-Mail: [e-mail]
◎→  Character: Main File,Main Function
◎→  Tips:此文件为本软件主要功能实现单元;
◎→       由Main来调用;
◎→       GetNodeIndex None Used;
◎→
◎→
∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑}
unit EnSet;

interface
Uses Windows,Classes,Sysutils,Forms,ShlObj,Comctrls,ExFile,Main;

Procedure SetbfIndex;           //寻找最前五个文件做为首页的备选;
Procedure CompileCHM;           //编译当前工程;
Procedure DeCompileCHM;          //反编译电子书;
Function SelectDir:String;      //选择导入目录;
//运行一个外部程序并等待其结束;
function ExecProc(FileName: string; Visibility: integer): Dword;
//列出当前目录文件;
procedure DirList(AParentPath: string; var ATreeView: TTreeView; AParentNode: TTreeNode);
Procedure DeleteNull;          //删除空目录;
Function GetNodeIndex(node:TTreeNode):Integer;      //取得node总序数;
Procedure DisMainPnl;  //禁用主要操作面板;
Procedure EnMainPnl;    //启用主要操作面板;
Procedure RemoveTNode(Node:TTreeNode);   //删除Tree目录;

Implementation

 //为CHM设置中首页选取最前的五个路径备用;
Procedure SetbfIndex;
Var
  IntUse,Intc,Intl:Integer;
  StrUse:String;
Begin
  StrUse:=FrmMain.CboCsIndex.Text;
  FrmMain.CboCsIndex.Clear;
  FrmMain.CboCsIndex.Text:=StrUse;
  Intl:=FrmMain.StrPath.Count;
  If Intl=0 Then Exit;
  Intc:=0;
  IntUse:=0;
  While (IntUse<=Intl) And (Intc<5) Do
  Begin
    StrUse:=FrmMain.StrPath.Strings[IntUse];
    If StrUse<>'' Then
    Begin
      FrmMain.CboCSIndex.Items.Add(StrUse);
      Inc(Intc);
    End;
    Inc(IntUse);
  End;
End;

//编译当前电子书;
Procedure CompileCHM;
Var
  IntLoop,Intc:Integer;
  Node:TTreeNode;
  Myres:TResourceStream;
begin
  Intc:=FrmMain.Trv1.Items.Count;
  SetLength(FrmMain.IntPath,Intc);
  For IntLoop:=0 To Intc-1 Do
  Begin
    Node:=FrmMain.Trv1.Items[IntLoop];
    If Node.Count=0 Then
      FrmMain.IntPath[IntLoop]:=PInteger(Node.Data)^;
  End;
  MyRes:=TResourceStream.Create(hInstance,'hhc','myexe');
  MyRes.SaveToFile(FrmMain.CurDir+'hhc.exe');
  Exhhp;
  ExHhc;
  ExHhk;
  SetLength(FrmMain.IntPath,0);
  ExecProc(FrmMain.CurDir+'hhc.exe '+FrmMain.CurDir+'Tresss.hhp',0);
  WinExec(pchar('hh.exe '+FrmMain.EdtCsPath.Text),SW_SHOW);
  DeleteFile(PChar(FrmMain.CurDir+'hhc.exe'));
  DeleteFile(PChar(FrmMain.CurDir+'Tresss.hhp'));
  DeleteFile(PChar(FrmMain.CurDir+'Tresss.hhk'));
  DeleteFile(PChar(FrmMain.CurDir+'Tresss.hhc'));
  EnMainPnl;
  FrmMain.PnlCompile.Hide;
End;

//运行一个外部程序并等待其结束;
function ExecProc(FileName: string; Visibility: integer): Dword;
var
  zAppName: array[0..512] of char;
  zCurDir: array[0..255] of char;
  WorkDir: string;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  StrPCopy(zAppName, FileName);
  GetDir(0, WorkDir);
  StrPCopy(zCurDir, WorkDir);
  FillChar(StartupInfo, Sizeof(StartupInfo), #0);
  StartupInfo.cb := Sizeof(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
  if not CreateProcess(nil,zAppName,nil,nil,false,
    CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
    nil,nil,StartupInfo,ProcessInfo)
    then Result := 1
  else begin
    while WaitforSingleObject(ProcessInfo.hProcess, 10) = WAIT_TIMEOUT
      do Application.ProcessMessages;
    GetExitCodeProcess(ProcessInfo.hProcess, Result);
  end;
end;

//选择目录;
Function SelectDir:String;
Var
  InfoDir:TBrowseInfo;
  StrDir:Array [0..255] of char;
  IidDir:PitemIDList;             //ShlObj;
Begin
  With InfoDir Do
  Begin
    hWndOwner:=Application.Handle;
    PidlRoot:=Nil;
    pszDisplayName:=Nil;
    lpszTitle:='请选择目录:';
    ulFlags:=$0042;
    lpfn:=Nil;
    lParam:=13;
    iImage:=12;
  End;
  IidDir:=SHBrowseForFolder(InfoDir);
  SHGetPathFromIDList(IidDir,@StrDir);
  Result:=String(StrDir);
End;

//反编译当前电子书;
Procedure DeCompileCHM;
Var
  StrFile,StrPath:String;
Begin
  StrFile:=FrmMain.EdtComDestChm.Text;
  StrPath:=FrmMain.EdtComDestDir.Text;
  If fileExists(StrFile) And directoryexists(StrPath) Then
  Begin
    ExecProc('hh.exe -decompile '+StrPath+' '+StrFile,0);
  End;
End;

//列出目录;
procedure DirList(AParentPath: string; var ATreeView: TTreeView; AParentNode: TTreeNode);
var
  SR: TSearchRec;
  nCount,Inti: Integer;
  Node: TTreeNode;
  StrUse,StrExt:string;     //显示的扩展名列表;
  Procedure SetNodeData(sNode:TTreeNode;Intn:Integer);
  Var
    Pn:PInteger;
  Begin
    If Not Assigned(SNode) Then Exit;
    GetMem(Pn,SizeOf(Integer));
    Pn^:=Intn;
    sNode.Data:=Pn;
  End;
  Function GetListExt:String;
  Var            //格式化扩展名;
    IntKey,IntLen,IntLoop:Integer;
    StrList,StrExt:String;
  begin
    StrList:=UpperCase(FrmMain.EdtUsExt.Text);
    IntLen:=Length(StrList);
    IntKey:=0;
    StrExt:='';
    For IntLoop:=1 To IntLen Do
    Begin
      If (IntKey=1) And (StrList[IntLoop]<>'.') Then
        StrExt:=StrExt+'.';
      StrExt:=StrExt+StrList[IntLoop];
      If StrList[IntLoop]=';' Then
        IntKey:=1
      Else
        IntKey:=0;
    End;
    If StrExt[Length(StrExt)]<>';' Then StrExt:=StrExt+';';
    If StrList[1]<>'.' Then StrExt:='.'+StrExt;
    Result:=StrExt;
  end;
begin
  StrExt:=GetListExt;
  nCount := FindFirst(AParentPath + '\*.*', faAnyFile, SR);
  while nCount = 0 do begin
    if (SR.Name = '.') or (SR.Name = '..') then begin
      nCount:=FindNext(SR);
      Continue;
    end;
    if SR.Attr = faDirectory then begin
      Node := ATreeView.Items.AddChild(AParentNode, SR.Name);
      Node.ImageIndex:=0;
      Node.SelectedIndex:=1;
      DirList(AParentPath + '\' + SR.Name, ATreeView, Node);
    end
    else
    begin
      If Pos(UpperCase(extractfileext(Sr.Name)),StrExt)>0 then
      Begin
        Node:=ATreeView.Items.AddChild(AParentNode,ChangeFileExt(SR.Name,''));
        Node.ImageIndex:=10;
        Node.SelectedIndex:=11;
        StrUse:=AparentPath+'\'+Sr.Name;
        StrUse:=Copy(StrUse,FrmMain.LenDir,50);
        Inti:=FrmMain.StrPath.Add(StrUse);
        SetNodeData(Node,Inti);
      End;
    end;
    nCount := FindNext(SR);
  end;
  FindClose(SR);
end;

//删除空目录;
Procedure DeleteNull;
Var
  node:TTreeNode;
  IntInd:Integer;
Begin
  IntInd:=0;
  While IntInd<=FrmMain.Trv1.Items.Count-1 Do
  Begin
    node:=FrmMain.Trv1.Items[IntInd];
    If (Node.ImageIndex=0) And (Node.Count=0) Then
      Node.Delete
    Else
      Inc(IntInd);
  End;
End;

//取得node的总序号;
Function GetNodeIndex(node:TTreenode):integer;
Var
  sNode:TTreenode;
  i:integer;
Begin
  for i:=0 to FrmMain.Trv1.Items.Count Do
  Begin
    sNode:=FrmMain.Trv1.Items[i];
    If sNode=Node Then Break;
  End;
  result:=i;
End;

//禁用主要操作面板;
Procedure DisMainPnl;
Begin
  With FrmMain Do
  Begin
    PnlTop.Enabled:=False;
    PnlLeft.Enabled:=False;
    PnlMain.Enabled:=False;
  End;
End;

//启用主要操作面板;
Procedure EnMainPnl;
Begin
  With FrmMain Do
  Begin
    PnlTop.Enabled:=True;
    PnlLeft.Enabled:=True;
    PnlMain.Enabled:=True;
  End;
End;

//删除Tree目录节点;
Procedure RemoveTNode(Node:TTreeNode);
Var
  iNode:TTreeNode;
Begin
  iNode:=node.getFirstChild;
  While iNode<>Nil Do
  Begin
    If iNode.Count=0 Then
      FrmMain.StrPath.Strings[PInteger(iNode.Data)^]:=''
    Else
      RemoveTNode(iNode);
    iNode:=iNode.getNextSibling;
  End;
End;


end.