Бібліотека, що містить процедури та функції, які повертають локальну системну інформацію

Для повсякденної роботи більшості програм необхідна інформація про системне оточення. Така як, наприклад, шлях до темпової директорії чи версію операційної системи. В наведеному модулі зібрано процедури та функції, що полегшують отримання цієї інформації.

{*******************************************************************************}
{                                                                               }
{             модуль vmsLocalInformation                                        }
{                  v.3.0.0.20                                                   }
{             створено 22/06/2009                                               }
{                                                                               }
{   Модуль містить процедури та функції, що повертають локальну системну        }
{  інформацію                                                                   }
{                                                                               }
{*******************************************************************************}

unit vmsLocalInformation;

interface

uses
  Windows, WideStrUtils, SysUtils, SHFolder, ComObj, ActiveX, WinSock, Registry;

type
  TLocalInformation = class(TObject)
    {
    Description:
      Повертає повний шлях до каталогів по ідентифікатору
      \All Users\Application Data
      \Program Files\
      \Program Files\Common\
      \My Pictures\
      ...
    Parameters:
      aFolder: константа, що визначає каталог, описана в SHFolder.pas з префіксом CSIDL_
      }
    class function GetSpecialFolderPath(aFolder: integer): string;
    {
    Description:
      Повертає системну інформацію;
    Parameters:
      aFlag: константа, описана в Windows.pas з префіксом LOCALE_
      }
    class function GetLocaleInformation(aFlag: Integer): string;
    {
    Description:
      Повертає системну кодову сторінку
     }
    class function GetSystemCodePage: integer;
    {
    Description:
      Повертає серійний номер логічного диска
    Parameters:
      aLetterDrive: літера диску, наприклад C:, D:
     }
    class function GetDriveSerialNumber(aLetterDrive: PChar): string;
    {
    Description:
      Повертає шлях до системного каталогу System32
     }
    class function GetDirSystem32: string;
    {
    Description:
      Повертає шлях до каталогу Windows
     }
    class function GetDirWindows: string;
    {
    Description:
      Повертає шлях до темпового каталогу
     }
    class function GetDirTemp: string;
    {
    Description:
      Повертає повний шлях до тимчасового файлу
     }
    class function GetFileTemp(aExtension: string = ''; aPrefix: string = ''): string;
    {
    Description:
      Повертає інформацію, чи зареєстровано OLE-об'єкт, наприклад 'Excel.Application'
     }
    class function IsOLEObjectInstalled(aName: string): boolean;
    {
    Description:
      Повертає версію Windows
     }
    class function GetWindowsVersion: string;
    {
    Description:
      Повертає користувача Windows
     }
    class function GetUserFromWindows: string;
    {
    Description:
      Повертає IP-адресу і домен
     }
    class procedure GetLocalIPAddressName(var aIP, aDomain: string);
    {
    Description:
      Повертає версію InternetExplorer
     }
    class function GetIEVersion: string;
  end;

implementation

class function TLocalInformation.GetLocaleInformation(aFlag: Integer): string;
var
  pcLCA: array[0..20] of Char;
begin
  if GetLocaleInfo(LOCALE_USER_DEFAULT, aFlag, pcLCA, 19) <= 0 then
    pcLCA[0] := #0;
  Result := pcLCA;
end;

class procedure TLocalInformation.GetLocalIPAddressName(var aIP, aDomain: string);
var
  WSAData : TWSAData;
  p       : PHostEnt;
  sName   : array [0..$FF] of AnsiChar;
begin
  WSAStartup($0101, WSAData);
  GetHostName(@sName, $FF);
  p := GetHostByName(@sName);

  aIP     := inet_ntoa(PInAddr(p.h_addr_list^)^);
  aDomain := sName;

  WSACleanup;
end;

class function TLocalInformation.GetSpecialFolderPath(aFolder: Integer): string;
const
  SHGFP_TYPE_CURRENT = 0;
var
  path: array[0..MAX_PATH] of Char;
begin
  if SUCCEEDED(SHGetFolderPath(0, aFolder, 0, SHGFP_TYPE_CURRENT, @path[0])) then
    Result := path
  else
    Result := '';
  if (Length(Result) > 0) and (Result[Length(Result)] <> '\') then
    Result := Result + '\';
end;

class function TLocalInformation.GetSystemCodePage: Integer;
begin
  result := StrToInt(GetLocaleInformation(LOCALE_IDEFAULTANSICODEPAGE));
end;

class function TLocalInformation.GetDirWindows: string;
var
  A: array[0..144] of Char;
begin
  GetWindowsDirectory(A, sizeof(A));
  result := StrPas(A) + '\';
end;

class function TLocalInformation.GetDirSystem32: string;
var
  A: array[0..144] of Char;
begin
  GetSystemDirectory(A, sizeof(A));
  result := StrPas(A) + '\';
end;

class function TLocalInformation.GetDirTemp: string;
var
  sTemp: PAnsiChar;
begin
  Result := GetEnvironmentVariable('TEMP');
  if (Result = '') then
    Result := GetEnvironmentVariable('TMP');
  if (Result = '') then
  begin
    GetMem(sTemp, 255);
    GetTempPathA(255, sTemp);
    try
      if (sTemp <> '') then
        Result := sTemp;
    finally
      FreeMem(sTemp);
    end;
  end;
  if (Length(Result) > 0) then
    Result := IncludeTrailingPathDelimiter(Result);
end;

class function TLocalInformation.GetFileTemp(aExtension: string = ''; aPrefix: string = ''): string;
begin
  Result := Concat(GetDirTemp, aPrefix, IntToHex(StrToInt(FormatDateTime('hhmmsszzz', Time)), 8), '.tmp');
  if (aExtension <> '') then
  begin
    if (aExtension[1] <> '.') then
      aExtension := Concat('.', aExtension);
    Result := ChangeFileExt(Result, aExtension);
  end;
end;

class function TLocalInformation.GetDriveSerialNumber(aLetterDrive: PChar): string;
var
  DW           : DWord;
  FileSystem   : array[0..$FF] of Char;
  SerialNumber : DWord;
  SysFlags     : DWord;
  VolumeLabel  : array[0..$FF] of Char;
begin
  GetVolumeInformation(aLetterDrive,
                       VolumeLabel,
                       SizeOf(VolumeLabel),
                       @SerialNumber,
                       DW,
                       SysFlags,
                       FileSystem,
                       SizeOf(FileSystem));
  Result := IntToStr(SerialNumber);
end;

class function TLocalInformation.IsOLEObjectInstalled(aName: string): boolean;
var
  ClassID : TCLSID;
  Rez     : HRESULT;
begin
  Rez := CLSIDFromProgID(PWideChar(WideString(aName)), ClassID);
  if Rez = S_OK then
    Result := True
  else
    Result := False;
end;

class function TLocalInformation.GetWindowsVersion: string;
begin
  Result := TOSVersion.ToString;
end;

class function TLocalInformation.GetUserFromWindows: string;
var
  sUserName    : string;
  sUserNameLen : Dword;
begin
  sUserNameLen := 255;
  SetLength(sUserName, sUserNameLen);
  if GetUserName(PChar(sUserName), sUserNameLen) then
    Result := Copy(sUserName,1,sUserNameLen - 1)
  else
    Result := 'Unknown';
end;

class function TLocalInformation.GetIEVersion: string;
var
  loReg: TRegistry;
begin
  loReg := TRegistry.Create;
  try
    loReg.RootKey := HKEY_LOCAL_MACHINE;
    loReg.OpenKey('Software\Microsoft\Internet Explorer', False);
    try
      Result := loReg.ReadString('Version');
    except
      Result := '';
    end;
    loReg.CloseKey;
  finally
    FreeAndNil(loReg);
  end;
end;

end.

Завантажити файл

В заголовку бібліотеки всі функції описано в коментарях, нема додаткової потреби в поясненнях.
Приклад використання:

procedure TForm1.Button1Click(Sender: TObject);
var
  sIP  : string;
  sName: string;
  sText: string;
begin
  TLocalInformation.GetLocalIPAddressName(sIP, sName);
  sText := Concat('GetDirSystem32 - ', TLocalInformation.GetDirSystem32, sLineBreak,
                  'GetDirTemp - ', TLocalInformation.GetDirTemp, sLineBreak,
                  'GetDriveSerialNumber - ', TLocalInformation.GetDriveSerialNumber('C:'), sLineBreak,
                  'GetFileTemp - ', TLocalInformation.GetFileTemp, sLineBreak,
                  'GetSystemCodePage - ', IntToStr(TLocalInformation.GetSystemCodePage), sLineBreak,
                  'GetUserFromWindows - ', TLocalInformation.GetUserFromWindows, sLineBreak,
                  'GetWindowsVersion - ', TLocalInformation.GetWindowsVersion, sLineBreak,
                  'Host - ', sName, sLineBreak,
                  'IP-address - ', sIP);
  Application.MessageBox(PWideChar(sText), 'Local Information');
end;