unit1.pas

帮助编写程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShlObj, shellapi;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    Edit2: TEdit;
    Button2: TButton;
    Button3: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
{$R collector.res}

function WinExecAndWait32(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, { pointer to command line string }
    nil, { pointer to process security attributes }
    nil, { pointer to thread security attributes }
    false, { handle inheritance flag }
    CREATE_NEW_CONSOLE or { creation flags }  NORMAL_PRIORITY_CLASS,
    nil, { pointer to new environment block }
    nil, { pointer to current directory name }
    StartupInfo, { pointer to STARTUPINFO }
    ProcessInfo)
    then Result := 1 { pointer to PROCESS_INF }
  else begin
    while WaitforSingleObject(ProcessInfo.hProcess, 10) = WAIT_TIMEOUT
      do Application.ProcessMessages;
    GetExitCodeProcess(ProcessInfo.hProcess, Result);
  end;
end;

function BrowseFolder: string;
var
  Info: TBrowseInfo;
  Dir: array[0..260] of char;
  ItemId: PItemIDList;
begin
  with Info do
  begin
    hwndOwner := Application.Handle;
    pidlRoot := nil;
    pszDisplayName := nil;
    lpszTitle := '请选择目录';
    ulFlags := 0;
    lpfn := nil;
    lParam := 0;
    iImage := 0;
  end;
  ItemId := SHBrowseForFolder(Info);
  SHGetPathFromIDList(ItemId, @Dir);
  Result := string(Dir);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  fileslist, hhclist, hhklist, hhplist: tstringlist;
  stream: TResourceStream;
  procedure SearchPathFile(qPath: string);
  var
    SR: TSearchRec;
    i: Integer;
  begin
    i := FindFirst(qPath + '\*.*', faDirectory, SR);
    while i = 0 do
    begin
      if (SR.Name <> '.') and (SR.Name <> '..') then
      begin
        if sr.Attr = faDirectory then //是文件夹
        begin
          hhklist.Add('    <LI> <OBJECT type="text/sitemap">');
          hhklist.Add('      <param name="Name" value="' + SR.Name + '">');
          hhklist.Add('      <param name="Local" value="' + 'empty.htm' + '">');
          hhklist.Add('      </OBJECT>');

          hhclist.Add('    <LI> <OBJECT type="text/sitemap">');
          hhclist.Add('      <param name="Name" value="' + SR.Name + '">');
          hhclist.Add('      <param name="Local" value="empty.htm">');
          hhclist.Add('      </OBJECT>');
          hhclist.Add('<UL>');
          SearchPathFile(qPath + '\' + SR.Name);
          hhclist.Add('</UL>');
        end
        else //是文件
        begin
          fileslist.Add('<p><a href="' + qPath + '\' + SR.Name + '">' + SR.Name + '</a> </p>');

          hhplist.Add(qPath + '\' + SR.Name);

          hhklist.Add('    <LI> <OBJECT type="text/sitemap">');
          hhklist.Add('      <param name="Name" value="' + SR.Name + '">');
          hhklist.Add('      <param name="Local" value="' + qPath + '\' + SR.Name + '">');
          hhklist.Add('      </OBJECT>');

          hhclist.Add('    <LI> <OBJECT type="text/sitemap">');
          hhclist.Add('      <param name="Name" value="' + SR.Name + '">');
          hhclist.Add('      <param name="Local" value="' + qPath + '\' + SR.Name + '">');
          hhclist.Add('      </OBJECT>');
        end;
      end;
      i := FindNext(sr);
    end;
    FindClose(sr);
  end;

begin
Button1.Enabled :=false;
  hhplist := tstringlist.Create;
  hhclist := tstringlist.Create;
  hhklist := tstringlist.Create;
  fileslist := tstringlist.Create;

  fileslist.Add('<html>');
  fileslist.Add('<head>');
  fileslist.Add('<title>总目录</title>');
  fileslist.Add('<meta http-equiv="Content-Type" content="text/html; charset=gb2312">');
  fileslist.Add('</head>');
  fileslist.Add('');
  fileslist.Add('<body bgcolor="#FFFFFF">');
  fileslist.Add('<PRE>');
  fileslist.Add('<h1 align="center"><font face="Verdana, Arial, Helvetica, sans-serif"><b>欢迎使用 Collector 资料收集管理器</b></font></h1>');
  fileslist.Add('<b>下载地址 http://nj.onlinedown.net/soft/11484.htm</b></font>');
  fileslist.Add('<hr width="100%" color="red" noshade>');
  fileslist.Add('');

  hhplist.add('[OPTIONS]');
  hhplist.add('Compatibility=1.1 or later');
  hhplist.add('Compiled file=' + edit2.Text);
  hhplist.add('Contents file=' + ExtractFilePath(edit2.Text) + '\hhc.hhc'); // + hhcFile);
  hhplist.add('Default Window=WIN2000');
  hhplist.add('Default topic=' + ExtractFilePath(edit2.Text) + 'index.htm'); // + ListFile);
  hhplist.add('Display compile progress=yes');
  hhplist.add('Full-text search=Yes');
  hhplist.add('Index file=' + ExtractFilePath(edit2.Text) + '\hhk.hhk');
  hhplist.add('Language=0x804 中文(中国)'); //0x409
  hhplist.add('Title=欢迎使用 Collector 资料收集管理器');
  hhplist.add('');
  hhplist.add('');
  hhplist.add('[FILES]');
  hhplist.add(ExtractFilePath(edit2.Text) + 'index.htm');

  hhclist.Add('<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">');
  hhclist.Add('<HTML>');
  hhclist.Add('<HEAD>');
  hhclist.Add('<meta name="GENERATOR" content="Microsoft? HTML Help Workshop 4.1">');
  hhclist.Add('<!-- Sitemap 1.0 -->');
  hhclist.Add('</HEAD><BODY>');
  hhclist.Add('<OBJECT type="text/site properties">');
  hhclist.Add('  <param name="ImageType" value="Folder">');
  hhclist.Add('</OBJECT>');
  hhclist.Add('<UL>');
  hhclist.Add('  <LI> <OBJECT type="text/sitemap">');
  hhclist.Add('    <param name="Name" value="目录">');
  hhclist.Add('    <param name="Local" value="' + ExtractFilePath(edit2.Text) + 'index.htm' + '">');
  hhclist.Add('    </OBJECT>');
  hhclist.Add('<UL>');
  hhclist.Add('  <LI> <OBJECT type="text/sitemap">');
  hhclist.Add('    <param name="Name" value="'+ExtractFileName(edit1.Text )+'">');
  hhclist.Add('    <param name="Local" value="' + ExtractFilePath(edit2.Text) + 'Collector.htm' + '">');
  hhclist.Add('    </OBJECT>');

  hhclist.Add('  <UL>');

  hhklist.Add('<HTML><HEAD></HEAD><BODY>');
    hhklist.Add('<UL>');
  hhklist.Add('  <LI> <OBJECT type="text/sitemap">');
  hhklist.Add('    <param name="Name" value="'+ExtractFileName(edit1.Text )+'">');
  hhklist.Add('    <param name="Local" value="' + ExtractFilePath(edit2.Text) + 'Collector.htm' + '">');
  hhklist.Add('    </OBJECT>');

 //   Resourcefile(outputfilepath, res_string, outputfiletype: string);

    Stream := TResourceStream.Create(Hinstance, 'Collector', PCHAR('htm'));
    Stream.SaveToFile(ExtractFilePath(edit2.Text) + '\Collector' + '.' + 'htm');
    Stream.Free;


  SearchPathFile(edit1.Text);

  fileslist.Add('');
  fileslist.Add('<hr width="100%" color="blue" noshade>');

  fileslist.Add('</body>');
  fileslist.Add('</PRE>');
  fileslist.Add('</html>');


  hhclist.Add('</UL>');
  hhclist.Add('</UL>');
  hhclist.Add('</UL>');
  hhclist.Add('</BODY></HTML>');

  hhklist.Add('</UL>');
  hhklist.Add('</BODY></HTML>');

  fileslist.SaveToFile(ExtractFilePath(edit2.Text) + '\index.htm');
  hhplist.SaveToFile(ExtractFilePath(edit2.Text) + '\hhp.hhp');
  hhklist.SaveToFile(ExtractFilePath(edit2.Text) + '\hhk.hhk');
  hhclist.SaveToFile(ExtractFilePath(edit2.Text) + '\hhc.hhc');
  fileslist.Free;
  hhplist.Free;
  hhklist.Free;
  hhclist.Free;

  WinExecAndWait32(pchar(ExtractFilePath(Application.ExeName) + 'hhc.exe') + ' ' + pchar(ExtractFilePath(edit2.Text) + '\hhp.hhp'), 0);
  ShellExecute(handle, 'Open', pchar(edit2.Text), nil, nil, sw_Show);
  DeleteFile(ExtractFilePath(edit2.Text) + '\index.htm');
  DeleteFile(ExtractFilePath(edit2.Text) + '\Collector.htm');
  DeleteFile(ExtractFilePath(edit2.Text) + '\hhp.hhp');
  DeleteFile(ExtractFilePath(edit2.Text) + '\hhk.hhk');
  DeleteFile(ExtractFilePath(edit2.Text) + '\hhc.hhc');
  Button1.Enabled :=true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  edit1.Text := BrowseFolder;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  with SaveDialog do
  begin
    DefaultExt := 'chm';
    Filter := '帮助文件(CHM)|*.CHM';
  end;
  if SaveDialog.Execute then
  begin
    edit2.Text := SaveDialog.FileName;
  end;
end;

end.