hh_funcs.pas

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

    result := 'Internet Explorer 6 Public Preview (Beta) Refresh'
  else if VerCompare( v1,v2,v3,v4, 6,00,2462,0000) >= 0 then
    result := 'Internet Explorer 6 Public Preview (Beta)'
  else if VerCompare( v1,v2,v3,v4, 5,50,4807,2300) >= 0 then
    result := 'Internet Explorer 5.5 Service Pack 2'
  else if VerCompare( v1,v2,v3,v4, 5,50,4522,1800) >= 0 then
    result := 'Internet Explorer 5.5 Service Pack 1'
  else if VerCompare( v1,v2,v3,v4, 5,50,4522,1800) >= 0 then
    result := 'Internet Explorer 5.5 Service Pack 1'
  else if VerCompare( v1,v2,v3,v4, 5,50,4308,2900) >= 0 then
    result := 'Internet Explorer 5.5 Advanced Security Privacy Beta'
  else if VerCompare( v1,v2,v3,v4, 5,50,4134,0600) >= 0 then
    result := 'Internet Explorer 5.5'
  else if VerCompare( v1,v2,v3,v4, 5,50,4134,0100) >= 0 then
    result := 'Internet Explorer 5.5 for Windows Me (4.90.3000)'
  else if VerCompare( v1,v2,v3,v4, 5,50,4030,2400) >= 0 then
    result := 'Internet Explorer 5.5 & Internet Tools Beta'
  else if VerCompare( v1,v2,v3,v4, 5,50,3825,1300) >= 0 then
    result := 'Internet Explorer 5.5 Developer Preview'
  else if VerCompare( v1,v2,v3,v4, 5,00,2919,6400) >= 0 then
    result := 'Internet Explorer 5.01'
  else if VerCompare( v1,v2,v3,v4, 5,00,2919,6307) >= 0 then
    result := 'Internet Explorer 5.01'
  else if VerCompare( v1,v2,v3,v4, 5,00,2919,3800) >= 0 then
    result := 'Internet Explorer 5.01 (Windows 2000 RC2, build 5.00.2128)'
  else if VerCompare( v1,v2,v3,v4, 5,00,2919,800) >= 0 then
    result := 'Internet Explorer 5.01 (Windows 2000 RC1, build 5.00.2072)'
  else if VerCompare( v1,v2,v3,v4, 5,00,2723,2900) >= 0 then
    result := 'Internet Explorer 5.0 updated'
  else if VerCompare( v1,v2,v3,v4, 5,00,2721,1400) >= 0 then
    result := 'Internet Explorer 5.0 updated'
  else if VerCompare( v1,v2,v3,v4, 5,00,2614,0) >= 0 then
    result := 'Internet Explorer 5.0b'
  else if VerCompare( v1,v2,v3,v4, 5,00,2314,0) >= 0 then
    result := 'Internet Explorer 5.0a'
  else if VerCompare( v1,v2,v3,v4, 5,00,2014,0) >= 0 then
    result := 'Internet Explorer 5.0'
  else if VerCompare( v1,v2,v3,v4, 5,00,0910,0) >= 0 then
    result := 'Internet Explorer 5 Beta (Beta 2)'
  else if VerCompare( v1,v2,v3,v4, 5,00,0518,0) >= 0 then
    result := 'Internet Explorer 5 Developer Preview (Beta 1)'
  else if VerCompare( v1,v2,v3,v4, 4,72,3612,0) >= 0 then
    result := 'Internet Explorer 4.01 Service Pack 2 (SP2)'
  else if VerCompare( v1,v2,v3,v4, 4,72,3110,0) >= 0 then
    result := 'Internet Explorer 4.01 Service Pack 1 (SP1)'
  else if VerCompare( v1,v2,v3,v4, 4,72,2106,0) >= 0 then
    result := 'Internet Explorer 4.01'
  else if VerCompare( v1,v2,v3,v4, 4,71,1712,0) >= 0 then
    result := 'Internet Explorer 4.0'
  else if VerCompare( v1,v2,v3,v4, 4,71,1008,0) >= 0 then
    result := 'Internet Explorer 4.0 Platform Preview 2.0 (PP2)'
  else if VerCompare( v1,v2,v3,v4, 4,71,544,0 ) >= 0 then
    result := 'Internet Explorer 4.0 Platform Preview 1.0 (PP1)'
  else if VerCompare( v1,v2,v3,v4, 4,70,1300,0) >= 0 then
    result := 'Internet Explorer 3.02'
  else if VerCompare( v1,v2,v3,v4, 4,70,1215,0) >= 0 then
    result := 'Internet Explorer 3.01'
  else if VerCompare( v1,v2,v3,v4, 4,70,1158,0) >= 0 then
    result := 'Internet Explorer 3.0 (OSR2)'
  else if VerCompare( v1,v2,v3,v4, 4,70,1155,0) >= 0 then
    result := 'Internet Explorer 3.0'
  else if VerCompare( v1,v2,v3,v4, 4,40,520,0 ) >= 0 then
    result := 'Internet Explorer 2.0'
  else if VerCompare( v1,v2,v3,v4, 4,40,308,0 ) >= 0 then
    result := 'Internet Explorer 1.0 (Plus!)'
  else
    result := '< Internet Explorer 1.0 (Plus!)';
end;


{
  Check is HtmlHelp Version x.x.x.x is installed.
  returns
    -1   ... A lesser version of x.x.x.x is installed.
     0   ... x.x.x.x is the version installed
    +1   ... A greater version of x.x.x.x is installed.

  Example
    if Check_HH_Version(4,73,8252,0) < 0 then
      ShowMessage('HtmlHelp 1.2 or greater is required. Please download a new version.');
}
function Check_HH_Version(x1, x2, x3, x4: Integer): Integer;
var  v1,v2,v3,v4: Word; fn: String;
begin
  result := -1;
  fn := hh.GetPathToHHCtrlOCX;
  if GetFileVer(fn, v1,v2,v3,v4) <> '' then
    result := VerCompare(v1,v2,v3,v4, x1,x2,x3,x4);
end;


{
  ShellExec()
  =============================
  Calls Windows shellexecute(h,'open',...)
  eg. Shellexec('mailto:[e-mail]', '');
  Returns TRUE if windows reports no errors
}
function ShellExec(aFilename: String; aParams: String): Boolean;
var h: THandle; handle: hWnd;
begin
  {
    Get Handle of parent window
  }
  if (Screen <> nil) AND (Screen.ActiveForm <> nil) AND (Screen.ActiveForm.handle <> 0) then
    handle := Screen.ActiveForm.handle
  else
  if Assigned(Application) AND Assigned(Application.Mainform) then
    handle := Application.Mainform.handle
  else
    handle := 0;

  h := ShellExecute(handle, 'open', Pchar(aFilename), Pchar(aParams), nil, SW_SHOWDEFAULT);
  result := (h > 32);  //success?
  if NOT result then
    ReportError('Function ShellExecute(%s)' + #13
              + 'Returned: %s', [aFilename+', '+aParams, GetLastErrorStr]);
end;


{
  Return error description of last error
}
function GetLastErrorStr: String;
var ErrCode: Integer;
begin
  ErrCode := GetlastError;
  case ErrCode of
    ERROR_FILE_NOT_FOUND:	  result := st_GLE_FileNotFound;
    ERROR_PATH_NOT_FOUND:	  result := st_GLE_PathNotFound;
    ERROR_ACCESS_DENIED:          result := st_GLE_AccessDenied;
    ERROR_NOT_ENOUGH_MEMORY:      result := st_GLE_InsufficientMemory;
    ERROR_WRITE_PROTECT:          result := st_GLE_MediaIsWriteProtected;
    ERROR_NOT_READY:              result := st_GLE_DeviceNotReady;
    ERROR_SHARING_VIOLATION,
    ERROR_LOCK_VIOLATION:         result := st_GLE_FileInUse;
    ERROR_HANDLE_DISK_FULL,
    ERROR_DISK_FULL:              result := st_GLE_DiskFull;
    ERROR_OLD_WIN_VERSION:        result := st_GLE_WindowsVersionIncorrect;
    ERROR_APP_WRONG_OS:           result := st_GLE_NotAWindowsOrMSDosProgram;
    ERROR_EA_FILE_CORRUPT,
    ERROR_UNRECOGNIZED_VOLUME,
    ERROR_FILE_CORRUPT,
    ERROR_DISK_CORRUPT:           result := st_GLE_CorruptFileOrDisk;
    ERROR_BADDB,
    ERROR_INTERNAL_DB_CORRUPTION: result := st_GLE_CorruptRegistry;
  else                            result := st_GLE_GeneralFailure;
  end; {case}
  result := '[Error:'+IntToStr(ErrCode) + '] ' + result;
end;


{
  Get a value from the registry
  dataName = '' for default value.
  Returns '' if not found
}
function GetRegStr(rootkey: HKEY; const key, dataName: string): string;
var rg: TRegistry;
begin
  result := '';  //default return
  rg := TRegistry.Create;
  rg.RootKey :=  rootkey;

{$IFDEF D4PLUS} // -- Delphi >=4
  if rg.OpenKeyReadOnly(key) AND rg.ValueExists(dataName) then //safer call under NT
{$ELSE}        // -- Delphi 2, 3
  if rg.OpenKey(key, false) AND rg.ValueExists(dataName) then
{$ENDIF}
  begin
    result := rg.ReadString(dataName);
    rg.CloseKey;
  end;
  rg.Free;
end;

{
  Creates a Key and addes a Value
  An absolute key begins with a backslash (\) and is a subkey of the root key.
}
procedure PutRegStr(rootkey: HKEY; const key, name, value: string);
var rg: TRegistry;
begin
  rg := TRegistry.Create;
  rg.RootKey :=  rootkey;
  if rg.OpenKey(key, TRUE {create if not found}) then
  begin
    rg.WriteString(name, value);
    rg.CloseKey;
  end;
  rg.Free;
end;


{
  Sometimes the only way we can test if a drive is writable is to write a test file.
  aDir is some Dir on a valid disk drive
}
function IsDirWritable(aDir: String): Boolean;
var F: File; fn: String;
begin
  StripR(aDir, '\');  //no trailing slash
  fn := aDir + '\$_Temp_$.$$$';   //Any abnormal filename will do
  FileMode := 2;  //read/write
  AssignFile(F, fn);
  {$I-} Rewrite(F, 1);
  result := (IOResult = 0);
  if result then
  begin
    CloseFile(F);
    DeleteFile(fn);
  end;
end;


{
  Debug file - takes same params as the Delphi Format() function.
  Output is to DBG_FILENAME in the application run folder.
  File is cleared when the exe is started.

  _DebugMode can be enabled by creating a file debug.debug in the
  applications run folder.

  Normal usage:
    if _DebugMode then
      DebugOut('File was not found "%s"', [filename]);
}
procedure DebugOut(msgStr: String; const Args: array of const);
var f: TextFile; s: String;
begin
  {$I-}
  AssignFile(f, DBG_DIR + DBG_FILENAME);
  if (not FileExists(DBG_DIR + DBG_FILENAME)) then
    Rewrite(f)  //create
  else
    Append(f);
  if ioresult = 0 then
  begin
    s := format(msgStr, Args);
    if s = '-' then   //separator
      s := MkStr('-', 80);
    if s = '=' then   //separator
      s := MkStr('=', 80);
    if (s <> '') and (s[1] in ['-', '=', '!']) then
      s := Copy(S, 2, maxint)
    else
      s := TimeToStr(now) + '   ' + s;
    Writeln(f, s);
    Flush(f);
    CloseFile(f);
  end;
end; //DebugOut


{same function but this one checks the debug flag}
procedure DebugOut2(msgStr: String; const Args: array of const);
begin
  if _DebugMode then
    DebugOut(msgStr, Args);
end;


{Display debug file in default window}
procedure ShowDebugFile;
var fn: String;
begin
  fn := DBG_DIR + DBG_FILENAME;
  if FileExists(fn) then
    ShellExec(fn, '')
  else
    ShowMessage('File not found'#13+fn+#13+'Debug Enabled = '+IntToStr(Integer(_DebugMode)));
end;

{Delete and start a new debug file}
procedure ResetDebugFile;
var i: Integer; s: String;
begin
  if FileExists(DBG_DIR + DBG_FILENAME) then
    DeleteFile(DBG_DIR + DBG_FILENAME);
  if _DebugMode then
  begin
    DebugOut('!Filename:             %s',[#9 + DBG_DIR + DBG_FILENAME]);
    DebugOut('!Date:                 %s',[#9 + DateTimeToStr(now)]);
{$IFDEF D3PLUS} // -- Delphi >=3
    if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT
    then DebugOut('!Operating System:      %s %d.%d.%d',[#9'Windows NT',Win32MajorVersion, Win32MinorVersion, Win32BuildNumber])
    else DebugOut('!Operating System:      %s %d.%d.%d',[#9'Windows',Win32MajorVersion, Win32MinorVersion, Win32BuildNumber]);

    DebugOut('!SysLocale.DefaultLCID: %s',[#9+'0x'+IntToHex(SysLocale.DefaultLCID, 4)]);
    DebugOut('!SysLocale.PriLangID:   %s',[#9+'0x'+IntToHex(SysLocale.PriLangID, 4)]);
    DebugOut('!SysLocale.SubLangID:   %s',[#9+'0x'+IntToHex(SysLocale.SubLangID, 4)]);
{$ENDIF}
    DebugOut('!DecimalSeparator:      %s',[#9+DecimalSeparator]);

    DebugOut('-', ['']);
    DebugOut('!EXE Path =          %s',[#9 + ParamStr(0)]);

    s := '';
    for i := 1 to ParamCount do
    begin
      if s <> '' then s := s + ' | ';
      s := s + ParamStr(i)
    end;   
    DebugOut('!Cmdline Param(s) =  %s',[#9 + s]);
    DebugOut('!_RunDir =           %s',[#9 + _RunDir]);
    DebugOut('!_ModuleName =       %s',[#9 + _ModuleName]);
    DebugOut('!_ModuleDir =        %s',[#9 + _ModuleDir]);
    DebugOut('-', ['']);
    DebugOut('!_hhInstalled =      %s', [#9 + BoolToYN(_hhInstalled)]);
    DebugOut('!_hhVerStr =         %s', [#9 + _hhVerStr]);
    DebugOut('!_hhFriendlyVerStr = %s', [#9 + _hhFriendlyVerStr]);
    DebugOut('-', ['']);
    DebugOut('!_ieInstalled =      %s', [#9 + BoolToYN(_ieInstalled)]);
    DebugOut('!_ieVerStr =         %s', [#9 + _ieVerStr]);
    DebugOut('!_ieFriendlyVerStr = %s', [#9 + _ieFriendlyVerStr]);
    DebugOut('=', ['']);
  end;
end;


{
  All Errors reported here
  Uses same format as the Delphi Format() function
}
procedure ReportError( errStr: String; const Args: array of const );
var s: String;
begin
  s := format( errStr, Args);
  MessageDlg(s, mtWarning, [mbOK], 0);
  if _DebugMode then
    DebugOut(s, ['']);
end;


{ Module initialization }
procedure ModuleInit;
var
  v1,v2,v3,v4, i: Word;
  FileName: array[0..300] of Char;
begin
  //Get run dir & Progname - or DLL or EXE
  GetModuleFileName(HInstance, FileName, SizeOf(FileName));
  _ModulePath := Filename;
  _ModuleDir := SysUtils.ExtractFilePath(_ModulePath);
  _ModuleName := SysUtils.ExtractFileName(_ModulePath);
  StripR(_ModuleDir, '\');

  { get run dir }
  _RunDir := ExtractFilePath(ParamStr(0));
  StripR(_RunDir, '\');

  { Debug Dir is current dir, Or root of Windows dir if readonly. CD? }
  If IsDirWritable(_ModuleDir) then
    DBG_DIR := _ModuleDir        //Where EXE or DLL lives
  else
    DBG_DIR := GetWinTempDir;    //Window Temp folder

  {debug mode enabled is file debug.debug found in the Modules dir OR a /debug or -debug cmdline switch}
  _DebugMode := FileExists(_ModuleDir + '\debug.debug');
  if not _DebugMode then
     for i := 1 to ParamCount do
       if (CompareText(paramstr(i), '/debug') = 0) or (CompareText(paramstr(i), '-debug') = 0) then
       begin
         _DebugMode := TRUE;
         break;
       end;

  {get version info of 'hhctrl.ocx' - returns '' and 0s if not found}
  _hhVerStr := GetFileVer(hh.GetPathToHHCtrlOCX, _hhMajVer, _hhMinVer, _hhBuildNo, _hhSubBuildNo);
  _hhInstalled := (_hhVerStr <> '');
  _hhFriendlyVerStr := GetHHFriendlyVer;

  {ie info}
  _ieVerStr := GetIEVer(v1,v2,v3,v4);
  _ieInstalled := (_ieVerStr <> '');
  _ieFriendlyVerStr := GetIEFriendlyVer;

  ResetDebugFile;
end;


initialization
  ModuleInit;
end.