hh_funcs.pas

企业端数据申报系统：单位管理模块 单位查询. 业务申报模块 在线数据下载 在线数据上传 在线业务申核 申报业务查询 磁盘数据导出 磁盘数据导入 在线业务模块 在线业务

{*******************************************************}
{                                                       }
{       HTML Help helper functin                        }
{                                                       }
{       Copyright (c) 1999  The Helpware Group          }
{                                                       }
{*******************************************************}

{
========================================================
  hh_funcs.pas
  Version 1.52
  Html Help helper functions

  Copyright (c) 1999 The Helpware Group
  Email: [e-mail]
  Web: http://www.helpware.net
  Platform: Delphi 2, 3, 4, 5, ...
  Changes Notes: See hh_doc.txt

1.51
  Debug info now displays Operating system type and version
1.6 25/9/2001
  Add Window Media Player detection
  Update IE HH version numbers

========================================================
}
unit hh_funcs;

interface

uses Windows,   //This line will not compile under Delphi 1 -- D1 is not supported
     SysUtils, Classes, Forms, Dialogs, ShellApi, Registry, FileCtrl;


{ >> Create conditional symbols.
     Note: This module is Delphi 2/3/4/5/.. compatible

     VER90     - Predefined by Delphi 2 compiler.
     VER100    - Predefined by Delphi 3 compiler.
     D3PLUS    - Compiler is Delphi 3 or greater
     D4PLUS    - Compiler is Delphi 4 or greater
}

{$DEFINE D3PLUS}
{$DEFINE D4PLUS}

{$IFDEF VER90}        //Dephi 2
  {$UNDEF D3PLUS}
  {$UNDEF D4PLUS}
{$ENDIF}

{$IFDEF VER100}       //Dephi 3
  {$UNDEF D4PLUS}
{$ENDIF}


{ Host Type }
type THostType = (htHHAPI, htKeyHHexe, htHHexe);

{ HH comand line prefix}
type TPrefixType = (ptNone, ptIE3, ptIE4);

{Exports}
  procedure HHCloseAll;

  function HHDisplayTopic(aChmFile, aTopic, aWinDef: String; aHostType: THostType): Integer;
  function HHHelpContext(aChmFile: String; aContextID: DWord; aWinDef: String; aHostType: THostType): Integer;

  function HHTopic(aCHMPath: String; aHostType: THostType): Integer;
  function HHContext(aChmPath: String; aContextId: Integer; aHostType: THostType): Integer;

  function HHFormat(aChmFile, aTopic, aWinDef: String; aPrefixType: TPrefixType): String;
  procedure HHSlitCmdStr(s: String; var aChmFile, aTopic, aWinDef: String);  //typo kept for backward compatibility
  procedure HHSplitCmdStr(s: String; var aChmFile, aTopic, aWinDef: String);

  procedure HHShowError(err: Integer);


{Callbacks available for THookHelpSystem}
type
  THelpProcCallback1 = procedure (Data: Longint);
  THelpProcCallback2 = procedure (Data: Longint; X, Y: Integer);


{THookHelpSystem}
type
  THookHelpSystem = class(TObject)
  private
    FOldHelpEvent: THelpEvent;
    FChmFile: String;
    FWinDef: String;
    FHostType: THostType;
    FPopupXY: TPoint;
    function HelpHook(Command : Word; Data : Longint; Var CallHelp : Boolean) : Boolean;
  public
    {Optional callback funcs called when Help events come in}
    HelpCallback1: THelpProcCallback1;
    HelpCallback2: THelpProcCallback2;

    constructor Create(aDefChmFile, aDefWinDef: String; aHostType: THostType);
    destructor Destroy; override;

    function HelpContext(aContextId: DWord): Integer;
    function HelpTopic(aTopic: String): Integer;
    function HelpTopic2(aChmFile, aTopic, aWinDef: String): Integer;
    function HelpTopic3(aChmPath: String): Integer;

    property ChmFile: String read FChmFile write FChmFile;
    property WinDef: String read FWinDef write FWinDef;
    property HostType: THostType read FHostType write FHostType;
  end;


{ See Module initialization }
var
  { 'hhctrl.ocx' version info }
  _hhInstalled: Boolean = FALSE;          //Is Html Help 'hhctrl.ocx' installed
  _hhVerStr: String = '';                 //eg. '4.73.8252.1' or '' if not found
  _hhMajVer: word = 0;                    //eg. 4
  _hhMinVer: word = 0;                    //eg. 73
  _hhBuildNo: word = 0;                   //eg. 8252
  _hhSubBuildNo: word = 0;                //eg. 1
  _hhFriendlyVerStr: String = '';         //eg. '1.2'

  { 'Shdocvw.dll' version info }
  _ieInstalled: Boolean = FALSE;          //Is Internet Explorer Installed
  _ieVerStr: String = '';                 //eg. '5.00.0910.1309'
  _ieFriendlyVerStr: String = '';         //eg. 'Internet Explorer 5'

  { General }
  _RunDir: String = '';                   //applications run directory. Or Host EXE directory if part of DLL.
  _ModulePath: String;                    //If part of DLL this is the full path to the DLL
  _ModuleDir: String;                     //If part of DLL this is the DLL Dir and different from _RunDir
  _ModuleName: String;                    //If part of DLL this is the DLL name otherwise it is host exe name

  _DebugMode: Boolean = FALSE;            //Set TRUE to enable debug file output. Or create a file 'debug.debug' in the rundir



{ Host Apps - Live in the Windows Dir }
const
  HOST_HHEXE = 'HH.EXE';
  HOST_KEYHHEXE = 'KeyHH.EXE';

{ HH comand line prefix}
const
  HH_PREFIX_IE4 = 'ms-its:';             //IE4 and above compatible command line prefix
  HH_PREFIX_IE3 = 'mk:@MSITStore:';      //IE3 and above compatible command line prefix


{ HH Errors }
const
  HH_ERR_AllOK              = 0;
  HH_ERR_HHNotInstalled     = 1;     //Html Help is not installed on this PC
  HH_ERR_KeyHHexeNotFound   = 2;     //KeyHH.EXE was not found in the Windows folder
  HH_ERR_HHexeNotFound      = 3;     //HH.EXE was not found in the Windows folder


{ exports - General functions }

procedure DosToUnix(var filename: String);
function StrPosC(const s: String; const find: String): Integer;
function StrPosI(const s: String; const find: String): Integer;
function StrRepC(var s: String;  const find, repl: String): Integer;
function StrRepI(var s: String;  const find, repl: String): Integer;
function StrRepCA(var s: String;  const find, repl: String): Integer;
function StrRepIA(var s: String;  const find, repl: String): Integer;
procedure StripL(var s: String; c: char);
procedure StripR(var s: String; c: char);
procedure StripLR(var s: String; c: char);
function MkStr(c: Char; count: Integer): String;
function BoolToYN(b: Boolean): String;

function GetWinDir: String;
function GetWinSysDir: String;
function GetWinTempDir: String;

function VerCompare(va1, va2, va3, va4, vb1, vb2, vb3, vb4: Word): Integer;
function GetFileVer(aFilename: String; var aV1, aV2, aV3, aV4: word): String;
function GetFileVerStr(aFilename: String): String;
function GetIEVer(var V1, V2, V3, V4: word): String;
function Check_HH_Version(x1, x2, x3, x4: Integer): Integer;
function Check_IE_Version(x1, x2, x3, x4: Integer): Integer;
function GetHHFriendlyVer: String;
function GetIEFriendlyVer: String;

function Check_WMP_Version(x1, x2, x3, x4: Integer): Integer;

function ShellExec(aFilename: String; aParams: String): Boolean;
function GetLastErrorStr: String;
function GetRegStr(rootkey: HKEY; const key, dataName: string): string;
procedure PutRegStr(rootkey: HKEY; const key, name, value: string);

procedure DebugOut(msgStr: String; const Args: array of const);
procedure DebugOut2(msgStr: String; const Args: array of const);
procedure ShowDebugFile;
procedure ResetDebugFile;
function IsDirWritable(aDir: String): Boolean;

procedure ReportError( errStr: String; const Args: array of const );


{$IFDEF D3PLUS} // -- Delphi >=3
resourcestring
{$ELSE}         // -- Delphi 2
const
{$ENDIF}

  //Error Strings
  st_HH_ERR_HHNotInstalled = 'MS Html Help is not installed on this PC.';
  st_HH_ERR_KeyHHexeNotFound = 'System file KeyHH.EXE was not found in the Windows folder.';
  st_HH_ERR_HHexeNotFound = 'System file HH.EXE was not found in the Windows folder.';
  st_HH_ERR_Unknown = 'Unknown error returned by HHHelpContext';

  //For GetLastError
  st_GLE_FileNotFound = 'File Not Found';
  st_GLE_PathNotFound = 'Path Not Found';
  st_GLE_AccessDenied = 'Access Denied';
  st_GLE_InsufficientMemory = 'Insufficient Memory';
  st_GLE_MediaIsWriteProtected = 'Media Is Write Protected';
  st_GLE_DeviceNotReady = 'Device Not Ready';
  st_GLE_FileInUse = 'File In Use';
  st_GLE_DiskFull = 'Disk Full';
  st_GLE_WindowsVersionIncorrect = 'Windows Version Incorrect';
  st_GLE_NotAWindowsOrMSDosProgram = 'Not A Windows Or MSDos Program';
  st_GLE_CorruptFileOrDisk = 'Corrupt File Or Disk';
  st_GLE_CorruptRegistry = 'Corrupt Registry';
  st_GLE_GeneralFailure = 'General Failure';

{Debug}
  var DBG_FILENAME: String = '\HHDebug.txt';
  var DBG_DIR: String = '';

implementation

uses
  hh;  //HH API

{---------------------------------------------------------------------]
  Hook Help System

  Delphi allows you to trap all help calls and redirect them
  to your own handler. Thus we get Html Help working under D3/4.

  Usage:

    var mHHelp: THookHelpSystem;

    procedure TMainForm.FormCreate(Sender: TObject);
    begin
      //Set CHM file, Window Definition to use if reqired and Mode of operation
      mHHelp := THookHelpSystem.Create(pathToCHM, '', htHHAPI);
      ...

    procedure TMainForm.FormDestroy(Sender: TObject);
    begin
      //Unhook and free
      mHHelp.Free;
      ...

  Show help in the normal way
  o Set "Form.HelpContext := xx" to display page sensitive help via F1 key.
  o Set "Control.HelpContext := xx" to display field sensitive help via F1 and "whats this" help.
  o Call Application.HelpContext(xx) to show help directly from a memu or help button.
  o Make sure that Topic xx, xx is a context ID, is defined in the CHM help file.
  eg. Application.HelpContext(1133)

  To display a topic by topic filename use
  mHHelp.HelpTopic('index.html');

[---------------------------------------------------------------------}

constructor THookHelpSystem.Create(aDefChmFile, aDefWinDef: String; aHostType: THostType);
begin
  inherited Create;
  FChmFile := aDefChmFile;
  FWinDef := aDefWinDef;
  FHostType := aHostType;

  {Hook in our help}
  FOldHelpEvent := Application.OnHelp;
  Application.OnHelp := HelpHook;

  {Debug}
  if _DebugMode then
    DebugOut('THookHelpSystem.Create("%s","%s", %d)', [aDefChmFile, aDefWinDef, ord(aHostType)]);
end; { THookHelpSystem.Create }

destructor THookHelpSystem.Destroy;
begin
  {Must call this or get access violation}
  if FHostType = htHHAPI then
    hh_funcs.HHCloseAll;

  {Unhook our help}
  Application.OnHelp := FOldHelpEvent;
  inherited destroy;
  if _DebugMode then
    DebugOut('THookHelpSystem.Destroy',['']);
end; { THookHelpSystem.Destroy }

{ Debug aid - Commands to pass to WinHelp() }
function WinHelpCmdToStr(cmd: Integer): string;
begin
  case cmd of
    HELP_CONTEXT: result := 'HELP_CONTEXT';       { Display topic in ulTopic  }
    HELP_QUIT: result := 'HELP_QUIT';            { Terminate help  }
    HELP_INDEX: result := 'HELP_INDEX or HELP_CONTENTS';         { Display index  }
    HELP_HELPONHELP: result := 'HELP_HELPONHELP';    { Display help on using help  }
    HELP_SETINDEX: result := 'HELP_SETINDEX or HELP_SETCONTENTS';      { Set current Index for multi index help  }
    HELP_CONTEXTPOPUP: result := 'HELP_CONTEXTPOPUP';
    HELP_FORCEFILE: result := 'HELP_FORCEFILE';
    HELP_KEY: result := 'HELP_KEY';         { Display topic for keyword in offabData  }
    HELP_COMMAND: result := 'HELP_COMMAND';
    HELP_PARTIALKEY: result := 'HELP_PARTIALKEY';
    HELP_MULTIKEY: result := 'HELP_MULTIKEY';
    HELP_SETWINPOS: result := 'HELP_SETWINPOS';
    HELP_CONTEXTMENU: result := 'HELP_CONTEXTMENU';
    HELP_FINDER: result := 'HELP_FINDER';
    HELP_WM_HELP: result := 'HELP_WM_HELP';
    HELP_SETPOPUP_POS: result := 'HELP_SETPOPUP_POS';
  else result := '??';
  end;
  result := inttostr(cmd) + ' (' + result +')';
end;


{ All application help calls to help come here }
function THookHelpSystem.HelpHook(Command: Word; Data: Longint; Var CallHelp: Boolean) : Boolean;
begin
   if _DebugMode then
     DebugOut('THookHelpSystem.HelpHook(%s, %d)',[WinHelpCmdToStr(Command), Data]);

   CallHelp := false;
   case Command of
    Help_Context:      //help button
      begin
        if Assigned(HelpCallback1)
          then HelpCallback1(Data)           //Call back
          else Self.HelpContext( Data );     //Call help
      end;
    HELP_SETPOPUP_POS: //call #1 of F1 Popup (Whats This) help
      FPopupXY := SmallPointToPoint(TSmallPoint(Data));           //data = x,y pos for popup
    Help_ContextPopup: //call #2 of F1 Popup (Whats This) help
      begin
        if Assigned(HelpCallback2)
          then HelpCallback2(Data, FPopupXY.X, FPopupXY.Y)   //Call back
          else Self.HelpContext(Data);                       //Call help
      end
    else
      CallHelp := TRUE; //Default handling - WinHelp
  end;
  result := TRUE;
end; { THookHelpSystem.HelpHook }


{ No need to call this directly. Instead call Application.HelpContext(xx) and it will call this
  function because of the hook we have installed.
  Uses ChmFile, WinDef & Hosttype specified by create}
function THookHelpSystem.HelpContext(aContextId: DWord): Integer;
begin
  result := HHHelpContext(FChmFile, aContextId, FWinDef, FHostType);
  HHShowError(result);
end;

{Show a help topic - 1
 Uses ChmFile, Topic, WinDef & HostType specified by create}
function THookHelpSystem.HelpTopic(aTopic: String): Integer;
begin
  result := HHDisplayTopic(FChmFile, aTopic, FWinDef, FHostType);
  HHShowError(result);
end;

{Show a help topic - 2
 overrides default Chm and WinDef - still uses initially specified Host Type}
function THookHelpSystem.HelpTopic2(aChmFile, aTopic, aWinDef: String): Integer;
begin
  result := HHDisplayTopic(aChmFile, aTopic, aWinDef, FHostType);
end;

{Show a help topic - 3
 overrides default Chm and WinDef - Specify a full path EG. c:\help\help.chm::/htm/topic.htm}
function THookHelpSystem.HelpTopic3(aChmPath: String): Integer;
begin
  Result := HHTopic(aCHMPath, FHostType);