⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 hh_funcs.pas

📁 企业端数据申报系统:单位管理模块 单位查询. 业务申报模块 在线数据下载 在线数据上传 在线业务申核 申报业务查询 磁盘数据导出 磁盘数据导入 在线业务模块 在线业务
💻 PAS
📖 第 1 页 / 共 4 页
字号:
end;


{returns pos where subString replacements was done - 0 = none done - Case Sensitive}
function StrRepC( var s: String;  const find, repl: String): Integer;
begin
  result := StrPosC(s, find);
  if result > 0 then     {found - replace}
  begin
    Delete( s, result, Length(find) );
    Insert( repl, s, result );
  end;
end;

{returns pos where subString replacements was done - 0 = none done - Ignore Sensitive}
function StrRepI( var s: String;  const find, repl: String): Integer;
begin
  result := StrPosI(s, find);
  if result > 0 then     {found - replace}
  begin
    Delete( s, result, Length(find) );
    Insert( repl, s, result );
  end;
end;


{Replace all ocurrences (Ignore Case) - returns replacements done}
function StrRepIA( var s: String;  const find, repl: String): Integer;
begin
  result := 0;
  repeat
    if StrRepI(s, find, repl) > 0 then
      inc(result)
    else
       break;
  until false;
end;

{Replace all ocurrences (Case Sensitive) - returns replacements done}
function StrRepCA( var s: String;  const find, repl: String): Integer;
begin
  result := 0;
  repeat
    if StrRepC(s, find, repl) > 0 then
      inc(result)
    else
       break;
  until false;
end;

{Strip leading chars}
procedure StripL(var s: String; c: char);
begin
  while (s <> '') and (s[1] = c) do
    Delete(s, 1, 1);
end;

{Strip trailing chars}
procedure StripR(var s: String; c: char);
var p: PChar;
begin
{$IFDEF D3PLUS} // -- Delphi >=3
  repeat
    p := AnsiLastChar(S);    //nil if S = empty
    if (p <> nil) and (p = c) then
      SetLength(s, Length(s)-1)
    else
      break;
  until p = nil;
{$ELSE}         // -- Delphi 2
  repeat
    if (s <> '') and (s[length(s)] = c) then
      SetLength(s, Length(s)-1)
    else
      break;
  until FALSE;
{$ENDIF}
end;


{Strip leading and trailing chars}
procedure StripLR(var s: String; c: char);
begin
  StripL(s, c);
  StripR(s, c);
end;

{Make string of chars}
function MkStr(c: Char; count: Integer): String;
var i: Integer;
begin
  result := '';
  for i := 1 to count do
    result := result + c;
end;

{ Boolean to Yes / No }
function BoolToYN(b: Boolean): String;
begin
  if b then result := 'YES' else result := 'NO';
end;


{Return Windows Dir}
function GetWinDir: String;
var path: array[0..260] of Char;
begin
  GetWindowsDirectory(path, SizeOf(path));
  result := path;
  StripR(result, '\');  //no trailing slash
end;

{Return Windows System Dir}
function GetWinSysDir: String;
var path: array[0..260] of Char;
begin
  GetSystemDirectory(path, SizeOf(path));
  result := path;
  StripR(result, '\');  //no trailing slash
end;

{Get Windows Temp Dir - with no trailing slash}
function GetWinTempDir: String;
var dwLen: DWORD;
begin
  SetLength(result, 300);
  dwLen := GetTempPath(300, @result[1]);
  SetLength(result, dwLen);

  //problems
  if DirectoryExists(result) = FALSE then
    result := 'c:';
  StripR(result, '\');  //no trailing slash
end;

{
  Get the product version number from a file (exe, dll, ocx etc.)
  Return '' if info not available - eg. file not found
  eg. Returns '7.47.3456.0', aV1=7, aV2=47, aV3=3456 aV4=0
  ie. major.minor.release.build
}
function GetFileVer(aFilename: String; var aV1, aV2, aV3, aV4: word): String;
var  InfoSize: DWORD; Wnd: DWORD; VerBuf: Pointer; VerSize: DWORD; FI: PVSFixedFileInfo;
begin
  result := '';
  aV1 := 0;  aV2 := 0;  aV3 := 0;  aV4 := 0;
  if (aFilename = '') or (not FileExists(aFilename)) then exit;  //don't continue if file not found

  InfoSize := GetFileVersionInfoSize(PChar(aFilename), Wnd);
  if InfoSize <> 0 then
  begin
    GetMem(VerBuf, InfoSize);
    try
      if GetFileVersionInfo(PChar(aFilename), Wnd, InfoSize, VerBuf) then
        if VerQueryValue(VerBuf, '\', Pointer(FI), VerSize) then
        begin
          aV1 := HiWord(FI^.dwFileVersionMS);
          aV2 := LoWord(FI^.dwFileVersionMS);
          aV3 := HiWord(FI^.dwFileVersionLS);
          aV4 := LoWord(FI^.dwFileVersionLS);
          result := IntToStr( HiWord(FI^.dwFileVersionMS) ) + '.' +
                    IntToStr( LoWord(FI^.dwFileVersionMS) ) + '.' +
                    IntToStr( HiWord(FI^.dwFileVersionLS) ) + '.' +
                    IntToStr( LoWord(FI^.dwFileVersionLS) );
        end;
    finally
      FreeMem(VerBuf);
    end;
  end;
end; //GetFileVer


{ Same as above but only returns version string }
function GetFileVerStr(aFilename: String): String;
var aV1, aV2, aV3, aV4: word;
begin
  result := GetFileVer(aFilename, aV1, aV2, aV3, aV4);
end;


function GetIEVer(var V1, V2, V3, V4: word): String;
begin
  result := GetFileVer(GetWinSysDir + '\Shdocvw.dll', V1, V2, V3, V4);
  //trick -- Early versions of IE had only 3 numbers
  if (v1=4) and (v2<=70) and (v3=0) then
  begin
    v3 := v4;  v4 := 0;
    result := format('%d.%d.%d.%d',[v1,v2,v3,v4]);
  end;
end;

{
  Version Compare : returns -1 if Va < Vb, 0 if Va = Vb, 1 if Va > Vb
  eg. VerCompar(1,0,0,1, 1,0,0,2) will return -1
  eg. VerCompar(2,0,0,1, 1,0,6,90) will return 1 because 2.0.0.1 is > 1.0.6.90
}
function VerCompare(va1, va2, va3, va4, vb1, vb2, vb3, vb4: Word): Integer;
begin
  if (va1 = vb1) AND (va2 = vb2) AND (va3 = vb3) AND (va4 = vb4) then
    result := 0
  else if (va1 > vb1)
  or ((va1 = vb1) AND (va2 > vb2))
  or ((va1 = vb1) AND (va2 = vb2) AND (va3 > vb3))
  or ((va1 = vb1) AND (va2 = vb2) AND (va3 = vb3) AND (va4 > vb4)) then
    result := 1
  else
    result := -1;
end;


{ Get Friendly version numbers for HTML Help 'hhctrl.ocx'
    V1.0 is   4.72.7290 - IE4
    V1.1 is   4.72.7323
    V1.1a is  4.72.7325 - Windows98
    V1.1b is  4.72.8164 - MSDN
    V1.2 is   4.73.8252 - Adds extra search control & Favorites tab
    V1.21 is  4.73.8412 - Bug fixes
    V1.21a is 4.73.8474 - Quick update to fix FTS on CDROM
    V1.22 is  4.73.8561 - This release fixes three bugs in 1.21a that caused problems for Arabic, Hebrew, and Far East languages.
    V1.3 is   4.74.8702 - Win2000 Unicode support
    V1.31 is  4.74.8793 - Minor update
     1.32 is  4.74.8875 - Windows ME+ IE5.5
     1.33 is  4.74.9273 - Windows XP+ IE6.0

  return '' if hhctrl.ocx not found, otherwise a version string like '1.2'.

  Get up to date version info from http://helpware.net/htmlhelp/hh_info.htm
}
function GetHHFriendlyVer: String;
var  v1,v2,v3,v4: Word; fn, s: String;
begin
  fn := hh.GetPathToHHCtrlOCX;
  s := GetFileVer(fn, v1,v2,v3,v4);
  if s = '' then
    result := ''
  else
  if VerCompare( v1,v2,v3,v4, 4,74,9273,0) > 0 then
    result := '> 1.33'
  else if VerCompare( v1,v2,v3,v4, 4,74,9273,0) >= 0 then
    result := '1.33'
  else if VerCompare( v1,v2,v3,v4, 4,74,8857,0) >= 0 then
    result := '1.32'
  else if VerCompare( v1,v2,v3,v4, 4,74,8793,0) >= 0 then
    result := '1.31'
  else if VerCompare( v1,v2,v3,v4, 4,74,8702,0) >= 0 then
    result := '1.3'
  else if VerCompare( v1,v2,v3,v4, 4,73,8561,0) >= 0 then
    result := '1.22'
  else if VerCompare( v1,v2,v3,v4, 4,73,8474,0) >= 0 then
    result := '1.21a'
  else if VerCompare( v1,v2,v3,v4, 4,73,8412,0) >= 0 then
    result := '1.21'
  else if VerCompare( v1,v2,v3,v4, 4,73,8252,0) >= 0 then
    result := '1.2'
  else if VerCompare( v1,v2,v3,v4, 4,72,8164,0) >= 0 then
    result := '1.1b'
  else if VerCompare( v1,v2,v3,v4, 4,72,7325,0) >= 0 then
    result := '1.1a'
  else if VerCompare( v1,v2,v3,v4, 4,72,7323,0) >= 0 then
    result := '1.1'
  else if VerCompare( v1,v2,v3,v4, 4,72,7290,0) >= 0 then
    result := '1.0'
  else
    result := '< 1.0';
end;


{
  Check is IE 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_IE_Version(4,70,1300,0) < 0 then
      ShowMessage('HtmlHelp requires that you installed IE3.02 or better.');
}
function Check_IE_Version(x1, x2, x3, x4: Integer): Integer;
var  v1,v2,v3,v4: Word; fn: String;
begin
  result := -1;
  fn := GetWinSysDir + '\Shdocvw.dll';
  if GetFileVer(fn, v1,v2,v3,v4) <> '' then
  begin
    //trick -- Early versions of IE had only 3 numbers
    if (v1=4) and (v2<=70) and (v3=0) then
    begin
      v3 := v4;  v4 := 0;
    end;

    result := VerCompare(v1,v2,v3,v4, x1,x2,x3,x4);  //Compare installed version with x.x.x.x 
  end;
end;

{
. MediaPlayer 6.4 = 22D6F312-B0F6-11D0-94AB-0080C74C7E95   //MediaPlayer.MediaPlayer.1
   InProc  C:\WINNT\System32\msdxm.ocx  (6.4.9.1117)  (6.4.9.1109)
. MediaPlayer 7.0 = 6BF52A52-394A-11d3-B153-00C04F79FAA6   //WMPlayer.OCX.7
   InProc  C:\WINNT\System32\wmp.ocx (7.1.0.3055)
}
function Check_WMP_Version(x1, x2, x3, x4: Integer): Integer;
var  v1,v2,v3,v4: Word; fn: String;
begin
  result := -1;

  if x1 = 6 then
    fn := GetWinSysDir + '\msdxm.ocx'           //6.4 player
  else if x1 >= 7 then
    fn := GetWinSysDir + '\wmp.ocx'             //7.x player
  else
    Exit;

  if GetFileVer(fn, v1,v2,v3,v4) <> '' then
    result := VerCompare(v1,v2,v3,v4, x1,x2,x3,x4);  //Compare installed version with x.x.x.x
end;


{ Get Friendly version numbers of IE (see above)
  return '' if Shdocvw.dll not found. otherwise a descriptive version string

  The following are the versions of Shdocvw.dll and the browser version that each represents
  <major version>.<minor version>.<build number>.<sub-build number>

  From http://support.microsoft.com/support/kb/articles/q164/5/39.asp
  or get up to date version info from http://helpware.net/htmlhelp/hh_info.htm

Shdocvw.dll -------------- May be different from the about box

   Version         Product
   --------------------------------------------------------------
   4.70.1155       Internet Explorer 3.0
   4.70.1158       Internet Explorer 3.0 (OSR2)
   4.70.1215       Internet Explorer 3.01
   4.70.1300       Internet Explorer 3.02
   4.71.1008.3     Internet Explorer 4.0 PP2
   4.71.1712.5     Internet Explorer 4.0
   4.72.2106.7     Internet Explorer 4.01
   4.72.3110.3     Internet Explorer 4.01 Service Pack 1
   4.72.3612.1707  Internet Explorer 4.01 SP2
   5.00.0518.5     Internet Explorer 5 Developer Preview (Beta 1)
   5.00.0910.1308  Internet Explorer 5 Beta (Beta 2)
   5.00.2014.213   Internet Explorer 5.0
   5.00.2314.1000  Internet Explorer 5.0a -- Released with Win98 SE and MSDN
   5.00.2614.3500  Internet Explorer 5.0b -- Contains Java VM and DCOM security patch as an update to Win98 SE
   5.00.2721.1400  Internet Explorer 5 with Update for "ImportExport - Favorites()" Security Issue installed
   5.0.2723.2900   Internet Explorer 5.0 with Update for "Server-side Page Reference Redirect" Issue installed.

   5.00.2919.800    Internet Explorer 5.01 (Windows 2000 RC1, build 5.00.2072)
   5.00.2919.3800   Internet Explorer 5.01 (Windows 2000 RC2, build 5.00.2128)
   5.00.2919.6307   Internet Explorer 5.01
   5.00.2919.6400   Internet Explorer 5.01 with Update for "Server-side Page Reference Redirect" Issue installed.
   5.50.3825.1300   Internet Explorer 5.5 Developer Preview (Beta)

   5.50.4030.2400   Internet Explorer 5.5 & Internet Tools Beta
   5.50.4134.0100   Windows Me (4.90.3000)
   5.50.4134.0600   Internet Explorer 5.5
   5.50.4308.2900   Internet Explorer 5.5 Advanced Security Privacy Beta
   5.50.4522.1800   Internet Explorer 5.5 Service Pack 1

   5.50.4522.1800 Internet Explorer 5.5 Service Pack 1
   5.50.4807.2300 Internet Explorer 5.5 Service Pack 2
   6.00.2462.0000 Internet Explorer 6 Public Preview (Beta)
   6.00.2479.0006 Internet Explorer 6 Public Preview (Beta) Refresh
   6.00.2600.0000 Internet Explorer 6 (Windows XP)
}
function GetIEFriendlyVer: String;
var  v1,v2,v3,v4: Word; fn, s: String;
begin
  fn := GetWinSysDir + '\Shdocvw.dll';
  s := GetFileVer(fn, v1,v2,v3,v4);
  //trick -- Early versions of IE had only 3 numbers
  if (v1=4) and (v2<=70) and (v3=0) then
  begin
    v3 := v4;  v4 := 0;
    s := format('%d.%d.%d.%d',[v1,v2,v3,v4]);
  end;

  if s = '' then
    result := ''
  else

  if VerCompare( v1,v2,v3,v4, 6,00,2600,0000) > 0 then
    result := '> Internet Explorer 6'
  else if VerCompare( v1,v2,v3,v4, 6,00,2600,0000) >= 0 then
    result := 'Internet Explorer 6 (Windows XP)'
  else if VerCompare( v1,v2,v3,v4, 6,00,2479,0006) >= 0 then

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -