hh_funcs.pas

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

end;


{ Show Error }
procedure HHShowError(err: Integer);
var s: String;
begin
  case err of
    HH_ERR_AllOK:            s := '';
    HH_ERR_HHNotInstalled:   s := st_HH_ERR_HHNotInstalled;
    HH_ERR_KeyHHexeNotFound: s := st_HH_ERR_KeyHHexeNotFound;
    HH_ERR_HHexeNotFound:    s := st_HH_ERR_HHexeNotFound;
    else                     s := st_HH_ERR_Unknown;
  end;
  if s <> '' then
  begin
    MessageDlg(s, mtWarning, [mbOK], 0);
    if _DebugMode then
      DebugOut('HHShowError(%d), "%s"',[err, s]);
  end;
end;


{---------------------------------------------------------------------]
   HH Functions
[---------------------------------------------------------------------}

{ Call HHCloseAll if you are calling help using the HH API.
  It will all tell HH API to close all HH Windows opened by this application.

 Warning: if you are calling HH API function to display help you must call this before
 application shutdown or your application will crash}
procedure HHCloseAll;
begin
  HH.HtmlHelp(0, nil, HH_CLOSE_ALL, 0);
  Sleep(0);   //17-Dec-2001 fix timing problem - bug with HH going off on a thread
end;

{ HHDisplayTopic()
  Display a Topic from the CHM file using a Window Definition
    aChmFile: In
      Name of compressed help file to display.
      Generally this should be full path as NT is less forgiving with relative paths.
    aTopic: In
      Path to html file in Chm file.
      Leave blank to display open the Chm at the default page
    aWinDef: In
      Specify a window definition. Leading slash will be added if missing.
      Leave blank to display open the Chm with the default window definition
      Note: not supported by some versions of HH.EXE and KeyHH.EXE
    aHostType: In
      Who will host the HH Window
      - htHHAPI:  This application will host via API calls.
      - htKeyHHexe:  Windows KeyHH.EXE will.
      - htHHexe:   Windows HH.EXE will.
    Returns:
      Possible returns
       0 = All OK
       HH_ERR_HHNotInstalled
       HH_ERR_KeyHHexeNotFound (aHostType = htKeyHHexe)
       HH_ERR_HHexeNotFound (aHostType = htHHexe)
  Other Info
      - No checking is done on any of the params.
        Caller should first verify that the chmFile exists.
  Example:
      HHDisplayTopic('windows.chm','about_magnify.htm','windefault', htHHAPI);
}
function HHDisplayTopic(aChmFile, aTopic, aWinDef: String; aHostType: THostType): Integer;
var target: String;
begin
  //Showmessage(format('%s, %s, %s, %d',[aChmFile, aTopic, aWinDef, ord(aHostType)]));
  if _DebugMode then
    DebugOut('HHHelpContext("%s", %s, "%s", %d)', [aChmFile, aTopic, aWinDef, Ord(aHostType)]);

  if aHostType = htHHexe then  //Prefix required by early versions - use IE3 prefix
    target := HHFormat(aChmFile, aTopic, aWinDef, ptIE3)
  else                         //No prefix needed
    target := HHFormat(aChmFile, aTopic, aWinDef, ptNone);
  result := HHTopic( target, aHostType );
end;

{
   HHTopic()
   Same as above except aCHMPath may be a combination
   chmfile, Topic, WinDef in the form chmfile::/Topic>WinDef
   Note: HH.EXE normally requires a path prefix.
}
function HHTopic(aCHMPath: String; aHostType: THostType): Integer;
var appPath: String; h: HWND;
begin
  if _DebugMode then
    DebugOut('ShowTopic("%s", %d)', [aChmPath, Ord(aHostType)]);
  result := HH_ERR_AllOK;  {0}

  { Check HH Installed on this PC }
  if not _hhInstalled then
    result := HH_ERR_HHNotInstalled
  else
  case aHostType of

    //Host Type = This app using HH API
    htHHAPI:
      begin
        h := HH.HtmlHelp(GetDesktopWindow, PChar(aCHMPath), HH_DISPLAY_TOPIC, 0);
        if h > 0 then
          SetForegroundWindow(h);
      end;

    //Host Type = KeyHH.EXE (must be installed)
    htKeyHHexe:
      begin
        appPath := GetWinDir + '\' + HOST_KEYHHEXE;
        if not FileExists(appPath) then
          result := HH_ERR_KeyHHexeNotFound
        else
        begin
          { Pass the parameters to KeyHH.exe using "-win" for single window.
            hh path prefix is not required by KeyHH.EXE
          }
          ShellExec(appPath, '-win ' + aCHMPath);
        end;
      end;

    //Host Type = HH.EXE (part of Html Help)
    htHHexe:
      begin
        appPath := GetWinDir + '\' + HOST_HHEXE;
        if not FileExists(appPath) then
          result := HH_ERR_HHexeNotFound
        else
        begin
          { HH.EXE requires a prefix. }
          ShellExec(appPath, aCHMPath);
        end;
      end;
  end; {case}
  if _DebugMode then
    DebugOut('  returned - %d', [result]);
end;




{ HHHelpContext()
  Displays a help topic based on a mapped topic ID.

  Function documentation is the same as above except replace "aTopic" by...

    aContextID
      Specifies the numeric ID of the topic to display

  returns same errors

  Example:
     HHHelpContext('windows.chm',200,'windefault', htHHAPI);
}
function HHHelpContext(aChmFile: String; aContextID: DWord; aWinDef: String; aHostType: THostType): Integer;
var target: String;
begin
  if _DebugMode then
    DebugOut('HHHelpContext("%s", %d, "%s", %d)', [aChmFile, aContextID, aWinDef, Ord(aHostType)]);
  if aHostType = htHHexe //Prefix required by early versions - use IE3 prefix
    then target := HHFormat(aChmFile, '', aWinDef, ptIE3)
    else target := HHFormat(aChmFile, '', aWinDef, ptNone);  //No prefix needed
  result := HHContext( target, aContextID, aHostType );
end;


{
   HHContext()
   Same as above except aCHMPath may be a combination
   chmfile & WinDef in the form chmfile>WinDef
   Note: HH.EXE does not support context mapped help - use KeyHH.exe instead
}
function HHContext(aChmPath: String; aContextId: Integer; aHostType: THostType): Integer;
var appPath: String; h: HWND;
begin
  if _DebugMode then
    DebugOut('ShowContext("%s", %d)', [aChmPath, Ord(aHostType)]);
  result := HH_ERR_AllOK;  {0}

  { Check HH Installed on this PC }
  if not _hhInstalled then
    result := HH_ERR_HHNotInstalled
  else
  case aHostType of

    //Host Type = This app using HH API
    htHHAPI:
      begin
        h := HH.HtmlHelp(GetDesktopWindow, PChar(aChmPath), HH_HELP_CONTEXT, aContextID);
        if h > 0 then
          SetForegroundWindow(h);
      end;

    //Host Type = KeyHH.EXE (must be installed)
    htKeyHHexe:
      begin
        appPath := GetWinDir + '\' + HOST_KEYHHEXE;
        if not FileExists(appPath) then
          result := HH_ERR_KeyHHexeNotFound
        else
        begin
          { Pass the parameters to KeyHH.exe
            using "-win" for single window and "-#mapid xx " for the context
            hh path prefix is not required by KeyHH.EXE
          }
          ShellExec(appPath, '-win -#mapid ' + IntToStr(aContextID) + ' ' + aChmPath);
        end;
      end;

    //Host Type = HH.EXE (part of Html Help)
    htHHexe:
      begin
        appPath := GetWinDir + '\' + HOST_HHEXE;
        if not FileExists(appPath) then
          result := HH_ERR_HHexeNotFound
        else
          ShellExec(appPath, '-mapid ' + IntToStr(aContextID) + ' ' + aChmPath);
      end;

  end; {case}
  if _DebugMode then
    DebugOut('  returned - %d', [result]);
end;



{
  This creates a command line suitable for use with HH.EXE, KeyHH or HHServer.EXE
    chmFile:
       Name of CHM file. Full or relative path.
    Topic:
       Html filename in Chm. Can be blank.
       Under IE4 this can include a bookmark.
    WinDef:
       Window Definition to use. Can be blank.
    aPrefixType:
       What to prefix string to add
       ptNone - No Prefix added
       ptIE3 - IE3 and above compatible prefix added - 'mk:@MSITStore:'
       ptIE4 - IE4 and above compatible prefix added - 'ms-its:'
  Result examples
    HHFormat('windows.chm', 'about_magnify.htm', 'windefault', ptIE3);
    => 'mk:@MSITStore:windows.chm::/about_magnify.htm>windefault'

    chmFile.chm
    chmFile.chm>WinDef
    Helpfile.chm::/Topic.htm>WinDef
    ms-its:chmFile.chm>WinDef
    mk:@MSITStore:Helpfile.chm::/Topic.htm>WinDef

}
function HHFormat(aChmFile, aTopic, aWinDef: String; aPrefixType: TPrefixType): String;
begin
  //  Rename all %20 to space
  StrRepCA( aChmFile, '%20', ' ');
  StrRepCA( aTopic, '%20', ' ');
  StrRepCA( aWinDef, '%20', ' ');

  StripLR(aChmFile, ' ');   StripLR(aTopic, ' ');   StripLR(aWinDef, ' ');  //no lead trail spaces

  {make chm and topic}
  if aTopic = '' then
    result := aChmFile
  else
  begin
    DosToUnix(aTopic);                    //Topics should always contain '/' unix slashes
    if aTopic[1] <> '/' then              //we want a leading slash
      aTopic := '/' + aTopic;
    result := aTopic;
    if aChmFile <> '' then                //Allow no chmfile so we can format the topic
      result := aChmFile + '::' + result
  end;

  {add win definition}
  if aWinDef <> '' then
    result := result + '>' + aWinDef;

  {add prefix}
  case aPrefixType of
    ptIE3: result := HH_PREFIX_IE3 + result;
    ptIE4: result := HH_PREFIX_IE4 + result;
  end;
end;


{
  Given a string s like
    mk:@MSITStore:aChmFile::aTopic>aWinDef
  eg.
    chmFile.chm
    chmFile.chm>WinDef
    Helpfile.chm::/Topic.htm>WinDef
    ms-its:chmFile.chm>WinDef
    mk:@MSITStore:Helpfile.chm::/Topic.htm>WinDef
  return the components
    aChmFile, aTopic, aWinDef
}
//Backward compatible Fix - Typo - Should be Split not Slit
procedure HHSlitCmdStr(s: String; var aChmFile, aTopic, aWinDef: String);
begin
  HHSplitCmdStr(s, aChmFile, aTopic, aWinDef);
end;

procedure HHSplitCmdStr(s: String; var aChmFile, aTopic, aWinDef: String);
var i: Integer;
begin
   //  Replace all %20 to space
   StrRepCA( s, '%20', ' ');

   {Get WinDef}
   i := StrPosC(s, '>');
   if i > 0 then
   begin
     aWinDef := Copy(s, i+1, Maxint);
     SetLength(s, i-1);
   end;

   {Get Topic}
   i := StrPosC(s, '::');
   if i > 0 then
   begin
     aTopic := Copy(s, i+2, Maxint);
     SetLength(s, i-1);
     DosToUnix(aTopic);                    //Topics should always contain '/' unix slashes
   end;

   {Get chmFile}
   i := StrPosI(s, 'its:'); //'ms-its:'
   if i > 0 then
     aChmFile := Copy(s, i+length('its:'), Maxint)
   else
   begin
     i := StrPosI(s, 'store:');  //'mk:@MSITStore:'
     if i > 0 then
       aChmFile := Copy(s, i+length('store:'), Maxint)
     else
       aChmFile := s;
   end;

   StripLR(aChmFile, ' ');
   StripLR(aTopic, ' ');
   StripLR(aWinDef, ' ');
end;



{---------------------------------------------------------------------]
   General Functions
[---------------------------------------------------------------------}


{ Sometimes safest to work in Unix / slashes }
procedure DosToUnix(var filename: String);
begin
  repeat until StrRepC(filename, '\', '/') = 0;
end;

{Find pos of sub string in string. Case Sensitive - returns 0 not found or 1..n}
function StrPosC(const s: String; const find: String): Integer;
var p: PChar;
begin
{$IFDEF D3PLUS} // -- Delphi >=3
  p := AnsiStrPos( PChar(s) , PChar(find) );   //double byte safe
{$ELSE}         // -- Delphi 2
  p := StrPos( PChar(s) , PChar(find) );   //double byte safe
{$ENDIF}
  if p = nil then
    result := 0
  else
    result := p - PChar(s) + 1;
end;

{Same as Above only ignores case}
function StrPosI(const s: String; const find: String): Integer;
var s2, find2: String;
begin
{$IFDEF D3PLUS} // -- Delphi >=3
  s2 := AnsiUpperCase(s);
  find2 := AnsiUpperCase(find);
{$ELSE}         // -- Delphi 2
  s2 := UpperCase(s);
  find2 := UpperCase(find);
{$ENDIF}

  result := StrPosC(s2, find2);