chmcompiler.pas

帮助编写程序

unit ChmCompiler;

interface 

uses 
  Windows, SysUtils; 

type 
  TChmCompileFunc = function(pszHhpFile: PChar; pLogString: Pointer; pProgress: Pointer): Bool; stdcall; 

  TLogMessageEvent = procedure(Msg: string) of object; 
  TProgressEvent = function(FileName: string): Boolean of object; 

  TChmCompiler = class 
  private 
   FDll: HMODULE; 
   FProc: TChmCompileFunc; 

   FOnLogMessage: TLogMessageEvent; 
   FOnProgress: TProgressEvent; 
  protected 
   constructor Create; 
  public 
   destructor Destroy; override; 

   class function Default: TChmCompiler; 

   function Compile(FileName: TFileName): Boolean; 

   property OnLogMessage: TLogMessageEvent read FOnLogMessage write FOnLogMessage; 
   property OnProgress: TProgressEvent read FOnProgress write FOnProgress; 
  end; 

implementation 

uses 
  ActiveX; 

var 
  GChmCompiler: TChmCompiler; 

procedure LogMessageFunc(pszMsg: PChar); stdcall; 
begin 
  Assert(Assigned(GChmCompiler)); 

  if Assigned(GChmCompiler.OnLogMessage) then 
   GChmCompiler.OnLogMessage(pszMsg); 
end; 

function ProgressFunc(pszFile: PChar): Bool; stdcall; 
begin 
  Assert(Assigned(GChmCompiler)); 

  if Assigned(GChmCompiler.OnProgress) then 
   Result := GChmCompiler.OnProgress(pszFile) 
  else 
   Result := True; 
end; 

{ TChmCompiler } 

constructor TChmCompiler.Create; 
begin 
  FDll := SafeLoadLibrary('HHA.DLL'); 

  if FDll = 0 then RaiseLastOSError; 

  FProc := TChmCompileFunc(GetProcAddress(FDll, 'HHA_CompileHHP')); 
  //FProc := TChmCompileFunc(GetProcAddress(FDll, PChar($13F))); 

  if @FProc = nil then RaiseLastOSError; 

  CoInitialize(nil); 
end; 

destructor TChmCompiler.Destroy; 
begin 
  CoUninitialize(); 
  
  FProc := nil; 

  if FDll <> 0 then 
   Win32Check(FreeLibrary(FDll)); 

  inherited; 
end; 

class function TChmCompiler.Default: TChmCompiler; 
begin 
  if not Assigned(GChmCompiler) then 
   GChmCompiler := TChmCompiler.Create; 

  Result := GChmCompiler; 
end; 

function TChmCompiler.Compile(FileName: TFileName): Boolean; 
var 
  szFileName: PChar; 
  LogMessageProc, ProgressProc, CompileProc: Pointer; 
  Ret: BOOL; 
begin 
  szFileName := PChar(FileName); 
  LogMessageProc := @LogMessageFunc; 
  ProgressProc := @ProgressFunc; 
  CompileProc := @FProc; 
  asm 
   XOR EAX, EAX 
   PUSH EAX 
   MOV EAX, ProgressProc 
   MOV ECX, LogMessageProc 
   MOV EDX, szFileName; 
   PUSH EAX 
   PUSH ECX 
   PUSH EDX 
   CALL CompileProc 
   MOV Ret, EAX 
  end; 
  Result := Ret; 
end; 

initialization 
  GChmCompiler := nil; 

finalization 
  if Assigned(GChmCompiler) then FreeAndNil(GChmCompiler); 

end.