cmnfunc2.pas

源代码

unit CmnFunc2;

{
  Inno Setup
  Copyright (C) 1997-2004 Jordan Russell
  Portions by Martijn Laan
  For conditions of distribution and use, see LICENSE.TXT.

  Common non-VCL functions

  $jrsoftware: issrc/Projects/CmnFunc2.pas,v 1.59 2004/12/23 19:51:05 jr Exp $
}

{$B-,R-}

interface

{$I VERSION.INC}

uses
  Windows, SysUtils;

{ Delphi 2.01's RegStr unit should never be used because it contains many
  wrong declarations. Delphi 3's RegStr unit doesn't have this problem, but
  for backward compatibility, it defines a few of the correct registry key
  constants here. }
const
  { Do NOT localize any of these }
  NEWREGSTR_PATH_SETUP = 'Software\Microsoft\Windows\CurrentVersion';
  NEWREGSTR_PATH_EXPLORER = NEWREGSTR_PATH_SETUP + '\Explorer';
  NEWREGSTR_PATH_SPECIAL_FOLDERS = NEWREGSTR_PATH_EXPLORER + '\Shell Folders';
  NEWREGSTR_PATH_UNINSTALL = NEWREGSTR_PATH_SETUP + '\Uninstall';
  NEWREGSTR_VAL_UNINSTALLER_DISPLAYNAME = 'DisplayName';
  NEWREGSTR_VAL_UNINSTALLER_COMMANDLINE = 'UninstallString';

type
  PLeadByteSet = ^TLeadByteSet;
  TLeadByteSet = set of Char;

function NewFileExists(const Name: String): Boolean;
function DirExists(const Name: String): Boolean;
function FileOrDirExists(const Name: String): Boolean;
function GetIniString(const Section, Key, Default, Filename: String): String;
function GetIniInt(const Section, Key: String; const Default, Min, Max: Longint; const Filename: String): Longint;
function GetIniBool(const Section, Key: String; const Default: Boolean; const Filename: String): Boolean;
function IniKeyExists(const Section, Key, Filename: String): Boolean;
function IsIniSectionEmpty(const Section, Filename: String): Boolean;
function SetIniString(const Section, Key, Value, Filename: String): Boolean;
function SetIniInt(const Section, Key: String; const Value: Longint; const Filename: String): Boolean;
function SetIniBool(const Section, Key: String; const Value: Boolean; const Filename: String): Boolean;
procedure DeleteIniEntry(const Section, Key, Filename: String);
procedure DeleteIniSection(const Section, Filename: String);
function GetEnv(const EnvVar: String): String;
function GetCmdTail: String;
function NewParamCount: Integer;
function NewParamStr(Index: Integer): string;
function AddQuotes(const S: String): String;
function RemoveQuotes(const S: String): String;
function GetShortName(const LongName: String): String;
function GetWinDir: String;
function GetSystemDir: String;
function GetTempDir: String;
procedure StringChange(var S: String; const FromStr, ToStr: String);
function AdjustLength(var S: String; const Res: Cardinal): Boolean;
function UsingWinNT: Boolean;
function ConvertConstPercentStr(var S: String): Boolean;
function ConvertPercentStr(var S: String): Boolean;
function ConstPos(const Ch: Char; const S: String): Integer;
function SkipPastConst(const S: String; const Start: Integer): Integer;
function RegQueryStringValue(H: HKEY; Name: PChar; var ResultStr: String): Boolean;
function RegQueryMultiStringValue(H: HKEY; Name: PChar; var ResultStr: String): Boolean;
function RegValueExists(H: HKEY; Name: PChar): Boolean;
function RegDeleteKeyIncludingSubkeys(const Key: HKEY; const Name: PChar): Longint;
function RegDeleteKeyIfEmpty(const RootKey: HKEY; const SubkeyName: PChar): Longint;
function GetShellFolderPath(const FolderID: Integer): String;
function GetProgramFilesPath: String;
function GetCommonFilesPath: String;
function IsAdminLoggedOn: Boolean;
function IsPowerUserLoggedOn: Boolean;
function IsMultiByteString(S: String): Boolean;
function FontExists(const FaceName: String): Boolean;
{$IFNDEF IS_D5}
procedure FreeAndNil(var Obj);
function SafeLoadLibrary(const Filename: String; ErrorMode: UINT): HMODULE;
{$ENDIF}
function GetUILanguage: LANGID;
function RemoveAccelChar(const S: String): String;
function GetTextWidth(const DC: HDC; S: String; const Prefix: Boolean): Integer;
function AddPeriod(const S: String): String;
function GetExceptMessage: String;
function GetPreferredUIFont: String;
function IsWildcard(const Pattern: String): Boolean;
function WildcardMatch(const Text, Pattern: PChar): Boolean;
function IntMax(const A, B: Integer): Integer;
function Win32ErrorString(ErrorCode: Integer): String;
procedure GetLeadBytes(var ALeadBytes: TLeadByteSet);
{$IFNDEF IS_D3}
function CompareMem(P1, P2: Pointer; Length: Integer): Boolean;
{$ENDIF}
function DeleteDirTree(const Dir: String): Boolean;

var
  ConstLeadBytes: PLeadByteSet = nil;

implementation

uses
  {$IFNDEF Delphi3orHigher} OLE2, {$ELSE} ActiveX, {$ENDIF} ShlObj, PathFunc;

function InternalGetFileAttr(const Name: String): Integer;
begin
  Result := GetFileAttributes(PChar(RemoveBackslashUnlessRoot(Name)));
end;

function NewFileExists(const Name: String): Boolean;
{ Returns True if the specified file exists.
  This function is better than Delphi's FileExists function because it works
  on files in directories that don't have "list" permission. There is, however,
  one other difference: FileExists allows wildcards, but this function does
  not. }
var
  Attr: Integer;
begin
  Attr := InternalGetFileAttr(Name);
  Result := (Attr <> -1) and (Attr and faDirectory = 0);
end;

function DirExists(const Name: String): Boolean;
{ Returns True if the specified directory name exists. The specified name
  may include a trailing backslash.
  NOTE: Delphi's FileCtrl unit has a similar function called DirectoryExists.
  However, the implementation is different between Delphi 1 and 2. (Delphi 1
  does not count hidden or system directories as existing.) }
var
  Attr: Integer;
begin
  Attr := InternalGetFileAttr(Name);
  Result := (Attr <> -1) and (Attr and faDirectory <> 0);
end;

function FileOrDirExists(const Name: String): Boolean;
{ Returns True if the specified directory or file name exists. The specified
  name may include a trailing backslash. }
begin
  Result := InternalGetFileAttr(Name) <> -1;
end;

function GetIniString(const Section, Key, Default, Filename: String): String;
begin
  SetLength(Result, 1023);
  if Filename <> '' then
    SetLength(Result, GetPrivateProfileString(
      PChar(Section), PChar(Key), PChar(Default),
      @Result[1], 1024, PChar(Filename)))
  else
    SetLength(Result, GetProfileString(
      PChar(Section), PChar(Key), PChar(Default),
      @Result[1], 1024));
end;

function GetIniInt(const Section, Key: String;
  const Default, Min, Max: Longint; const Filename: String): Longint;
{ Reads a Longint from an INI file. If the Longint read is not between Min/Max
  then it returns Default. If Min=Max then Min/Max are ignored }
var
  S: String;
  E: Integer;
begin
  S := GetIniString(Section, Key, '', Filename);
  if S = '' then
    Result := Default
  else begin
    Val(S, Result, E);
    if (E <> 0) or ((Min <> Max) and ((Result < Min) or (Result > Max))) then
      Result := Default;
  end;
end;

function GetIniBool(const Section, Key: String; const Default: Boolean;
  const Filename: String): Boolean;
begin
  Result := GetIniInt(Section, Key, Ord(Default), 0, 0, Filename) <> 0;
end;

function IniKeyExists(const Section, Key, Filename: String): Boolean;
  function Equals(const Default: PChar): Boolean;
  var
    Test: array[0..7] of Char;
  begin
    Test[0] := #0;
    if Filename <> '' then
      GetPrivateProfileString(PChar(Section), PChar(Key), Default,
        Test, SizeOf(Test), PChar(Filename))
    else
      GetProfileString(PChar(Section), PChar(Key), Default,
        Test, SizeOf(Test));
    Result := lstrcmp(Test, Default) = 0;
  end;
begin
  { If the key does not exist, a default string is returned both times. }
  Result := not Equals('x1234x') or not Equals('x5678x');  { <- don't change }
end;

function IsIniSectionEmpty(const Section, Filename: String): Boolean;
var
  Test: array[0..255] of Char;
begin
  Test[0] := #0;
  if Filename <> '' then
    GetPrivateProfileString(PChar(Section), nil, '', Test,
      SizeOf(Test), PChar(Filename))
  else
    GetProfileString(PChar(Section), nil, '', Test, SizeOf(Test));
  Result := Test[0] = #0;
end;

function SetIniString(const Section, Key, Value, Filename: String): Boolean;
begin
  if Filename <> '' then
    Result := WritePrivateProfileString(PChar(Section), PChar(Key),
      PChar(Value), PChar(Filename))
  else
    Result := WriteProfileString(PChar(Section), PChar(Key),
      PChar(Value));
end;

function SetIniInt(const Section, Key: String; const Value: Longint;
  const Filename: String): Boolean;
begin
  Result := SetIniString(Section, Key, IntToStr(Value), Filename);
end;

function SetIniBool(const Section, Key: String; const Value: Boolean;
  const Filename: String): Boolean;
begin
  Result := SetIniInt(Section, Key, Ord(Value), Filename);
end;

procedure DeleteIniEntry(const Section, Key, Filename: String);
begin
  if Filename <> '' then
    WritePrivateProfileString(PChar(Section), PChar(Key),
      nil, PChar(Filename))
  else
    WriteProfileString(PChar(Section), PChar(Key),
      nil);
end;

procedure DeleteIniSection(const Section, Filename: String);
begin
  if Filename <> '' then
    WritePrivateProfileString(PChar(Section), nil, nil,
      PChar(Filename))
  else
    WriteProfileString(PChar(Section), nil, nil);
end;

function GetEnv(const EnvVar: String): String;
{ Gets the value of the specified environment variable. (Just like TP's GetEnv) }
var
  Res: DWORD;
begin
  SetLength(Result, 255);
  repeat
    Res := GetEnvironmentVariable(PChar(EnvVar), PChar(Result), Length(Result));
    if Res = 0 then begin
      Result := '';
      Break;
    end;
  until AdjustLength(Result, Res);
end;

function GetCmdTail: String;
{ Returns all command line parameters passed to the process as a single
  string. }
var
  CmdLine: PChar;
  InQuote: Boolean;
begin
  CmdLine := GetCommandLine;
  InQuote := False;
  while True do begin
    case CmdLine^ of
      #0: Break;
      #1..' ': if not InQuote then Break;
      '"': InQuote := not InQuote;
    end;
    Inc(CmdLine);
  end;
  while CmdLine^ in [#1..' '] do
    Inc(CmdLine);
  Result := CmdLine;
end;

function GetParamStr(P: PChar; var Param: String): PChar;

  function Extract(P: PChar; const Buffer: PChar; var Len: Integer): PChar;
  var
    InQuote: Boolean;
  begin
    Len := 0;
    InQuote := False;
    while (P^ <> #0) and ((P^ > ' ') or InQuote) do begin
      if P^ = '"' then
        InQuote := not InQuote
      else begin
        if Assigned(Buffer) then
          Buffer[Len] := P^;
        Inc(Len);
      end;
      Inc(P);
    end;
    Result := P;
  end;

var
  Len: Integer;
  Buffer: String;
begin
  while True do begin
    while (P[0] <> #0) and (P[0] <= ' ') do Inc(P);
    if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break;
  end;
  Extract(P, nil, Len);
  SetString(Buffer, nil, Len);
  Result := Extract(P, @Buffer[1], Len);
  Param := Buffer;
end;

function NewParamCount: Integer;
var
  P2: String;
  P: PChar;
  S: string;
begin
  P2 := GetCmdTail;
  P := PChar(P2);
  Result := 0;
  while True do begin
    P := GetParamStr(P, S);
    if S = '' then Break;
    Inc(Result);
  end;
end;

function NewParamStr(Index: Integer): string;
var
  Buffer: array[0..MAX_PATH-1] of Char;
  P2: String;
  P: PChar;
begin
  if Index = 0 then begin
    SetString(Result, Buffer, GetModuleFileName(0, Buffer, SizeOf(Buffer)));
  end
  else begin
    P2 := GetCmdTail;
    P := PChar(P2);
    while True do begin
      P := GetParamStr(P, Result);
      if (Index = 1) or (Result = '') then Break;
      Dec(Index);
    end;
  end;
end;

function AddQuotes(const S: String): String;
{ Adds a quote (") character to the left and right sides of the string if
  the string contains a space and it didn't have quotes already. This is
  primarily used when spawning another process with a long filename as one of
  the parameters. }
begin
  Result := Trim(S);
  if (PathPos(' ', Result) <> 0) and
     ((Result[1] <> '"') or (PathLastChar(Result)^ <> '"')) then
    Result := '"' + Result + '"';
end;

function RemoveQuotes(const S: String): String;
{ Opposite of AddQuotes; removes any quotes around the string. }
begin
  Result := S;
  while (Result <> '') and (Result[1] = '"') do
    Delete(Result, 1, 1);
  while (Result <> '') and (PathLastChar(Result)^ = '"') do
    SetLength(Result, Length(Result)-1);
end;

function ConvertPercentStr(var S: String): Boolean;
{ Expands all %-encoded characters in the string (see RFC 2396). Returns True
  if all were successfully expanded. }
var
  I, C, E: Integer;
  N: String;
begin
  Result := True;
  I := 1;
  while I <= Length(S) do begin
    if S[I] = '%' then begin
      N := Copy(S, I, 3);
      if Length(N) <> 3 then begin
        Result := False;
        Break;
      end;
      N[1] := '$';
      Val(N, C, E);
      if E <> 0 then begin
        Result := False;
        Break;
      end;
      { delete the two numbers following '%', and replace '%' with the character }
      Delete(S, I+1, 2);
      S[I] := Chr(C);
    end;
    Inc(I);
  end;
end;