2726 lines
87 KiB
ObjectPascal
2726 lines
87 KiB
ObjectPascal
{******************************************************************************}
|
|
{ }
|
|
{ Library: Fundamentals 5.00 }
|
|
{ File name: flcWinUtils.pas }
|
|
{ File version: 5.14 }
|
|
{ Description: MS Windows utility functions }
|
|
{ }
|
|
{ Copyright: Copyright (c) 2000-2019, David J Butler }
|
|
{ All rights reserved. }
|
|
{ Redistribution and use in source and binary forms, with }
|
|
{ or without modification, are permitted provided that }
|
|
{ the following conditions are met: }
|
|
{ Redistributions of source code must retain the above }
|
|
{ copyright notice, this list of conditions and the }
|
|
{ following disclaimer. }
|
|
{ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND }
|
|
{ CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED }
|
|
{ WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED }
|
|
{ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A }
|
|
{ PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL }
|
|
{ THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, }
|
|
{ INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR }
|
|
{ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, }
|
|
{ PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF }
|
|
{ USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) }
|
|
{ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER }
|
|
{ IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING }
|
|
{ NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE }
|
|
{ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE }
|
|
{ POSSIBILITY OF SUCH DAMAGE. }
|
|
{ }
|
|
{ Github: https://github.com/fundamentalslib }
|
|
{ E-mail: fundamentals.library at gmail.com }
|
|
{ }
|
|
{ Revision history: }
|
|
{ }
|
|
{ 2000/10/01 1.01 Initial version created from cUtils. }
|
|
{ 2002/03/15 2.02 Added GetWinOSType. }
|
|
{ 2002/06/26 3.03 Refactored for Fundamentals 3. }
|
|
{ 2002/09/22 3.04 Refactored registry functions. }
|
|
{ 2002/12/08 3.05 Improvements to registry functions. }
|
|
{ 2003/01/04 3.06 Added Reboot function. }
|
|
{ 2003/10/01 3.07 Updated GetWindowsVersion function. }
|
|
{ 2005/08/26 4.08 Split unit into cWinUtils and cWinClasses. }
|
|
{ 2005/09/29 4.09 Revised for Fundamentals 4. }
|
|
{ 2009/03/27 4.10 Updates for Delphi 2009. }
|
|
{ 2016/01/21 4.11 String changes. }
|
|
{ 2016/01/22 5.12 Revised for Fundamentals 5. }
|
|
{ 2018/08/12 5.13 String type changes. }
|
|
{ 2019/03/22 5.14 Changes for FreePascal 3.0.4. }
|
|
{ }
|
|
{ Supported compilers: }
|
|
{ }
|
|
{ Delphi XE7 Win32 5.12 2016/01/21 }
|
|
{ Delphi XE7 Win64 5.12 2016/01/21 }
|
|
{ }
|
|
{******************************************************************************}
|
|
|
|
{$INCLUDE ..\..\flcInclude.inc}
|
|
|
|
{$IFDEF FREEPASCAL}
|
|
{$WARNINGS OFF}
|
|
{$HINTS OFF}
|
|
{$ENDIF}
|
|
|
|
unit flcWinUtils;
|
|
|
|
interface
|
|
|
|
uses
|
|
{ System }
|
|
Windows,
|
|
SysUtils,
|
|
|
|
{ Fundamentals }
|
|
flcStdTypes,
|
|
flcUtils;
|
|
|
|
|
|
|
|
{ }
|
|
{ Errors }
|
|
{ }
|
|
{$IFDEF DELPHI5}
|
|
type
|
|
EOSError = class(EWin32Error);
|
|
{$ENDIF}
|
|
|
|
function GetLastWinError: LongWord;
|
|
|
|
function WinErrorMessageA(const ErrorCode: LongWord): AnsiString;
|
|
function WinErrorMessageU(const ErrorCode: LongWord): UnicodeString;
|
|
function WinErrorMessage(const ErrorCode: LongWord): String;
|
|
|
|
function GetLastWinErrorMessageA: AnsiString;
|
|
function GetLastWinErrorMessageU: UnicodeString;
|
|
function GetLastWinErrorMessage: String;
|
|
|
|
procedure RaiseWinError(const ErrorCode: LongWord); {$IFDEF UseInline}inline;{$ENDIF}
|
|
procedure RaiseLastWinError; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ Environment variables }
|
|
{ }
|
|
function GetEnvironmentVariableA(const Name: AnsiString): AnsiString;
|
|
function GetEnvironmentVariableU(const Name: UnicodeString): UnicodeString;
|
|
function GetEnvironmentVariable(const Name: String): String; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function GetEnvironmentStringsA: AnsiStringArray;
|
|
function GetEnvironmentStringsU: UnicodeStringArray;
|
|
function GetEnvironmentStrings: StringArray; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ Registry }
|
|
{ }
|
|
|
|
{ SplitRegName }
|
|
procedure SplitRegNameA(const Name: AnsiString; var Key, ValueName: AnsiString);
|
|
procedure SplitRegNameU(const Name: UnicodeString; var Key, ValueName: UnicodeString);
|
|
procedure SplitRegName(const Name: String; var Key, ValueName: String); {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
{ Exists }
|
|
function RegKeyExistsA(const RootKey: HKEY; const Key: AnsiString): Boolean;
|
|
function RegKeyExistsU(const RootKey: HKEY; const Key: UnicodeString): Boolean;
|
|
function RegKeyExists(const RootKey: HKEY; const Key: String): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function RegValueExistsA(const RootKey: HKEY; const Key, Name: AnsiString): Boolean;
|
|
function RegValueExistsU(const RootKey: HKEY; const Key, Name: UnicodeString): Boolean;
|
|
function RegValueExists(const RootKey: HKEY; const Key, Name: String): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
{ Set }
|
|
function RegSetValueA(const RootKey: HKEY; const Key, Name: AnsiString;
|
|
const ValueType: Cardinal; const Value: Pointer;
|
|
const ValueSize: Integer): Boolean; overload;
|
|
function RegSetValueU(const RootKey: HKEY; const Key, Name: UnicodeString;
|
|
const ValueType: Cardinal; const Value: Pointer;
|
|
const ValueSize: Integer): Boolean; overload;
|
|
function RegSetValue(const RootKey: HKEY; const Key, Name: String;
|
|
const ValueType: Cardinal; const Value: Pointer;
|
|
const ValueSize: Integer): Boolean; overload; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function RegSetValueA(const RootKey: HKEY; const Name: AnsiString;
|
|
const ValueType: Cardinal; const Value: Pointer;
|
|
const ValueSize: Integer): Boolean; overload;
|
|
function RegSetValueU(const RootKey: HKEY; const Name: UnicodeString;
|
|
const ValueType: Cardinal; const Value: Pointer;
|
|
const ValueSize: Integer): Boolean; overload;
|
|
function RegSetValue(const RootKey: HKEY; const Name: String;
|
|
const ValueType: Cardinal; const Value: Pointer;
|
|
const ValueSize: Integer): Boolean; overload; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function SetRegistryStringA(const RootKey: HKEY; const Key: AnsiString;
|
|
const Name: AnsiString; const Value: AnsiString): Boolean; overload;
|
|
function SetRegistryStringU(const RootKey: HKEY; const Key: UnicodeString;
|
|
const Name: UnicodeString; const Value: UnicodeString): Boolean; overload;
|
|
function SetRegistryString(const RootKey: HKEY; const Key: String;
|
|
const Name: String; const Value: String): Boolean; overload; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function SetRegistryStringA(const RootKey: HKEY; const Name: AnsiString;
|
|
const Value: AnsiString): Boolean; overload;
|
|
function SetRegistryStringU(const RootKey: HKEY; const Name: UnicodeString;
|
|
const Value: UnicodeString): Boolean; overload;
|
|
function SetRegistryString(const RootKey: HKEY; const Name: String;
|
|
const Value: String): Boolean; overload; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function SetRegistryDWordA(const RootKey: HKEY; const Name: AnsiString;
|
|
const Value: LongWord): Boolean;
|
|
function SetRegistryDWordU(const RootKey: HKEY; const Name: UnicodeString;
|
|
const Value: LongWord): Boolean;
|
|
function SetRegistryDWord(const RootKey: HKEY; const Name: String;
|
|
const Value: LongWord): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function SetRegistryBinaryA(const RootKey: HKEY; const Name: AnsiString;
|
|
const Value; const ValueSize: Integer): Boolean;
|
|
|
|
{ Get }
|
|
function RegGetValueA(
|
|
const RootKey: HKEY; const Key, Name: AnsiString;
|
|
const ValueType: Cardinal;
|
|
var RegValueType: Cardinal;
|
|
var ValueBuf: Pointer; var ValueSize: Integer): Boolean; overload;
|
|
function RegGetValueU(
|
|
const RootKey: HKEY; const Key, Name: UnicodeString;
|
|
const ValueType: Cardinal;
|
|
var RegValueType: Cardinal;
|
|
var ValueBuf: Pointer; var ValueSize: Integer): Boolean; overload;
|
|
function RegGetValue(
|
|
const RootKey: HKEY; const Key, Name: String;
|
|
const ValueType: Cardinal;
|
|
var RegValueType: Cardinal;
|
|
var ValueBuf: Pointer; var ValueSize: Integer): Boolean; overload; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function RegGetValueA(
|
|
const RootKey: HKEY; const Name: AnsiString;
|
|
const ValueType: Cardinal; var RegValueType: Cardinal;
|
|
var ValueBuf: Pointer; var ValueSize: Integer): Boolean; overload;
|
|
|
|
function GetRegistryStringA(const RootKey: HKEY; const Key, Name: AnsiString): AnsiString; overload;
|
|
function GetRegistryStringU(const RootKey: HKEY; const Key, Name: UnicodeString): UnicodeString; overload;
|
|
function GetRegistryString(const RootKey: HKEY; const Key, Name: String): String; overload; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function GetRegistryStringA(const RootKey: HKEY; const Name: AnsiString): AnsiString; overload;
|
|
function GetRegistryStringU(const RootKey: HKEY; const Name: UnicodeString): UnicodeString; overload;
|
|
function GetRegistryString(const RootKey: HKEY; const Name: String): String; overload; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function GetRegistryDWordA(const RootKey: HKEY; const Key, Name: AnsiString): LongWord;
|
|
function GetRegistryDWordU(const RootKey: HKEY; const Key, Name: UnicodeString): LongWord;
|
|
function GetRegistryDWord(const RootKey: HKEY; const Key, Name: String): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
{ Delete }
|
|
function DeleteRegistryValueA(const RootKey: HKEY; const Key, Name: AnsiString): Boolean;
|
|
function DeleteRegistryValueU(const RootKey: HKEY; const Key, Name: UnicodeString): Boolean;
|
|
function DeleteRegistryValue(const RootKey: HKEY; const Key, Name: String): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function DeleteRegistryKeyA(const RootKey: HKEY; const Key: AnsiString): Boolean;
|
|
function DeleteRegistryKeyU(const RootKey: HKEY; const Key: UnicodeString): Boolean;
|
|
function DeleteRegistryKey(const RootKey: HKEY; const Key: String): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
{ Remote Registries }
|
|
function ConnectRegistryA(const MachineName: AnsiString; const RootKey: HKEY;
|
|
var RemoteKey: HKEY): Boolean;
|
|
function ConnectRegistryU(const MachineName: UnicodeString; const RootKey: HKEY;
|
|
var RemoteKey: HKEY): Boolean;
|
|
|
|
function DisconnectRegistry(const RemoteKey: HKEY): Boolean;
|
|
|
|
{ Enumerate }
|
|
function EnumRegistryValuesA(const RootKey: HKEY; const Name: AnsiString;
|
|
var ValueList: AnsiStringArray): Boolean;
|
|
function EnumRegistryValuesU(const RootKey: HKEY; const Name: UnicodeString;
|
|
var ValueList: UnicodeStringArray): Boolean;
|
|
function EnumRegistryValues(const RootKey: HKEY; const Name: String;
|
|
var ValueList: StringArray): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function EnumRegistryKeysA(const RootKey: HKEY; const Name: AnsiString;
|
|
var KeyList: AnsiStringArray): Boolean;
|
|
function EnumRegistryKeysU(const RootKey: HKEY; const Name: UnicodeString;
|
|
var KeyList: UnicodeStringArray): Boolean;
|
|
function EnumRegistryKeys(const RootKey: HKEY; const Name: String;
|
|
var KeyList: StringArray): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ Windows Version }
|
|
{ }
|
|
type
|
|
TWindowsVersion = (
|
|
// 16-bit Windows
|
|
Win16_31,
|
|
// 32-bit Windows
|
|
Win32_95, Win32_95R2, Win32_98, Win32_98SE, Win32_ME, Win32_Future,
|
|
// Windows NT (Pre 3)
|
|
WinNT_Pre3,
|
|
// Windows NT 3
|
|
WinNT_31, WinNT_35, WinNT_351,
|
|
// Windows NT 4
|
|
WinNT_40,
|
|
// Windows NT 5 - 2000/XP/2003
|
|
Win_2000, Win_XP, Win_2003, WinNT5_Future,
|
|
// Windows NT 6 - Vista/7/8/8.1
|
|
Win_Vista, Win_7, Win_8, Win_81, WinNT6_Future,
|
|
// Windows NT 10 - 10
|
|
Win_10, WinNT10_Future,
|
|
// Windows NT 11+
|
|
WinNT_Future,
|
|
// Windows Post-NT
|
|
Win_Future);
|
|
TWindowsVersions = set of TWindowsVersion;
|
|
|
|
function GetWindowsVersion: TWindowsVersion;
|
|
|
|
function GetWindowsVersionString: String;
|
|
|
|
function IsWinPlatform95: Boolean;
|
|
function IsWinPlatformNT: Boolean;
|
|
|
|
function GetWindowsProductIDA: AnsiString;
|
|
function GetWindowsProductIDU: UnicodeString;
|
|
function GetWindowsProductID: String; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function GetWindowsProductNameA: AnsiString;
|
|
function GetWindowsProductNameU: UnicodeString;
|
|
function GetWindowsProductName: String; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ Windows Paths }
|
|
{ }
|
|
procedure EnsurePathSuffixA(var Path: AnsiString);
|
|
procedure EnsurePathSuffixU(var Path: UnicodeString);
|
|
procedure EnsurePathSuffix(var Path: String);
|
|
|
|
function GetWindowsTemporaryPathA: AnsiString;
|
|
function GetWindowsTemporaryPathU: UnicodeString;
|
|
function GetWindowsTemporaryPath: String; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function GetWindowsPathA: AnsiString;
|
|
function GetWindowsPathU: UnicodeString;
|
|
function GetWindowsPath: String; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function GetWindowsSystemPathA: AnsiString;
|
|
function GetWindowsSystemPathU: UnicodeString;
|
|
function GetWindowsSystemPath: String; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function GetProgramFilesPathA: AnsiString;
|
|
function GetProgramFilesPathU: UnicodeString;
|
|
function GetProgramFilesPath: String;
|
|
|
|
function GetCommonFilesPathA: AnsiString;
|
|
function GetCommonFilesPathU: UnicodeString;
|
|
function GetCommonFilesPath: String;
|
|
|
|
function GetApplicationFileNameA: AnsiString;
|
|
function GetApplicationFileNameU: UnicodeString;
|
|
function GetApplicationFileName: String;
|
|
|
|
function GetApplicationPath: String;
|
|
|
|
function GetHomePathA: AnsiString;
|
|
function GetHomePathU: UnicodeString;
|
|
function GetHomePath: String; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function GetLocalAppDataPathA: AnsiString;
|
|
function GetLocalAppDataPathU: UnicodeString;
|
|
function GetLocalAppDataPath: String; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ Identification }
|
|
{ }
|
|
function GetUserNameA: AnsiString;
|
|
function GetUserNameU: UnicodeString;
|
|
function GetUserName: String; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function GetLocalComputerNameA: AnsiString;
|
|
function GetLocalComputerNameU: UnicodeString;
|
|
function GetLocalComputerName: String; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ Application Version Info }
|
|
{ }
|
|
type
|
|
TVersionInfo = (viFileVersion, viFileDescription, viLegalCopyright,
|
|
viComments, viCompanyName, viInternalName,
|
|
viLegalTrademarks, viOriginalFilename, viProductName,
|
|
viProductVersion);
|
|
|
|
function GetAppVersionInfoA(const VersionInfo: TVersionInfo): AnsiString;
|
|
function GetAppVersionInfoU(const VersionInfo: TVersionInfo): UnicodeString;
|
|
function GetAppVersionInfo(const VersionInfo: TVersionInfo): String; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ Windows Processes }
|
|
{ }
|
|
function WinExecuteA(const ExeName, Params: AnsiString;
|
|
const ShowWin: Word = SW_SHOWNORMAL;
|
|
const WaitTime: Integer = -1;
|
|
const DefaultPath: AnsiString = ''): LongWord;
|
|
function WinExecuteU(const ExeName, Params: UnicodeString;
|
|
const ShowWin: Word = SW_SHOWNORMAL;
|
|
const WaitTime: Integer = -1;
|
|
const DefaultPath: UnicodeString = ''): LongWord;
|
|
function WinExecute(const ExeName, Params: String;
|
|
const ShowWin: Word = SW_SHOWNORMAL;
|
|
const WaitTime: Integer = -1;
|
|
const DefaultPath: String = ''): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ Dynamic library }
|
|
{ }
|
|
type
|
|
TLibraryHandle = Cardinal;
|
|
|
|
function LoadLibraryA(const LibraryName: AnsiString): TLibraryHandle; overload;
|
|
function LoadLibraryA(const LibraryName: array of AnsiString): TLibraryHandle; overload;
|
|
function LoadLibraryU(const LibraryName: UnicodeString): TLibraryHandle;
|
|
function LoadLibrary(const LibraryName: String): TLibraryHandle; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function GetProcAddressA(const Handle: TLibraryHandle; const ProcName: AnsiString): Pointer;
|
|
{$IFNDEF FREEPASCAL}
|
|
function GetProcAddressU(const Handle: TLibraryHandle; const ProcName: UnicodeString): Pointer;
|
|
{$ENDIF}
|
|
function GetProcAddress(const Handle: TLibraryHandle; const ProcName: String): Pointer; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
procedure FreeLibrary(const Handle: TLibraryHandle);
|
|
|
|
type
|
|
TDynamicLibrary = class
|
|
protected
|
|
FHandle : TLibraryHandle;
|
|
|
|
function GetProcAddressA(const ProcName: AnsiString): Pointer;
|
|
function GetProcAddressU(const ProcName: UnicodeString): Pointer;
|
|
|
|
public
|
|
constructor CreateA(const LibraryName: AnsiString); overload;
|
|
constructor CreateA(const LibraryName: array of AnsiString); overload;
|
|
|
|
constructor CreateU(const LibraryName: UnicodeString);
|
|
|
|
destructor Destroy; override;
|
|
|
|
property Handle: TLibraryHandle read FHandle;
|
|
|
|
property ProcAddressA[const ProcName: AnsiString]: Pointer read GetProcAddressA; default;
|
|
property ProcAddressU[const ProcName: UnicodeString]: Pointer read GetProcAddressU;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Exit Windows }
|
|
{ }
|
|
type
|
|
TExitWindowsType = (exitLogOff, exitPowerOff, exitReboot, exitShutDown);
|
|
|
|
function ExitWindows(const ExitType: TExitWindowsType;
|
|
const Force: Boolean = False): Boolean;
|
|
|
|
function LogOff(const Force: Boolean = False): Boolean;
|
|
function PowerOff(const Force: Boolean = False): Boolean;
|
|
function Reboot(const Force: Boolean = False): Boolean;
|
|
function ShutDown(const Force: Boolean = False): Boolean;
|
|
|
|
|
|
|
|
{ }
|
|
{ Locale information }
|
|
{ }
|
|
function GetCountryCode1A: AnsiString;
|
|
function GetCountryCode1U: UnicodeString;
|
|
function GetCountryCode1: String; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function GetCountryCode2A: AnsiString;
|
|
function GetCountryCode2U: UnicodeString;
|
|
function GetCountryCode2: String; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function GetCountryNameA: AnsiString;
|
|
function GetCountryNameU: UnicodeString;
|
|
function GetCountryName: String; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ Miscelleaneous Windows API }
|
|
{ }
|
|
function ContentTypeFromExtentionA(const Extention: AnsiString): AnsiString;
|
|
function ContentTypeFromExtentionU(const Extention: UnicodeString): UnicodeString;
|
|
function ContentTypeFromExtention(const Extention: String): String; {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function FileClassFromExtentionA(const Extention: AnsiString): AnsiString;
|
|
|
|
function GetFileClassA(const FileName: AnsiString): AnsiString;
|
|
|
|
function GetFileAssociationA(const FileName: AnsiString): AnsiString;
|
|
|
|
function IsApplicationAutoRunA(const Name: AnsiString): Boolean;
|
|
|
|
procedure SetApplicationAutoRunA(const Name: AnsiString; const AutoRun: Boolean);
|
|
|
|
function GetKeyPressed(const VKeyCode: Integer): Boolean;
|
|
|
|
function GetHardDiskSerialNumberA(const DriveLetter: AnsiChar): AnsiString;
|
|
function GetHardDiskSerialNumberU(const DriveLetter: WideChar): UnicodeString;
|
|
function GetHardDiskSerialNumber(const DriveLetter: Char): String;
|
|
|
|
|
|
|
|
{ }
|
|
{ Windows Fibers API }
|
|
{ }
|
|
type
|
|
TFNFiberStartRoutine = TFarProc;
|
|
|
|
function ConvertThreadToFiber(lpParameter: Pointer): Pointer; stdcall;
|
|
function CreateFiber(dwStackSize: DWORD; lpStartAddress: TFNFiberStartRoutine;
|
|
lpParameter: Pointer): Pointer; stdcall;
|
|
|
|
|
|
|
|
{ }
|
|
{ Windows Shell API }
|
|
{ }
|
|
function ShellExecuteA(hWnd: HWND; Operation, FileName, Parameters,
|
|
Directory: PAnsiChar; ShowCmd: Integer): HINST; stdcall;
|
|
|
|
procedure ShellLaunch(const S: AnsiString);
|
|
|
|
|
|
|
|
{ }
|
|
{ WinSpool API }
|
|
{ }
|
|
function EnumPortsA(pName: PAnsiChar; Level: DWORD; pPorts: Pointer; cbBuf: DWORD;
|
|
var pcbNeeded, pcReturned: DWORD): BOOL; stdcall;
|
|
|
|
function GetWinPortNamesA: AnsiStringArray;
|
|
|
|
|
|
|
|
{ }
|
|
{ Timers }
|
|
{ }
|
|
function GetMsCount: LongWord;
|
|
function GetUsCount: Int64;
|
|
|
|
|
|
|
|
{ }
|
|
{ Tests }
|
|
{ }
|
|
{$IFDEF DEBUG}
|
|
{$IFDEF TEST}
|
|
procedure Test;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
{ Fundamentals }
|
|
flcDynArrays,
|
|
flcStrings,
|
|
flcZeroTermStrings,
|
|
flcFileUtils;
|
|
|
|
|
|
|
|
resourcestring
|
|
SInvalidParameter = 'Invalid parameter';
|
|
SProcessTimedOut = 'Process timed out';
|
|
|
|
|
|
|
|
{ }
|
|
{ Errors }
|
|
{ }
|
|
function GetLastWinError: LongWord;
|
|
begin
|
|
Result := Windows.GetLastError;
|
|
end;
|
|
|
|
const
|
|
MAX_ERRORMESSAGE_LENGTH = 512;
|
|
|
|
function WinErrorMessageA(const ErrorCode: LongWord): AnsiString;
|
|
var Buf: array[0..MAX_ERRORMESSAGE_LENGTH + 1] of AnsiChar;
|
|
Len: LongWord;
|
|
begin
|
|
FillChar(Buf, Sizeof(Buf), 0);
|
|
Len := Windows.FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrorCode, 0,
|
|
@Buf, MAX_ERRORMESSAGE_LENGTH, nil);
|
|
if Len = 0 then
|
|
Result := 'WindowsError#' + IntToStringA(ErrorCode)
|
|
else
|
|
Result := StrZPasA(PAnsiChar(@Buf));
|
|
end;
|
|
|
|
function WinErrorMessageU(const ErrorCode: LongWord): UnicodeString;
|
|
var Buf: array[0..MAX_ERRORMESSAGE_LENGTH + 1] of WideChar;
|
|
Len: LongWord;
|
|
begin
|
|
FillChar(Buf, Sizeof(Buf), 0);
|
|
Len := Windows.FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrorCode, 0,
|
|
@Buf, MAX_ERRORMESSAGE_LENGTH, nil);
|
|
if Len = 0 then
|
|
Result := 'WindowsError#' + IntToStringU(ErrorCode)
|
|
else
|
|
Result := StrZPasU(PWideChar(@Buf));
|
|
end;
|
|
|
|
function WinErrorMessage(const ErrorCode: LongWord): String;
|
|
var Buf: array[0..MAX_ERRORMESSAGE_LENGTH + 1] of Char;
|
|
Len: LongWord;
|
|
begin
|
|
FillChar(Buf, Sizeof(Buf), 0);
|
|
{$IFDEF StringIsUnicode}
|
|
Len := Windows.FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrorCode, 0,
|
|
@Buf, MAX_ERRORMESSAGE_LENGTH, nil);
|
|
{$ELSE}
|
|
Len := Windows.FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrorCode, 0,
|
|
@Buf, MAX_ERRORMESSAGE_LENGTH, nil);
|
|
{$ENDIF}
|
|
if Len = 0 then
|
|
Result := 'WindowsError#' + IntToStr(ErrorCode)
|
|
else
|
|
Result := StrPas(PChar(@Buf));
|
|
end;
|
|
|
|
function GetLastWinErrorMessageA: AnsiString;
|
|
begin
|
|
Result := WinErrorMessageA(GetLastWinError);
|
|
end;
|
|
|
|
function GetLastWinErrorMessageU: UnicodeString;
|
|
begin
|
|
Result := WinErrorMessageU(GetLastWinError);
|
|
end;
|
|
|
|
function GetLastWinErrorMessage: String;
|
|
begin
|
|
Result := WinErrorMessage(GetLastWinError);
|
|
end;
|
|
|
|
procedure RaiseWinError(const ErrorCode: LongWord);
|
|
begin
|
|
raise EOSError.Create(WinErrorMessage(ErrorCode));
|
|
end;
|
|
|
|
procedure RaiseLastWinError;
|
|
begin
|
|
raise EOSError.Create(GetLastWinErrorMessage);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Environment variables }
|
|
{ }
|
|
const
|
|
MAX_ENVIRONMENTVARIABLE_LEN = 16384;
|
|
|
|
function GetEnvironmentVariableA(const Name: AnsiString): AnsiString;
|
|
var Buf: array[0..MAX_ENVIRONMENTVARIABLE_LEN] of AnsiChar;
|
|
begin
|
|
FillChar(Buf, Sizeof(Buf), 0);
|
|
Windows.GetEnvironmentVariableA(PAnsiChar(Name), @Buf[0], MAX_ENVIRONMENTVARIABLE_LEN);
|
|
Result := StrZPasA(@Buf[0]);
|
|
end;
|
|
|
|
function GetEnvironmentVariableU(const Name: UnicodeString): UnicodeString;
|
|
var Buf: array[0..MAX_ENVIRONMENTVARIABLE_LEN] of WideChar;
|
|
begin
|
|
FillChar(Buf, Sizeof(Buf), 0);
|
|
Windows.GetEnvironmentVariableW(PWideChar(Name), @Buf[0], MAX_ENVIRONMENTVARIABLE_LEN);
|
|
Result := StrZPasU(@Buf[0]);
|
|
end;
|
|
|
|
function GetEnvironmentVariable(const Name: String): String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetEnvironmentVariableU(Name);
|
|
{$ELSE}
|
|
Result := GetEnvironmentVariableA(Name);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function GetEnvironmentStringsA: AnsiStringArray;
|
|
var P, Q, H : PAnsiChar;
|
|
I : Integer;
|
|
S : AnsiString;
|
|
begin
|
|
H := PAnsiChar(Windows.GetEnvironmentStringsA);
|
|
try
|
|
P := H;
|
|
if P^ <> #0 then
|
|
repeat
|
|
Q := P;
|
|
I := 0;
|
|
while Q^ <> #0 do
|
|
begin
|
|
Inc(Q);
|
|
Inc(I);
|
|
end;
|
|
SetLength(S, I);
|
|
if I > 0 then
|
|
MoveMem(P^, PAnsiChar(S)^, I);
|
|
DynArrayAppendA(Result, S);
|
|
P := Q;
|
|
Inc(P);
|
|
until P^ = #0;
|
|
finally
|
|
FreeEnvironmentStringsA(H);
|
|
end;
|
|
end;
|
|
|
|
function GetEnvironmentStringsU: UnicodeStringArray;
|
|
var P, Q, H : PWideChar;
|
|
I : Integer;
|
|
S : UnicodeString;
|
|
begin
|
|
H := PWideChar(Windows.GetEnvironmentStringsW);
|
|
try
|
|
P := H;
|
|
if P^ <> #0 then
|
|
repeat
|
|
Q := P;
|
|
I := 0;
|
|
while Q^ <> #0 do
|
|
begin
|
|
Inc(Q);
|
|
Inc(I);
|
|
end;
|
|
SetLength(S, I);
|
|
if I > 0 then
|
|
MoveMem(P^, PWideChar(S)^, I * SizeOf(WideChar));
|
|
DynArrayAppendU(Result, S);
|
|
P := Q;
|
|
Inc(P);
|
|
until P^ = #0;
|
|
finally
|
|
FreeEnvironmentStringsW(H);
|
|
end;
|
|
end;
|
|
|
|
function GetEnvironmentStrings: StringArray;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := StringArray(GetEnvironmentStringsU);
|
|
{$ELSE}
|
|
Result := StringArray(GetEnvironmentStringsA);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Registry }
|
|
{ }
|
|
procedure SplitRegNameA(const Name: AnsiString; var Key, ValueName: AnsiString);
|
|
var S : AnsiString;
|
|
I : Integer;
|
|
begin
|
|
S := StrExclSuffixA(StrExclPrefixA(Name, '\'), '\');
|
|
I := PosCharA('\', S);
|
|
if I <= 0 then
|
|
begin
|
|
Key := S;
|
|
ValueName := '';
|
|
exit;
|
|
end;
|
|
Key := CopyLeftA(S, I - 1);
|
|
ValueName := CopyFromA(S, I + 1);
|
|
end;
|
|
|
|
procedure SplitRegNameU(const Name: UnicodeString; var Key, ValueName: UnicodeString);
|
|
var S : UnicodeString;
|
|
I : Integer;
|
|
begin
|
|
S := StrExclSuffixU(StrExclPrefixU(Name, '\'), '\');
|
|
I := PosCharU('\', S);
|
|
if I <= 0 then
|
|
begin
|
|
Key := S;
|
|
ValueName := '';
|
|
exit;
|
|
end;
|
|
Key := CopyLeftU(S, I - 1);
|
|
ValueName := CopyFromU(S, I + 1);
|
|
end;
|
|
|
|
procedure SplitRegName(const Name: String; var Key, ValueName: String);
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
SplitRegNameU(Name, Key, ValueName);
|
|
{$ELSE}
|
|
SplitRegNameA(Name, Key, ValueName);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ Exists }
|
|
function RegKeyExistsA(const RootKey: HKEY; const Key: AnsiString): Boolean;
|
|
var Handle : HKEY;
|
|
begin
|
|
if RegOpenKeyExA(RootKey, PAnsiChar(Key), 0, KEY_READ, Handle) = ERROR_SUCCESS then
|
|
begin
|
|
RegCloseKey(Handle);
|
|
Result := True;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function RegKeyExistsU(const RootKey: HKEY; const Key: UnicodeString): Boolean;
|
|
var Handle : HKEY;
|
|
begin
|
|
if RegOpenKeyExW(RootKey, PWideChar(Key), 0, KEY_READ, Handle) = ERROR_SUCCESS then
|
|
begin
|
|
RegCloseKey(Handle);
|
|
Result := True;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function RegKeyExists(const RootKey: HKEY; const Key: String): Boolean;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := RegKeyExistsU(RootKey, Key);
|
|
{$ELSE}
|
|
Result := RegKeyExistsA(RootKey, Key);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function RegValueExistsA(const RootKey: HKEY; const Key, Name: AnsiString): Boolean;
|
|
var Handle : HKEY;
|
|
begin
|
|
if Windows.RegOpenKeyExA(RootKey, PAnsiChar(Key), 0, KEY_READ, Handle) = ERROR_SUCCESS then
|
|
begin
|
|
Result := Windows.RegQueryValueExA(Handle, PAnsiChar(Name), nil, nil, nil, nil) = ERROR_SUCCESS;
|
|
RegCloseKey(Handle);
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function RegValueExistsU(const RootKey: HKEY; const Key, Name: UnicodeString): Boolean;
|
|
var Handle : HKEY;
|
|
begin
|
|
if Windows.RegOpenKeyExW(RootKey, PWideChar(Key), 0, KEY_READ, Handle) = ERROR_SUCCESS then
|
|
begin
|
|
Result := Windows.RegQueryValueExW(Handle, PWideChar(Name), nil, nil, nil, nil) = ERROR_SUCCESS;
|
|
RegCloseKey(Handle);
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function RegValueExists(const RootKey: HKEY; const Key, Name: String): Boolean;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := RegValueExistsU(RootKey, Key, Name);
|
|
{$ELSE}
|
|
Result := RegValueExistsA(RootKey, Key, Name);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ Set }
|
|
function RegSetValueA(const RootKey: HKEY; const Key, Name: AnsiString;
|
|
const ValueType: Cardinal; const Value: Pointer;
|
|
const ValueSize: Integer): Boolean;
|
|
var D : DWORD;
|
|
Handle : HKEY;
|
|
begin
|
|
Result := False;
|
|
if ValueSize < 0 then
|
|
exit;
|
|
if RegCreateKeyExA(RootKey, PAnsiChar(Key), 0, nil, REG_OPTION_NON_VOLATILE,
|
|
KEY_WRITE, nil, Handle, @D) <> ERROR_SUCCESS then
|
|
exit;
|
|
Result := RegSetValueExA(Handle, PAnsiChar(Name), 0, ValueType, Value, ValueSize) = ERROR_SUCCESS;
|
|
RegCloseKey(Handle);
|
|
end;
|
|
|
|
function RegSetValueU(const RootKey: HKEY; const Key, Name: UnicodeString;
|
|
const ValueType: Cardinal; const Value: Pointer;
|
|
const ValueSize: Integer): Boolean;
|
|
var D : DWORD;
|
|
Handle : HKEY;
|
|
begin
|
|
Result := False;
|
|
if ValueSize < 0 then
|
|
exit;
|
|
if RegCreateKeyExW(RootKey, PWideChar(Key), 0, nil, REG_OPTION_NON_VOLATILE,
|
|
KEY_WRITE, nil, Handle, @D) <> ERROR_SUCCESS then
|
|
exit;
|
|
Result := RegSetValueExW(Handle, PWideChar(Name), 0, ValueType, Value, ValueSize) = ERROR_SUCCESS;
|
|
RegCloseKey(Handle);
|
|
end;
|
|
|
|
function RegSetValue(const RootKey: HKEY; const Key, Name: String;
|
|
const ValueType: Cardinal; const Value: Pointer;
|
|
const ValueSize: Integer): Boolean;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := RegSetValueU(RootKey, Key, Name, ValueType, Value, ValueSize);
|
|
{$ELSE}
|
|
Result := RegSetValueA(RootKey, Key, Name, ValueType, Value, ValueSize);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function RegSetValueA(const RootKey: HKEY; const Name: AnsiString;
|
|
const ValueType: Cardinal; const Value: Pointer;
|
|
const ValueSize: Integer): Boolean;
|
|
var K, N : AnsiString;
|
|
begin
|
|
SplitRegNameA(Name, K, N);
|
|
Result := RegSetValueA(RootKey, K, N, ValueType, Value, ValueSize);
|
|
end;
|
|
|
|
function RegSetValueU(const RootKey: HKEY; const Name: UnicodeString;
|
|
const ValueType: Cardinal; const Value: Pointer;
|
|
const ValueSize: Integer): Boolean;
|
|
var K, N : UnicodeString;
|
|
begin
|
|
SplitRegNameU(Name, K, N);
|
|
Result := RegSetValueU(RootKey, K, N, ValueType, Value, ValueSize);
|
|
end;
|
|
|
|
function RegSetValue(const RootKey: HKEY; const Name: String;
|
|
const ValueType: Cardinal; const Value: Pointer;
|
|
const ValueSize: Integer): Boolean;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := RegSetValueU(RootKey, Name, ValueType, Value, ValueSize);
|
|
{$ELSE}
|
|
Result := RegSetValueA(RootKey, Name, ValueType, Value, ValueSize);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function SetRegistryStringA(const RootKey: HKEY; const Key: AnsiString;
|
|
const Name: AnsiString; const Value: AnsiString): Boolean;
|
|
begin
|
|
Result := RegSetValueA(RootKey, Key, Name, REG_SZ, PAnsiChar(Value), Length(Value) + 1);
|
|
end;
|
|
|
|
function SetRegistryStringU(const RootKey: HKEY; const Key: UnicodeString;
|
|
const Name: UnicodeString; const Value: UnicodeString): Boolean;
|
|
begin
|
|
Result := RegSetValueU(RootKey, Key, Name, REG_SZ, PWideChar(Value), (Length(Value) + 1) * SizeOf(WideChar));
|
|
end;
|
|
|
|
function SetRegistryString(const RootKey: HKEY; const Key: String;
|
|
const Name: String; const Value: String): Boolean;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := SetRegistryStringU(RootKey, Key, Name, Value);
|
|
{$ELSE}
|
|
Result := SetRegistryStringA(RootKey, Key, Name, Value);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function SetRegistryStringA(const RootKey: HKEY; const Name: AnsiString;
|
|
const Value: AnsiString): Boolean;
|
|
begin
|
|
Result := RegSetValueA(RootKey, Name, REG_SZ, PAnsiChar(Value), Length(Value) + 1);
|
|
end;
|
|
|
|
function SetRegistryStringU(const RootKey: HKEY; const Name: UnicodeString;
|
|
const Value: UnicodeString): Boolean;
|
|
begin
|
|
Result := RegSetValueU(RootKey, Name, REG_SZ, PWideChar(Value), (Length(Value) + 1) * SizeOf(WideChar));
|
|
end;
|
|
|
|
function SetRegistryString(const RootKey: HKEY; const Name: String;
|
|
const Value: String): Boolean;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := SetRegistryStringU(RootKey, Name, Value);
|
|
{$ELSE}
|
|
Result := SetRegistryStringA(RootKey, Name, Value);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function SetRegistryDWordA(const RootKey: HKEY; const Name: AnsiString;
|
|
const Value: LongWord): Boolean;
|
|
begin
|
|
Result := RegSetValueA(RootKey, Name, REG_DWORD, @Value, Sizeof(LongWord));
|
|
end;
|
|
|
|
function SetRegistryDWordU(const RootKey: HKEY; const Name: UnicodeString;
|
|
const Value: LongWord): Boolean;
|
|
begin
|
|
Result := RegSetValueU(RootKey, Name, REG_DWORD, @Value, Sizeof(LongWord));
|
|
end;
|
|
|
|
function SetRegistryDWord(const RootKey: HKEY; const Name: String;
|
|
const Value: LongWord): Boolean;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := SetRegistryDWordU(RootKey, Name, Value);
|
|
{$ELSE}
|
|
Result := SetRegistryDWordA(RootKey, Name, Value);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function SetRegistryBinaryA(const RootKey: HKEY; const Name: AnsiString; const Value;
|
|
const ValueSize: Integer): Boolean;
|
|
begin
|
|
Result := RegSetValueA(RootKey, Name, REG_BINARY, @Value, ValueSize);
|
|
end;
|
|
|
|
{ Get }
|
|
function RegGetValueA(const RootKey: HKEY; const Key, Name: AnsiString;
|
|
const ValueType: Cardinal; var RegValueType: Cardinal;
|
|
var ValueBuf: Pointer; var ValueSize: Integer): Boolean;
|
|
var Handle : HKEY;
|
|
Buf : Pointer;
|
|
BufSize : Cardinal;
|
|
begin
|
|
Result := False;
|
|
ValueSize := 0;
|
|
ValueBuf := nil;
|
|
if RegOpenKeyExA(RootKey, PAnsiChar(Key), 0, KEY_READ, Handle) <> ERROR_SUCCESS then
|
|
exit;
|
|
try
|
|
BufSize := 0;
|
|
RegQueryValueExA(Handle, PAnsiChar(Name), nil, @RegValueType, nil, @BufSize);
|
|
if BufSize <= 0 then
|
|
exit;
|
|
GetMem(Buf, BufSize);
|
|
if RegQueryValueExA(Handle, PAnsiChar(Name), nil, @RegValueType, Buf, @BufSize) = ERROR_SUCCESS then
|
|
begin
|
|
ValueBuf := Buf;
|
|
ValueSize := Integer(BufSize);
|
|
Result := True;
|
|
end;
|
|
if not Result then
|
|
FreeMem(Buf);
|
|
finally
|
|
RegCloseKey(Handle);
|
|
end;
|
|
end;
|
|
|
|
function RegGetValueU(const RootKey: HKEY; const Key, Name: UnicodeString;
|
|
const ValueType: Cardinal; var RegValueType: Cardinal;
|
|
var ValueBuf: Pointer; var ValueSize: Integer): Boolean;
|
|
var Handle : HKEY;
|
|
Buf : Pointer;
|
|
BufSize : Cardinal;
|
|
begin
|
|
Result := False;
|
|
ValueSize := 0;
|
|
ValueBuf := nil;
|
|
if RegOpenKeyExW(RootKey, PWideChar(Key), 0, KEY_READ, Handle) <> ERROR_SUCCESS then
|
|
exit;
|
|
try
|
|
BufSize := 0;
|
|
RegQueryValueExW(Handle, PWideChar(Name), nil, @RegValueType, nil, @BufSize);
|
|
if BufSize <= 0 then
|
|
exit;
|
|
GetMem(Buf, BufSize);
|
|
if RegQueryValueExW(Handle, PWideChar(Name), nil, @RegValueType, Buf, @BufSize) = ERROR_SUCCESS then
|
|
begin
|
|
ValueBuf := Buf;
|
|
ValueSize := Integer(BufSize);
|
|
Result := True;
|
|
end;
|
|
if not Result then
|
|
FreeMem(Buf);
|
|
finally
|
|
RegCloseKey(Handle);
|
|
end;
|
|
end;
|
|
|
|
function RegGetValue(
|
|
const RootKey: HKEY; const Key, Name: String;
|
|
const ValueType: Cardinal;
|
|
var RegValueType: Cardinal;
|
|
var ValueBuf: Pointer; var ValueSize: Integer): Boolean;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := RegGetValueU(RootKey, Key, Name, ValueType, RegValueType, ValueBuf, ValueSize);
|
|
{$ELSE}
|
|
Result := RegGetValueA(RootKey, Key, Name, ValueType, RegValueType, ValueBuf, ValueSize);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function RegGetValueA(const RootKey: HKEY; const Name: AnsiString;
|
|
const ValueType: Cardinal; var RegValueType: Cardinal;
|
|
var ValueBuf: Pointer; var ValueSize: Integer): Boolean;
|
|
var K, N : AnsiString;
|
|
begin
|
|
SplitRegNameA(Name, K, N);
|
|
Result := RegGetValueA(RootKey, K, N, ValueType, RegValueType, ValueBuf, ValueSize);
|
|
end;
|
|
|
|
function GetRegistryStringA(const RootKey: HKEY; const Key, Name: AnsiString): AnsiString;
|
|
var Buf : Pointer;
|
|
Size : Integer;
|
|
VType : Cardinal;
|
|
begin
|
|
Result := '';
|
|
if not RegGetValueA(RootKey, Key, Name, REG_SZ, VType, Buf, Size) then
|
|
exit;
|
|
if (VType = REG_DWORD) and (Size >= Sizeof(LongWord)) then
|
|
Result := IntToStringA(PLongWord(Buf)^) else
|
|
if Size > 0 then
|
|
begin
|
|
SetLength(Result, Size - 1);
|
|
MoveMem(Buf^, PAnsiChar(Result)^, Size - 1);
|
|
end;
|
|
FreeMem(Buf);
|
|
end;
|
|
|
|
function GetRegistryStringU(const RootKey: HKEY; const Key, Name: UnicodeString): UnicodeString;
|
|
var Buf : Pointer;
|
|
Size : Integer;
|
|
VType : Cardinal;
|
|
begin
|
|
Result := '';
|
|
if not RegGetValueU(RootKey, Key, Name, REG_SZ, VType, Buf, Size) then
|
|
exit;
|
|
if (VType = REG_DWORD) and (Size >= Sizeof(LongWord)) then
|
|
Result := IntToStringU(PLongWord(Buf)^) else
|
|
if Size > 0 then
|
|
begin
|
|
SetLength(Result, (Size div SizeOf(WideChar)) - 1);
|
|
MoveMem(Buf^, PWideChar(Result)^, Size - 1);
|
|
end;
|
|
FreeMem(Buf);
|
|
end;
|
|
|
|
function GetRegistryString(const RootKey: HKEY; const Key, Name: String): String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetRegistryStringU(RootKey, Key, Name);
|
|
{$ELSE}
|
|
Result := GetRegistryStringA(RootKey, Key, Name);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function GetRegistryStringA(const RootKey: HKEY; const Name: AnsiString): AnsiString;
|
|
var K, N : AnsiString;
|
|
begin
|
|
SplitRegNameA(Name, K, N);
|
|
Result := GetRegistryStringA(RootKey, K, N);
|
|
end;
|
|
|
|
function GetRegistryStringU(const RootKey: HKEY; const Name: UnicodeString): UnicodeString;
|
|
var K, N : UnicodeString;
|
|
begin
|
|
SplitRegNameU(Name, K, N);
|
|
Result := GetRegistryStringU(RootKey, K, N);
|
|
end;
|
|
|
|
function GetRegistryString(const RootKey: HKEY; const Name: String): String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetRegistryStringU(RootKey, Name);
|
|
{$ELSE}
|
|
Result := GetRegistryStringA(RootKey, Name);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function GetRegistryDWordA(const RootKey: HKEY; const Key, Name: AnsiString): LongWord;
|
|
var Buf : Pointer;
|
|
Size : Integer;
|
|
VType : Cardinal;
|
|
begin
|
|
Result := 0;
|
|
if not RegGetValueA(RootKey, Key, Name, REG_DWORD, VType, Buf, Size) then
|
|
exit;
|
|
if (VType = REG_DWORD) and (Size >= Sizeof(LongWord)) then
|
|
Result := PLongWord(Buf)^;
|
|
FreeMem(Buf);
|
|
end;
|
|
|
|
function GetRegistryDWordU(const RootKey: HKEY; const Key, Name: UnicodeString): LongWord;
|
|
var Buf : Pointer;
|
|
Size : Integer;
|
|
VType : Cardinal;
|
|
begin
|
|
Result := 0;
|
|
if not RegGetValueU(RootKey, Key, Name, REG_DWORD, VType, Buf, Size) then
|
|
exit;
|
|
if (VType = REG_DWORD) and (Size >= Sizeof(LongWord)) then
|
|
Result := PLongWord(Buf)^;
|
|
FreeMem(Buf);
|
|
end;
|
|
|
|
function GetRegistryDWord(const RootKey: HKEY; const Key, Name: String): LongWord;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetRegistryDWordU(RootKey, Key, Name);
|
|
{$ELSE}
|
|
Result := GetRegistryDWordA(RootKey, Key, Name);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ Delete }
|
|
function DeleteRegistryValueA(const RootKey: HKEY; const Key, Name: AnsiString): Boolean;
|
|
var Handle : HKEY;
|
|
begin
|
|
if RegOpenKeyExA(RootKey, PAnsiChar(Key), 0, KEY_WRITE, Handle) = ERROR_SUCCESS then
|
|
begin
|
|
Result := RegDeleteValueA(Handle, PAnsiChar(Name)) = ERROR_SUCCESS;
|
|
RegCloseKey(Handle);
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function DeleteRegistryValueU(const RootKey: HKEY; const Key, Name: UnicodeString): Boolean;
|
|
var Handle : HKEY;
|
|
begin
|
|
if RegOpenKeyExW(RootKey, PWideChar(Key), 0, KEY_WRITE, Handle) = ERROR_SUCCESS then
|
|
begin
|
|
Result := RegDeleteValueW(Handle, PWideChar(Name)) = ERROR_SUCCESS;
|
|
RegCloseKey(Handle);
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function DeleteRegistryValue(const RootKey: HKEY; const Key, Name: String): Boolean;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := DeleteRegistryValueU(RootKey, Key, Name);
|
|
{$ELSE}
|
|
Result := DeleteRegistryValueA(RootKey, Key, Name);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function DeleteRegistryKeyA(const RootKey: HKEY; const Key: AnsiString): Boolean;
|
|
var Handle : HKEY;
|
|
K, N : AnsiString;
|
|
begin
|
|
SplitRegNameA(Key, K, N);
|
|
if RegOpenKeyExA(RootKey, PAnsiChar(K), 0, KEY_WRITE, Handle) = ERROR_SUCCESS then
|
|
begin
|
|
Result := RegDeleteKeyA(Handle, PAnsiChar(N)) = ERROR_SUCCESS;
|
|
RegCloseKey(Handle);
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function DeleteRegistryKeyU(const RootKey: HKEY; const Key: UnicodeString): Boolean;
|
|
var Handle : HKEY;
|
|
K, N : UnicodeString;
|
|
begin
|
|
SplitRegNameU(Key, K, N);
|
|
if RegOpenKeyExW(RootKey, PWideChar(K), 0, KEY_WRITE, Handle) = ERROR_SUCCESS then
|
|
begin
|
|
Result := RegDeleteKeyW(Handle, PWideChar(N)) = ERROR_SUCCESS;
|
|
RegCloseKey(Handle);
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function DeleteRegistryKey(const RootKey: HKEY; const Key: String): Boolean;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := DeleteRegistryKeyU(RootKey, Key);
|
|
{$ELSE}
|
|
Result := DeleteRegistryKeyA(RootKey, Key);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ Remote Registries }
|
|
function ConnectRegistryA(const MachineName: AnsiString; const RootKey: HKEY;
|
|
var RemoteKey: HKEY): Boolean;
|
|
begin
|
|
Result := RegConnectRegistryA(PAnsiChar(MachineName), RootKey, RemoteKey) = ERROR_SUCCESS;
|
|
end;
|
|
|
|
function ConnectRegistryU(const MachineName: UnicodeString; const RootKey: HKEY;
|
|
var RemoteKey: HKEY): Boolean;
|
|
begin
|
|
Result := RegConnectRegistryW(PWideChar(MachineName), RootKey, RemoteKey) = ERROR_SUCCESS;
|
|
end;
|
|
|
|
function DisconnectRegistry(const RemoteKey: HKEY): Boolean;
|
|
begin
|
|
Result := RegCloseKey(RemoteKey) = ERROR_SUCCESS;
|
|
end;
|
|
|
|
{ Enumerate }
|
|
function RegEnumA(const RootKey: HKEY; const Name: AnsiString;
|
|
var ResultList: AnsiStringArray; const DoKeys: Boolean): Boolean;
|
|
const
|
|
BufCharCount = 2048;
|
|
var Buf : array[0..BufCharCount] of AnsiChar;
|
|
BufLen : LongWord;
|
|
I : Integer;
|
|
Res : Integer;
|
|
S : AnsiString;
|
|
Handle : HKEY;
|
|
begin
|
|
ResultList := nil;
|
|
Result := RegOpenKeyExA(RootKey, PAnsiChar(Name), 0, KEY_READ, Handle) = ERROR_SUCCESS;
|
|
if not Result then
|
|
exit;
|
|
I := 0;
|
|
repeat
|
|
BufLen := BufCharCount;
|
|
if DoKeys then
|
|
Res := RegEnumKeyExA(Handle, I, @Buf[0], BufLen, nil, nil, nil, nil)
|
|
else
|
|
Res := RegEnumValueA(Handle, I, @Buf[0], BufLen, nil, nil, nil, nil);
|
|
if Res = ERROR_SUCCESS then
|
|
begin
|
|
SetLength(S, BufLen);
|
|
if BufLen > 0 then
|
|
MoveMem(Buf[0], PAnsiChar(S)^, BufLen);
|
|
DynArrayAppendA(ResultList, S);
|
|
Inc(I);
|
|
end;
|
|
until Res <> ERROR_SUCCESS;
|
|
RegCloseKey(Handle);
|
|
end;
|
|
|
|
function RegEnumU(const RootKey: HKEY; const Name: UnicodeString;
|
|
var ResultList: UnicodeStringArray; const DoKeys: Boolean): Boolean;
|
|
const
|
|
BufCharCount = 2048;
|
|
var Buf : array[0..BufCharCount] of WideChar;
|
|
BufLen : LongWord;
|
|
I : Integer;
|
|
Res : Integer;
|
|
S : UnicodeString;
|
|
Handle : HKEY;
|
|
begin
|
|
ResultList := nil;
|
|
Result := RegOpenKeyExW(RootKey, PWideChar(Name), 0, KEY_READ, Handle) = ERROR_SUCCESS;
|
|
if not Result then
|
|
exit;
|
|
I := 0;
|
|
repeat
|
|
BufLen := BufCharCount;
|
|
if DoKeys then
|
|
Res := RegEnumKeyExW(Handle, I, @Buf[0], BufLen, nil, nil, nil, nil)
|
|
else
|
|
Res := RegEnumValueW(Handle, I, @Buf[0], BufLen, nil, nil, nil, nil);
|
|
if Res = ERROR_SUCCESS then
|
|
begin
|
|
SetLength(S, BufLen);
|
|
if BufLen > 0 then
|
|
MoveMem(Buf[0], PWideChar(S)^, BufLen * SizeOf(WideChar));
|
|
DynArrayAppendU(ResultList, S);
|
|
Inc(I);
|
|
end;
|
|
until Res <> ERROR_SUCCESS;
|
|
RegCloseKey(Handle);
|
|
end;
|
|
|
|
function EnumRegistryValuesA(const RootKey: HKEY; const Name: AnsiString;
|
|
var ValueList: AnsiStringArray): Boolean;
|
|
begin
|
|
Result := RegEnumA(RootKey, Name, ValueList, False);
|
|
end;
|
|
|
|
function EnumRegistryValuesU(const RootKey: HKEY; const Name: UnicodeString;
|
|
var ValueList: UnicodeStringArray): Boolean;
|
|
begin
|
|
Result := RegEnumU(RootKey, Name, ValueList, False);
|
|
end;
|
|
|
|
function EnumRegistryValues(const RootKey: HKEY; const Name: String;
|
|
var ValueList: StringArray): Boolean;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := EnumRegistryValuesU(RootKey, Name, UnicodeStringArray(ValueList));
|
|
{$ELSE}
|
|
Result := EnumRegistryValuesA(RootKey, Name, AnsiStringArray(ValueList));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function EnumRegistryKeysA(const RootKey: HKEY; const Name: AnsiString;
|
|
var KeyList: AnsiStringArray): Boolean;
|
|
begin
|
|
Result := RegEnumA(RootKey, Name, KeyList, True);
|
|
end;
|
|
|
|
function EnumRegistryKeysU(const RootKey: HKEY; const Name: UnicodeString;
|
|
var KeyList: UnicodeStringArray): Boolean;
|
|
begin
|
|
Result := RegEnumU(RootKey, Name, KeyList, True);
|
|
end;
|
|
|
|
function EnumRegistryKeys(const RootKey: HKEY; const Name: String;
|
|
var KeyList: StringArray): Boolean;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := EnumRegistryKeysU(RootKey, Name, UnicodeStringArray(KeyList));
|
|
{$ELSE}
|
|
Result := EnumRegistryKeysA(RootKey, Name, AnsiStringArray(KeyList));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Windows Version Info }
|
|
{ }
|
|
var
|
|
Win32PlatformInit : Boolean = False;
|
|
Win32Platform : Integer;
|
|
Win32MajorVersion : Integer;
|
|
Win32MinorVersion : Integer;
|
|
Win32CSDVersion : AnsiString;
|
|
|
|
procedure InitPlatformId;
|
|
var OSVersionInfo : TOSVersionInfoA;
|
|
begin
|
|
OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
|
|
if Windows.GetVersionExA(OSVersionInfo) then
|
|
with OSVersionInfo do
|
|
begin
|
|
Win32Platform := dwPlatformId;
|
|
Win32MajorVersion := dwMajorVersion;
|
|
Win32MinorVersion := dwMinorVersion;
|
|
Win32CSDVersion := szCSDVersion;
|
|
end;
|
|
Win32PlatformInit := True;
|
|
end;
|
|
|
|
function GetWindowsVersion: TWindowsVersion;
|
|
begin
|
|
if not Win32PlatformInit then
|
|
InitPlatformId;
|
|
case Win32Platform of
|
|
VER_PLATFORM_WIN32s :
|
|
Result := Win16_31;
|
|
VER_PLATFORM_WIN32_WINDOWS :
|
|
if Win32MajorVersion <= 4 then
|
|
case Win32MinorVersion of
|
|
0..9 : if StrTrimA(Win32CSDVersion, csWhiteSpace) = 'B' then
|
|
Result := Win32_95R2
|
|
else
|
|
Result := Win32_95;
|
|
10..89 : if StrTrimA(Win32CSDVersion, csWhiteSpace) = 'A' then
|
|
Result := Win32_98SE
|
|
else
|
|
Result := Win32_98;
|
|
90..99 : Result := Win32_ME;
|
|
else
|
|
Result := Win32_Future;
|
|
end
|
|
else
|
|
Result := Win32_Future;
|
|
VER_PLATFORM_WIN32_NT :
|
|
case Win32MajorVersion of
|
|
0..2 : Result := WinNT_Pre3;
|
|
3 : case Win32MinorVersion of
|
|
1, 10..19 : Result := WinNT_31;
|
|
5, 50 : Result := WinNT_35;
|
|
51..99 : Result := WinNT_351;
|
|
else
|
|
Result := WinNT_31;
|
|
end;
|
|
4 : Result := WinNT_40;
|
|
5 : case Win32MinorVersion of
|
|
0 : Result := Win_2000;
|
|
1 : Result := Win_XP;
|
|
2 : Result := Win_2003;
|
|
else
|
|
Result := WinNT5_Future;
|
|
end;
|
|
6 : case Win32MinorVersion of
|
|
0 : Result := Win_Vista;
|
|
1 : Result := Win_7;
|
|
2 : Result := Win_8;
|
|
3 : Result := Win_81;
|
|
else
|
|
Result := WinNT6_Future;
|
|
end;
|
|
10 : case Win32MinorVersion of
|
|
0 : Result := Win_10;
|
|
else
|
|
Result := WinNT10_Future;
|
|
end;
|
|
else
|
|
Result := WinNT_Future;
|
|
end;
|
|
else
|
|
Result := Win_Future;
|
|
end;
|
|
end;
|
|
|
|
function GetWindowsVersionString: String;
|
|
begin
|
|
case GetWindowsVersion of
|
|
Win16_31 : Result := '3.1 16-bit';
|
|
Win32_95 : Result := '95';
|
|
Win32_95R2 : Result := '95 R2';
|
|
Win32_98 : Result := '98';
|
|
Win32_98SE : Result := '98 SE';
|
|
Win32_ME : Result := 'ME';
|
|
Win32_Future : Result := '32-bit';
|
|
WinNT_Pre3 : Result := 'NT <3';
|
|
WinNT_31 : Result := 'NT 3.1';
|
|
WinNT_35 : Result := 'NT 3.5';
|
|
WinNT_351 : Result := 'NT 3.51';
|
|
WinNT_40 : Result := 'NT 4';
|
|
Win_2000 : Result := '2000';
|
|
Win_XP : Result := 'XP';
|
|
Win_2003 : Result := '2003';
|
|
WinNT5_Future : Result := '2003+';
|
|
Win_Vista : Result := 'Vista/2008';
|
|
Win_7 : Result := '7/2008R2';
|
|
Win_8 : Result := '8/2012';
|
|
Win_81 : Result := '8.1/2012R2';
|
|
WinNT6_Future : Result := '8.1+/2012R2+';
|
|
Win_10 : Result := '10/2016';
|
|
WinNT10_Future : Result := '10+/2016+';
|
|
WinNT_Future : Result := '(future)';
|
|
Win_Future : Result := '(future)';
|
|
else
|
|
Result := '';
|
|
end;
|
|
end;
|
|
|
|
function IsWinPlatform95: Boolean;
|
|
begin
|
|
Result := Win32Platform = VER_PLATFORM_WIN32_WINDOWS;
|
|
end;
|
|
|
|
function IsWinPlatformNT: Boolean;
|
|
begin
|
|
Result := Win32Platform = VER_PLATFORM_WIN32_NT;
|
|
end;
|
|
|
|
const
|
|
CurrentVersionKey1 = 'Software\Microsoft\Windows NT\CurrentVersion';
|
|
CurrentVersionKey2 = 'Software\Microsoft\Windows\CurrentVersion';
|
|
|
|
function GetWindowsProductIDA: AnsiString;
|
|
begin
|
|
Result := GetRegistryStringA(HKEY_LOCAL_MACHINE, CurrentVersionKey1, 'ProductId');
|
|
if Result = '' then
|
|
Result := GetRegistryStringA(HKEY_LOCAL_MACHINE, CurrentVersionKey2, 'ProductId');
|
|
end;
|
|
|
|
function GetWindowsProductIDU: UnicodeString;
|
|
begin
|
|
Result := GetRegistryStringU(HKEY_LOCAL_MACHINE, CurrentVersionKey1, 'ProductId');
|
|
if Result = '' then
|
|
Result := GetRegistryStringU(HKEY_LOCAL_MACHINE, CurrentVersionKey2, 'ProductId');
|
|
end;
|
|
|
|
function GetWindowsProductID: String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetWindowsProductIDU;
|
|
{$ELSE}
|
|
Result := GetWindowsProductIDA;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function GetWindowsProductNameA: AnsiString;
|
|
begin
|
|
Result := GetRegistryStringA(HKEY_LOCAL_MACHINE, CurrentVersionKey1, 'ProductName');
|
|
if Result = '' then
|
|
Result := GetRegistryStringA(HKEY_LOCAL_MACHINE, CurrentVersionKey2, 'ProductName');
|
|
end;
|
|
|
|
function GetWindowsProductNameU: UnicodeString;
|
|
begin
|
|
Result := GetRegistryStringU(HKEY_LOCAL_MACHINE, CurrentVersionKey1, 'ProductName');
|
|
if Result = '' then
|
|
Result := GetRegistryStringU(HKEY_LOCAL_MACHINE, CurrentVersionKey2, 'ProductName');
|
|
end;
|
|
|
|
function GetWindowsProductName: String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetWindowsProductNameU;
|
|
{$ELSE}
|
|
Result := GetWindowsProductNameA;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
{ }
|
|
{ Windows Paths }
|
|
{ }
|
|
procedure EnsurePathSuffixA(var Path: AnsiString);
|
|
var L : Integer;
|
|
begin
|
|
L := Length(Path);
|
|
if (L > 0) and (Path[L] <> '\') then
|
|
begin
|
|
SetLength(Path, L + 1);
|
|
Path[L + 1] := '\';
|
|
end;
|
|
end;
|
|
|
|
procedure EnsurePathSuffixU(var Path: UnicodeString);
|
|
var L : Integer;
|
|
begin
|
|
L := Length(Path);
|
|
if (L > 0) and (Path[L] <> '\') then
|
|
begin
|
|
SetLength(Path, L + 1);
|
|
Path[L + 1] := '\';
|
|
end;
|
|
end;
|
|
|
|
procedure EnsurePathSuffix(var Path: String);
|
|
var L : Integer;
|
|
begin
|
|
L := Length(Path);
|
|
if (L > 0) and (Path[L] <> '\') then
|
|
begin
|
|
SetLength(Path, L + 1);
|
|
Path[L + 1] := '\';
|
|
end;
|
|
end;
|
|
|
|
const
|
|
MaxTempPathLen = MAX_PATH + 1;
|
|
|
|
function GetWindowsTemporaryPathA: AnsiString;
|
|
var I : LongWord;
|
|
begin
|
|
SetLength(Result, MaxTempPathLen);
|
|
I := GetTempPathA(MaxTempPathLen, PAnsiChar(Result));
|
|
if I > 0 then
|
|
SetLength(Result, I)
|
|
else
|
|
Result := GetEnvironmentVariableA('TEMP');
|
|
EnsurePathSuffixA(Result);
|
|
end;
|
|
|
|
function GetWindowsTemporaryPathU: UnicodeString;
|
|
var I : LongWord;
|
|
begin
|
|
SetLength(Result, MaxTempPathLen);
|
|
I := GetTempPathW(MaxTempPathLen, PWideChar(Result));
|
|
if I > 0 then
|
|
SetLength(Result, I)
|
|
else
|
|
Result := GetEnvironmentVariableU('TEMP');
|
|
EnsurePathSuffixU(Result);
|
|
end;
|
|
|
|
function GetWindowsTemporaryPath: String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetWindowsTemporaryPathU;
|
|
{$ELSE}
|
|
Result := GetWindowsTemporaryPathA;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
const
|
|
MaxWinPathLen = MAX_PATH + 1;
|
|
|
|
function GetWindowsPathA: AnsiString;
|
|
var I : LongWord;
|
|
begin
|
|
SetLength(Result, MaxWinPathLen);
|
|
I := Windows.GetWindowsDirectoryA(PAnsiChar(Result), MaxWinPathLen);
|
|
if I > 0 then
|
|
SetLength(Result, I)
|
|
else
|
|
Result := GetEnvironmentVariableA('SystemRoot');
|
|
EnsurePathSuffixA(Result);
|
|
end;
|
|
|
|
function GetWindowsPathU: UnicodeString;
|
|
var I : LongWord;
|
|
begin
|
|
SetLength(Result, MaxWinPathLen);
|
|
I := Windows.GetWindowsDirectoryW(PWideChar(Result), MaxWinPathLen);
|
|
if I > 0 then
|
|
SetLength(Result, I)
|
|
else
|
|
Result := GetEnvironmentVariableU('SystemRoot');
|
|
EnsurePathSuffixU(Result);
|
|
end;
|
|
|
|
function GetWindowsPath: String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetWindowsPathU;
|
|
{$ELSE}
|
|
Result := GetWindowsPathA;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
const
|
|
MaxWinSysPathLen = MAX_PATH + 1;
|
|
|
|
function GetWindowsSystemPathA: AnsiString;
|
|
var I : LongWord;
|
|
begin
|
|
SetLength(Result, MaxWinSysPathLen);
|
|
I := Windows.GetSystemDirectoryA(PAnsiChar(Result), MaxWinSysPathLen);
|
|
if I > 0 then
|
|
SetLength(Result, I)
|
|
else
|
|
Result := '';
|
|
EnsurePathSuffixA(Result);
|
|
end;
|
|
|
|
function GetWindowsSystemPathU: UnicodeString;
|
|
var I : LongWord;
|
|
begin
|
|
SetLength(Result, MaxWinSysPathLen);
|
|
I := Windows.GetSystemDirectoryW(PWideChar(Result), MaxWinSysPathLen);
|
|
if I > 0 then
|
|
SetLength(Result, I)
|
|
else
|
|
Result := '';
|
|
EnsurePathSuffixU(Result);
|
|
end;
|
|
|
|
function GetWindowsSystemPath: String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetWindowsSystemPathU;
|
|
{$ELSE}
|
|
Result := GetWindowsSystemPathA;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
const
|
|
CurrentVersionRegistryKey = 'SOFTWARE\Microsoft\Windows\CurrentVersion';
|
|
|
|
function GetProgramFilesPathA: AnsiString;
|
|
begin
|
|
Result := GetRegistryStringA(HKEY_LOCAL_MACHINE, CurrentVersionRegistryKey,
|
|
'ProgramFilesDir');
|
|
EnsurePathSuffixA(Result);
|
|
end;
|
|
|
|
function GetProgramFilesPathU: UnicodeString;
|
|
begin
|
|
Result := GetRegistryStringU(HKEY_LOCAL_MACHINE, CurrentVersionRegistryKey,
|
|
'ProgramFilesDir');
|
|
EnsurePathSuffixU(Result);
|
|
end;
|
|
|
|
function GetProgramFilesPath: String;
|
|
begin
|
|
Result := GetRegistryString(HKEY_LOCAL_MACHINE, CurrentVersionRegistryKey,
|
|
'ProgramFilesDir');
|
|
EnsurePathSuffix(Result);
|
|
end;
|
|
|
|
function GetCommonFilesPathA: AnsiString;
|
|
begin
|
|
Result := GetRegistryStringA(HKEY_LOCAL_MACHINE, CurrentVersionRegistryKey,
|
|
'CommonFilesDir');
|
|
EnsurePathSuffixA(Result);
|
|
end;
|
|
|
|
function GetCommonFilesPathU: UnicodeString;
|
|
begin
|
|
Result := GetRegistryStringU(HKEY_LOCAL_MACHINE, CurrentVersionRegistryKey,
|
|
'CommonFilesDir');
|
|
EnsurePathSuffixU(Result);
|
|
end;
|
|
|
|
function GetCommonFilesPath: String;
|
|
begin
|
|
Result := GetRegistryString(HKEY_LOCAL_MACHINE, CurrentVersionRegistryKey,
|
|
'CommonFilesDir');
|
|
EnsurePathSuffix(Result);
|
|
end;
|
|
|
|
function GetApplicationFileNameA: AnsiString;
|
|
begin
|
|
Result := ToAnsiString(ParamStr(0));
|
|
end;
|
|
|
|
function GetApplicationFileNameU: UnicodeString;
|
|
begin
|
|
Result := ToUnicodeString(ParamStr(0));
|
|
end;
|
|
|
|
function GetApplicationFileName: String;
|
|
begin
|
|
Result := ParamStr(0);
|
|
end;
|
|
|
|
function GetApplicationPath: String;
|
|
begin
|
|
Result := ExtractFilePath(GetApplicationFileName);
|
|
EnsurePathSuffix(Result);
|
|
end;
|
|
|
|
function GetHomePathA: AnsiString;
|
|
begin
|
|
Result :=
|
|
GetEnvironmentVariableA('HOMEDRIVE') +
|
|
GetEnvironmentVariableA('HOMEPATH');
|
|
if Result = '' then
|
|
Result := GetEnvironmentVariableA('USERPROFILE');
|
|
EnsurePathSuffixA(Result);
|
|
end;
|
|
|
|
function GetHomePathU: UnicodeString;
|
|
begin
|
|
Result :=
|
|
GetEnvironmentVariableU('HOMEDRIVE') +
|
|
GetEnvironmentVariableU('HOMEPATH');
|
|
if Result = '' then
|
|
Result := GetEnvironmentVariableU('USERPROFILE');
|
|
EnsurePathSuffixU(Result);
|
|
end;
|
|
|
|
function GetHomePath: String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetHomePathU;
|
|
{$ELSE}
|
|
Result := GetHomePathA;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function GetLocalAppDataPathA: AnsiString;
|
|
begin
|
|
Result := GetEnvironmentVariableA('LOCALAPPDATA');
|
|
EnsurePathSuffixA(Result);
|
|
end;
|
|
|
|
function GetLocalAppDataPathU: UnicodeString;
|
|
begin
|
|
Result := GetEnvironmentVariableU('LOCALAPPDATA');
|
|
EnsurePathSuffixU(Result);
|
|
end;
|
|
|
|
function GetLocalAppDataPath: String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetLocalAppDataPathU;
|
|
{$ELSE}
|
|
Result := GetLocalAppDataPathA;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ }
|
|
{ Identification }
|
|
{ }
|
|
const
|
|
MAX_USERNAME_LENGTH = 256;
|
|
|
|
function GetUserNameA: AnsiString;
|
|
var L : LongWord;
|
|
begin
|
|
L := MAX_USERNAME_LENGTH;
|
|
SetLength(Result, L + 1);
|
|
if Windows.GetUserNameA(PAnsiChar(Result), L) and (L > 0) then
|
|
SetLength(Result, StrZLenA(PAnsiChar(Result)))
|
|
else
|
|
Result := GetEnvironmentVariableA('USERNAME');
|
|
end;
|
|
|
|
function GetUserNameU: UnicodeString;
|
|
var L : LongWord;
|
|
begin
|
|
L := MAX_USERNAME_LENGTH;
|
|
SetLength(Result, L + 1);
|
|
if Windows.GetUserNameW(PWideChar(Result), L) and (L > 0) then
|
|
SetLength(Result, StrZLenW(PWideChar(Result)))
|
|
else
|
|
Result := GetEnvironmentVariableU('USERNAME');
|
|
end;
|
|
|
|
function GetUserName: String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetUserNameU;
|
|
{$ELSE}
|
|
Result := GetUserNameA;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function GetLocalComputerNameA: AnsiString;
|
|
var L : LongWord;
|
|
begin
|
|
L := MAX_COMPUTERNAME_LENGTH + 2;
|
|
SetLength(Result, L);
|
|
if Windows.GetComputerNameA(PAnsiChar(Result), L) and (L > 0) then
|
|
SetLength(Result, StrZLenA(PAnsiChar(Result)))
|
|
else
|
|
Result := GetEnvironmentVariableA('COMPUTERNAME');
|
|
end;
|
|
|
|
function GetLocalComputerNameU: UnicodeString;
|
|
var L : LongWord;
|
|
begin
|
|
L := MAX_COMPUTERNAME_LENGTH + 2;
|
|
SetLength(Result, L);
|
|
if Windows.GetComputerNameW(PWideChar(Result), L) and (L > 0) then
|
|
SetLength(Result, StrZLenW(PWideChar(Result)))
|
|
else
|
|
Result := GetEnvironmentVariableU('COMPUTERNAME');
|
|
end;
|
|
|
|
function GetLocalComputerName: String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetLocalComputerNameU;
|
|
{$ELSE}
|
|
Result := GetLocalComputerNameA;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
{ }
|
|
{ Application Version Info }
|
|
{ }
|
|
var
|
|
VersionInfoBufA : Pointer = nil;
|
|
VerTransStrA : AnsiString;
|
|
|
|
// Returns True if VersionInfo is available
|
|
function LoadAppVersionInfoA: Boolean;
|
|
type TTransBuffer = array[1..4] of SmallInt;
|
|
PTransBuffer = ^TTransBuffer;
|
|
var InfoSize : Integer;
|
|
Size, H : LongWord;
|
|
EXEName : AnsiString;
|
|
Trans : PTransBuffer;
|
|
begin
|
|
Result := Assigned(VersionInfoBufA);
|
|
if Result then
|
|
exit;
|
|
EXEName := GetApplicationFileNameA;
|
|
InfoSize := GetFileVersionInfoSizeA(PAnsiChar(EXEName), H);
|
|
if InfoSize = 0 then
|
|
exit;
|
|
GetMem(VersionInfoBufA, InfoSize);
|
|
if not GetFileVersionInfoA(PAnsiChar(EXEName), H, InfoSize, VersionInfoBufA) then
|
|
begin
|
|
FreeMem(VersionInfoBufA);
|
|
VersionInfoBufA := nil;
|
|
exit;
|
|
end;
|
|
VerQueryValueA(VersionInfoBufA, PAnsiChar('\VarFileInfo\Translation'),
|
|
Pointer(Trans), Size);
|
|
VerTransStrA := Word32ToHexA(Trans^[1], 4, True) + Word32ToHexA(Trans^[2], 4, True);
|
|
Result := True;
|
|
end;
|
|
|
|
var
|
|
VersionInfoBufW : Pointer = nil;
|
|
VerTransStrU : UnicodeString;
|
|
|
|
// Returns True if VersionInfo is available
|
|
function LoadAppVersionInfoW: Boolean;
|
|
type
|
|
TTransBuffer = array[1..4] of SmallInt;
|
|
PTransBuffer = ^TTransBuffer;
|
|
var InfoSize : Integer;
|
|
Size, H : LongWord;
|
|
EXEName : UnicodeString;
|
|
Trans : PTransBuffer;
|
|
begin
|
|
Result := Assigned(VersionInfoBufW);
|
|
if Result then
|
|
exit;
|
|
EXEName := GetApplicationFileNameU;
|
|
InfoSize := GetFileVersionInfoSizeW(PWideChar(EXEName), H);
|
|
if InfoSize = 0 then
|
|
exit;
|
|
GetMem(VersionInfoBufW, InfoSize);
|
|
if not GetFileVersionInfoW(PWideChar(EXEName), H, InfoSize, VersionInfoBufW) then
|
|
begin
|
|
FreeMem(VersionInfoBufW);
|
|
VersionInfoBufW := nil;
|
|
exit;
|
|
end;
|
|
VerQueryValueW(VersionInfoBufW, PWideChar('\VarFileInfo\Translation'),
|
|
Pointer(Trans), Size);
|
|
VerTransStrU := Word32ToHexU(Trans^[1], 4, True) + Word32ToHexU(Trans^[2], 4, True);
|
|
Result := True;
|
|
end;
|
|
|
|
const
|
|
VersionInfoStrA: Array [TVersionInfo] of AnsiString = (
|
|
'FileVersion',
|
|
'FileDescription',
|
|
'LegalCopyright',
|
|
'Comments',
|
|
'CompanyName',
|
|
'InternalName',
|
|
'LegalTrademarks',
|
|
'OriginalFilename',
|
|
'ProductName',
|
|
'ProductVersion'
|
|
);
|
|
|
|
function GetAppVersionInfoA(const VersionInfo: TVersionInfo): AnsiString;
|
|
var S : AnsiString;
|
|
Size : LongWord;
|
|
Value : PAnsiChar;
|
|
begin
|
|
Result := '';
|
|
if not LoadAppVersionInfoA then
|
|
exit;
|
|
S := 'StringFileInfo\' + VerTransStrA + '\' + VersionInfoStrA[VersionInfo];
|
|
if VerQueryValueA(VersionInfoBufA, PAnsiChar(S), Pointer(Value), Size) then
|
|
Result := Value;
|
|
end;
|
|
|
|
const
|
|
VersionInfoStrW: array [TVersionInfo] of UnicodeString = (
|
|
'FileVersion',
|
|
'FileDescription',
|
|
'LegalCopyright',
|
|
'Comments',
|
|
'CompanyName',
|
|
'InternalName',
|
|
'LegalTrademarks',
|
|
'OriginalFilename',
|
|
'ProductName',
|
|
'ProductVersion'
|
|
);
|
|
|
|
function GetAppVersionInfoU(const VersionInfo: TVersionInfo): UnicodeString;
|
|
var S : UnicodeString;
|
|
Size : LongWord;
|
|
Value : PWideChar;
|
|
begin
|
|
Result := '';
|
|
if not LoadAppVersionInfoW then
|
|
exit;
|
|
S := 'StringFileInfo\' + VerTransStrU + '\' + VersionInfoStrW[VersionInfo];
|
|
if VerQueryValueW(VersionInfoBufW, PWideChar(S), Pointer(Value), Size) then
|
|
Result := Value;
|
|
end;
|
|
|
|
function GetAppVersionInfo(const VersionInfo: TVersionInfo): String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetAppVersionInfoU(VersionInfo);
|
|
{$ELSE}
|
|
Result := GetAppVersionInfoA(VersionInfo);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
{ }
|
|
{ Windows Processes }
|
|
{ }
|
|
{$IFDEF DELPHI7_DOWN}
|
|
type
|
|
TStartupInfoA = _STARTUPINFOA;
|
|
{$ENDIF}
|
|
|
|
const
|
|
WINEXECUTE_MAXCMDBUFLEN = 1024;
|
|
|
|
function WinExecuteA(const ExeName, Params: AnsiString; const ShowWin: Word;
|
|
const WaitTime: Integer; const DefaultPath: AnsiString): LongWord;
|
|
var LStartUpInfo : TStartupInfoA;
|
|
LProcessInfo : TProcessInformation;
|
|
Cmd : AnsiString;
|
|
CmdBuf : array[0..WINEXECUTE_MAXCMDBUFLEN + 2] of AnsiChar;
|
|
DefDir : PAnsiChar;
|
|
TimeOut : LongWord;
|
|
begin
|
|
if ExeName = '' then
|
|
raise EOSError.Create(SInvalidParameter);
|
|
if Params = '' then
|
|
Cmd := ExeName
|
|
else
|
|
Cmd := ExeName + ' ' + Params;
|
|
if PosStrA('%', Cmd) > 0 then
|
|
begin
|
|
FillChar(CmdBuf, Sizeof(CmdBuf), 0);
|
|
if ExpandEnvironmentStringsA(PAnsiChar(Cmd), @CmdBuf, WINEXECUTE_MAXCMDBUFLEN) > 0 then
|
|
Cmd := StrZPasA(PAnsiChar(@CmdBuf));
|
|
end;
|
|
FillChar(LStartUpInfo, SizeOf(LStartUpInfo), 0);
|
|
LStartUpInfo.cb := SizeOf(LStartUpInfo);
|
|
LStartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
|
|
LStartUpInfo.wShowWindow := ShowWin;
|
|
if DefaultPath = '' then
|
|
DefDir := nil
|
|
else
|
|
DefDir := PAnsiChar(DefaultPath);
|
|
FillChar(LProcessInfo, Sizeof(LProcessInfo), 0);
|
|
if not CreateProcessA(
|
|
nil, PAnsiChar(Cmd), nil, nil, False,
|
|
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, DefDir,
|
|
LStartUpInfo, LProcessInfo) then
|
|
RaiseLastWinError;
|
|
if LProcessInfo.hThread <> 0 then
|
|
CloseHandle(LProcessInfo.hThread);
|
|
if WaitTime < 0 then
|
|
TimeOut := INFINITE
|
|
else
|
|
TimeOut := WaitTime;
|
|
if WaitTime = 0 then
|
|
Result := 0
|
|
else
|
|
if Windows.WaitForSingleObject(LProcessInfo.hProcess, TimeOut) = WAIT_TIMEOUT then
|
|
begin
|
|
TerminateProcess(LProcessInfo.hProcess, 1);
|
|
CloseHandle(LProcessInfo.hProcess);
|
|
raise EOSError.Create(SProcessTimedOut)
|
|
end
|
|
else
|
|
begin
|
|
GetExitCodeProcess(LProcessInfo.hProcess, Result);
|
|
CloseHandle(LProcessInfo.hProcess);
|
|
end;
|
|
end;
|
|
|
|
function WinExecuteU(const ExeName, Params: UnicodeString; const ShowWin: Word;
|
|
const WaitTime: Integer; const DefaultPath: UnicodeString): LongWord;
|
|
var StartUpInfo : TStartupInfoW;
|
|
ProcessInfo : TProcessInformation;
|
|
Cmd : UnicodeString;
|
|
CmdBuf : array[0..WINEXECUTE_MAXCMDBUFLEN + 2] of WideChar;
|
|
DefDir : PWideChar;
|
|
TimeOut : LongWord;
|
|
begin
|
|
if ExeName = '' then
|
|
raise EOSError.Create(SInvalidParameter);
|
|
if Params = '' then
|
|
Cmd := ExeName
|
|
else
|
|
Cmd := ExeName + ' ' + Params;
|
|
if PosStrU('%', Cmd) > 0 then
|
|
begin
|
|
FillChar(CmdBuf, Sizeof(CmdBuf), 0);
|
|
if ExpandEnvironmentStringsW(PWideChar(Cmd), @CmdBuf, WINEXECUTE_MAXCMDBUFLEN) > 0 then
|
|
Cmd := StrZPasU(PWideChar(@CmdBuf));
|
|
end;
|
|
FillChar(StartUpInfo, SizeOf(StartUpInfo), 0);
|
|
StartUpInfo.cb := SizeOf(StartUpInfo);
|
|
StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
|
|
StartUpInfo.wShowWindow := ShowWin;
|
|
if DefaultPath = '' then
|
|
DefDir := nil
|
|
else
|
|
DefDir := PWideChar(DefaultPath);
|
|
FillChar(ProcessInfo, Sizeof(ProcessInfo), 0);
|
|
if not CreateProcessW(
|
|
nil, PWideChar(Cmd), nil, nil, False,
|
|
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, DefDir,
|
|
StartUpInfo, ProcessInfo) then
|
|
RaiseLastWinError;
|
|
if ProcessInfo.hThread <> 0 then
|
|
CloseHandle(ProcessInfo.hThread);
|
|
if WaitTime < 0 then
|
|
TimeOut := INFINITE
|
|
else
|
|
TimeOut := WaitTime;
|
|
if WaitTime = 0 then
|
|
Result := 0
|
|
else
|
|
if Windows.WaitForSingleObject(ProcessInfo.hProcess, TimeOut) = WAIT_TIMEOUT then
|
|
begin
|
|
TerminateProcess(ProcessInfo.hProcess, 1);
|
|
CloseHandle(ProcessInfo.hProcess);
|
|
raise EOSError.Create(SProcessTimedOut)
|
|
end
|
|
else
|
|
begin
|
|
GetExitCodeProcess(ProcessInfo.hProcess, Result);
|
|
CloseHandle(ProcessInfo.hProcess);
|
|
end;
|
|
end;
|
|
|
|
function WinExecute(const ExeName, Params: String; const ShowWin: Word;
|
|
const WaitTime: Integer; const DefaultPath: String): LongWord;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := WinExecuteU(ExeName, Params, ShowWin, WaitTime, DefaultPath);
|
|
{$ELSE}
|
|
Result := WinExecuteA(ExeName, Params, ShowWin, WaitTime, DefaultPath);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Dynamic library }
|
|
{ }
|
|
function LoadLibraryA(const LibraryName: AnsiString): TLibraryHandle;
|
|
begin
|
|
Result := TLibraryHandle(Windows.LoadLibraryA(PAnsiChar(LibraryName)));
|
|
if Result <= HINSTANCE_ERROR then
|
|
raise EOSError.Create('Failed to load library (' +
|
|
ToStringB(PathExtractFileNameB(LibraryName)) + '): ' + GetLastWinErrorMessage);
|
|
end;
|
|
|
|
function LoadLibraryU(const LibraryName: UnicodeString): TLibraryHandle;
|
|
begin
|
|
Result := TLibraryHandle(Windows.LoadLibraryW(PWideChar(LibraryName)));
|
|
if Result <= HINSTANCE_ERROR then
|
|
raise EOSError.Create('Failed to load library (' +
|
|
PathExtractFileName(LibraryName) + '): ' + GetLastWinErrorMessage);
|
|
end;
|
|
|
|
function LoadLibraryA(const LibraryName: array of AnsiString): TLibraryHandle;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Length(LibraryName);
|
|
if L = 0 then
|
|
begin
|
|
raise EOSError.Create('Failed to load library');
|
|
exit;
|
|
end;
|
|
for I := 0 to L - 1 do
|
|
begin
|
|
Result := TLibraryHandle(Windows.LoadLibraryA(PAnsiChar(LibraryName[I])));
|
|
if Result > HINSTANCE_ERROR then
|
|
exit;
|
|
end;
|
|
raise EOSError.Create('Failed to load library: ' + GetLastWinErrorMessage);
|
|
end;
|
|
|
|
function LoadLibrary(const LibraryName: String): TLibraryHandle;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := LoadLibraryU(LibraryName);
|
|
{$ELSE}
|
|
Result := LoadLibraryA(LibraryName);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function GetProcAddressA(const Handle: TLibraryHandle; const ProcName: AnsiString): Pointer;
|
|
begin
|
|
Result := Windows.GetProcAddress(Cardinal(Handle), LPCSTR(PAnsiChar(ProcName)));
|
|
end;
|
|
|
|
{$IFNDEF FREEPASCAL}
|
|
function GetProcAddressU(const Handle: TLibraryHandle; const ProcName: UnicodeString): Pointer;
|
|
begin
|
|
Result := Windows.GetProcAddress(Cardinal(Handle), LPCWSTR(PWideChar(ProcName)));
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function GetProcAddress(const Handle: TLibraryHandle; const ProcName: String): Pointer;
|
|
begin
|
|
{$IFDEF FREEPASCAL}
|
|
Result := GetProcAddressA(Handle, ProcName);
|
|
{$ELSE}
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetProcAddressU(Handle, ProcName);
|
|
{$ELSE}
|
|
Result := GetProcAddressA(Handle, ProcName);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure FreeLibrary(const Handle: TLibraryHandle);
|
|
begin
|
|
Windows.FreeLibrary(Cardinal(Handle));
|
|
end;
|
|
|
|
{ TDynamicLibrary }
|
|
constructor TDynamicLibrary.CreateA(const LibraryName: AnsiString);
|
|
begin
|
|
inherited Create;
|
|
FHandle := LoadLibraryA(LibraryName);
|
|
Assert(FHandle <> 0);
|
|
end;
|
|
|
|
constructor TDynamicLibrary.CreateA(const LibraryName: array of AnsiString);
|
|
begin
|
|
inherited Create;
|
|
FHandle := LoadLibraryA(LibraryName);
|
|
Assert(FHandle <> 0);
|
|
end;
|
|
|
|
constructor TDynamicLibrary.CreateU(const LibraryName: UnicodeString);
|
|
begin
|
|
inherited Create;
|
|
FHandle := LoadLibraryU(LibraryName);
|
|
Assert(FHandle <> 0);
|
|
end;
|
|
|
|
destructor TDynamicLibrary.Destroy;
|
|
begin
|
|
if FHandle <> 0 then
|
|
begin
|
|
FreeLibrary(FHandle);
|
|
FHandle := 0;
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TDynamicLibrary.GetProcAddressA(const ProcName: AnsiString): Pointer;
|
|
begin
|
|
Assert(FHandle <> 0);
|
|
Result := flcWinUtils.GetProcAddressA(FHandle, ProcName);
|
|
end;
|
|
|
|
function TDynamicLibrary.GetProcAddressU(const ProcName: UnicodeString): Pointer;
|
|
begin
|
|
Assert(FHandle <> 0);
|
|
{$IFDEF FREEPASCAL}
|
|
Result := flcWinUtils.GetProcAddressA(FHandle, ProcName);
|
|
{$ELSE}
|
|
Result := flcWinUtils.GetProcAddressU(FHandle, ProcName);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Exit Windows }
|
|
{ }
|
|
function ExitWindows(const ExitType: TExitWindowsType; const Force: Boolean): Boolean;
|
|
const SE_SHUTDOWN_NAME = 'SeShutDownPrivilege';
|
|
ExitTypeFlags : array[TExitWindowsType] of Cardinal =
|
|
(EWX_LOGOFF, EWX_POWEROFF, EWX_REBOOT, EWX_SHUTDOWN);
|
|
var hToken : THandle;
|
|
tkp : TTokenPrivileges;
|
|
retval : Cardinal;
|
|
uFlags : Cardinal;
|
|
begin
|
|
if IsWinPlatformNT then
|
|
if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
|
|
begin
|
|
LookupPrivilegeValue(nil, SE_SHUTDOWN_NAME, tkp.Privileges[0].Luid);
|
|
tkp.PrivilegeCount := 1;
|
|
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
|
|
AdjustTokenPrivileges(hToken, false, tkp, 0, tkp, retval);
|
|
end;
|
|
uFlags := ExitTypeFlags[ExitType];
|
|
if Force then
|
|
uFlags := uFlags or EWX_FORCE;
|
|
Result := Windows.ExitWindowsEx(uFlags, 0);
|
|
end;
|
|
|
|
function LogOff(const Force: Boolean = False): Boolean;
|
|
begin
|
|
Result := ExitWindows(exitLogOff, Force);
|
|
end;
|
|
|
|
function PowerOff(const Force: Boolean = False): Boolean;
|
|
begin
|
|
Result := ExitWindows(exitPowerOff, Force);
|
|
end;
|
|
|
|
function Reboot(const Force: Boolean): Boolean;
|
|
begin
|
|
Result := ExitWindows(exitReboot, Force);
|
|
end;
|
|
|
|
function ShutDown(const Force: Boolean = False): Boolean;
|
|
begin
|
|
Result := ExitWindows(exitShutDown, Force);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Locale information }
|
|
{ }
|
|
const
|
|
LOCALE_MAXSIZE = 1024;
|
|
|
|
function GetLocaleStringA(const LocaleType: LongWord): AnsiString;
|
|
var Buf : array[0..LOCALE_MAXSIZE] of AnsiChar;
|
|
begin
|
|
FillChar(Buf[0], SizeOf(Buf), 0);
|
|
if GetLocaleInfoA(LOCALE_USER_DEFAULT, LocaleType, @Buf[0], LOCALE_MAXSIZE) <> 0 then
|
|
Result := StrZPasA(PAnsiChar(@Buf[0]))
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function GetLocaleStringU(const LocaleType: LongWord): UnicodeString;
|
|
var Buf : array[0..LOCALE_MAXSIZE] of WideChar;
|
|
begin
|
|
FillChar(Buf[0], SizeOf(Buf), 0);
|
|
if GetLocaleInfoW(LOCALE_USER_DEFAULT, LocaleType, @Buf[0], LOCALE_MAXSIZE) <> 0 then
|
|
Result := StrZPasU(PWideChar(@Buf[0]))
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function GetCountryCode1A: AnsiString;
|
|
begin
|
|
Result := GetLocaleStringA(LOCALE_ICOUNTRY);
|
|
end;
|
|
|
|
function GetCountryCode1U: UnicodeString;
|
|
begin
|
|
Result := GetLocaleStringU(LOCALE_ICOUNTRY);
|
|
end;
|
|
|
|
function GetCountryCode1: String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetCountryCode1U;
|
|
{$ELSE}
|
|
Result := GetCountryCode1A;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function GetCountryCode2A: AnsiString;
|
|
begin
|
|
Result := GetLocaleStringA(LOCALE_SISO3166CTRYNAME);
|
|
end;
|
|
|
|
function GetCountryCode2U: UnicodeString;
|
|
begin
|
|
Result := GetLocaleStringU(LOCALE_SISO3166CTRYNAME);
|
|
end;
|
|
|
|
function GetCountryCode2: String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetCountryCode2U;
|
|
{$ELSE}
|
|
Result := GetCountryCode2A;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function GetCountryNameA: AnsiString;
|
|
begin
|
|
Result := GetLocaleStringA(LOCALE_SENGCOUNTRY);
|
|
end;
|
|
|
|
function GetCountryNameU: UnicodeString;
|
|
begin
|
|
Result := GetLocaleStringU(LOCALE_SENGCOUNTRY);
|
|
end;
|
|
|
|
function GetCountryName: String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetCountryNameU;
|
|
{$ELSE}
|
|
Result := GetCountryNameA;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Miscelleaneous Windows API }
|
|
{ }
|
|
function ContentTypeFromExtentionA(const Extention: AnsiString): AnsiString;
|
|
begin
|
|
Result := GetRegistryStringA(HKEY_CLASSES_ROOT, Extention, 'Content Type');
|
|
end;
|
|
|
|
function ContentTypeFromExtentionU(const Extention: UnicodeString): UnicodeString;
|
|
begin
|
|
Result := GetRegistryStringU(HKEY_CLASSES_ROOT, Extention, 'Content Type');
|
|
end;
|
|
|
|
function ContentTypeFromExtention(const Extention: String): String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := ContentTypeFromExtentionU(Extention);
|
|
{$ELSE}
|
|
Result := ContentTypeFromExtentionA(Extention);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function FileClassFromExtentionA(const Extention: AnsiString): AnsiString;
|
|
begin
|
|
Result := GetRegistryStringA(HKEY_CLASSES_ROOT, Extention, '');
|
|
end;
|
|
|
|
function GetFileClassA(const FileName: AnsiString): AnsiString;
|
|
begin
|
|
Result := FileClassFromExtentionA(PathExtractFileExtB(FileName));
|
|
end;
|
|
|
|
function GetFileAssociationA(const FileName: AnsiString): AnsiString;
|
|
var S : AnsiString;
|
|
begin
|
|
S := FileClassFromExtentionA(PathExtractFileExtB(FileName));
|
|
if S = '' then
|
|
Result := ''
|
|
else
|
|
Result := GetRegistryStringA(HKEY_CLASSES_ROOT, S + '\Shell\Open\Command', '');
|
|
end;
|
|
|
|
const
|
|
AutoRunRegistryKey = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Run';
|
|
|
|
function IsApplicationAutoRunA(const Name: AnsiString): Boolean;
|
|
var S : AnsiString;
|
|
begin
|
|
S := GetApplicationFileNameA;
|
|
Result := (S <> '') and (Name <> '') and
|
|
StrEqualNoAsciiCaseA(GetRegistryStringA(HKEY_LOCAL_MACHINE, AutoRunRegistryKey, Name), S);
|
|
end;
|
|
|
|
procedure SetApplicationAutoRunA(const Name: AnsiString; const AutoRun: Boolean);
|
|
begin
|
|
if Name = '' then
|
|
exit;
|
|
if AutoRun then
|
|
SetRegistryStringA(HKEY_LOCAL_MACHINE, AnsiString(AutoRunRegistryKey), Name, GetApplicationFileNameA)
|
|
else
|
|
DeleteRegistryValueA(HKEY_LOCAL_MACHINE, AutoRunRegistryKey, Name);
|
|
end;
|
|
|
|
function GetKeyPressed(const VKeyCode: Integer): Boolean;
|
|
begin
|
|
Result := GetKeyState(VKeyCode) and $80 <> 0;
|
|
end;
|
|
|
|
function GetHardDiskSerialNumberA(const DriveLetter: AnsiChar): AnsiString;
|
|
var N, F, S : DWORD;
|
|
T : AnsiString;
|
|
begin
|
|
S := 0;
|
|
T := DriveLetter + AnsiString(':\');
|
|
GetVolumeInformationA(PAnsiChar(T), nil, MAX_PATH + 1, @S,
|
|
N, F, nil, 0);
|
|
Result := Word32ToHexA(S, 8, False);
|
|
end;
|
|
|
|
function GetHardDiskSerialNumberU(const DriveLetter: WideChar): UnicodeString;
|
|
var N, F, S : DWORD;
|
|
T : UnicodeString;
|
|
begin
|
|
S := 0;
|
|
T := DriveLetter + UnicodeString(':\');
|
|
GetVolumeInformationW(PWideChar(T), nil, MAX_PATH + 1, @S,
|
|
N, F, nil, 0);
|
|
Result := Word32ToHexU(S, 8, False);
|
|
end;
|
|
|
|
function GetHardDiskSerialNumber(const DriveLetter: Char): String;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetHardDiskSerialNumberU(DriveLetter);
|
|
{$ELSE}
|
|
Result := GetHardDiskSerialNumberA(DriveLetter);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
{ }
|
|
{ Windows Fibers }
|
|
{ }
|
|
function ConvertThreadToFiber; external kernel32 name 'ConvertThreadToFiber';
|
|
function CreateFiber(dwStackSize: DWORD; lpStartAddress: TFNFiberStartRoutine;
|
|
lpParameter: Pointer): Pointer; external kernel32 name 'CreateFiber';
|
|
|
|
|
|
|
|
{ }
|
|
{ Windows Shell }
|
|
{ }
|
|
const
|
|
shell32 = 'shell32.dll';
|
|
|
|
function ShellExecuteA; external shell32 name 'ShellExecuteA';
|
|
|
|
procedure ShellLaunch(const S: AnsiString);
|
|
begin
|
|
ShellExecuteA(0, 'open', PAnsiChar(S), '', '', SW_SHOWNORMAL);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ WinSpool API }
|
|
{ }
|
|
const
|
|
winspl = 'winspool.drv';
|
|
|
|
function EnumPortsA; external winspl name 'EnumPortsA';
|
|
|
|
type
|
|
PPortInfo1A = ^TPortInfo1A;
|
|
PPortInfo1 = PPortInfo1A;
|
|
_PORT_INFO_1A = record
|
|
pName: PAnsiChar;
|
|
end;
|
|
TPortInfo1A = _PORT_INFO_1A;
|
|
TPortInfo1 = TPortInfo1A;
|
|
|
|
function GetWinPortNamesA: AnsiStringArray;
|
|
var BytesNeeded, N, I : LongWord;
|
|
Buf : Pointer;
|
|
InfoPtr : PPortInfo1;
|
|
TempStr : AnsiString;
|
|
begin
|
|
Result := nil;
|
|
if EnumPortsA(nil, 1, nil, 0, BytesNeeded, N) then
|
|
exit;
|
|
if GetLastWinError <> ERROR_INSUFFICIENT_BUFFER then
|
|
RaiseLastWinError;
|
|
GetMem(Buf, BytesNeeded);
|
|
try
|
|
if not EnumPortsA(nil, 1, Buf, BytesNeeded, BytesNeeded, N) then
|
|
RaiseLastWinError;
|
|
For I := 0 to N - 1 do
|
|
begin
|
|
InfoPtr := PPortInfo1(LongWord(Buf) + I * SizeOf(TPortInfo1));
|
|
TempStr := InfoPtr^.pName;
|
|
DynArrayAppendA(Result, TempStr);
|
|
end;
|
|
finally
|
|
FreeMem(Buf);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Timers }
|
|
{ }
|
|
function GetMsCount: LongWord;
|
|
begin
|
|
Result := GetTickCount;
|
|
end;
|
|
|
|
function GetUsCount: Int64;
|
|
var F : Int64;
|
|
begin
|
|
QueryPerformanceCounter(Result);
|
|
if not QueryPerformanceFrequency(F) then
|
|
Result := 0
|
|
else
|
|
Result := Result div (F div 1000000);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Tests }
|
|
{ }
|
|
{$IFDEF DEBUG}
|
|
{$IFDEF TEST}
|
|
{$ASSERTIONS ON}
|
|
{$WARNINGS OFF}
|
|
|
|
{$DEFINE TEST_APPVERSIONINFO}
|
|
{$DEFINE TEST_DRIVEC_VALID}
|
|
|
|
procedure Test;
|
|
var
|
|
A : AnsiStringArray;
|
|
B : UnicodeStringArray;
|
|
I : Integer;
|
|
begin
|
|
Assert(Length(WinErrorMessageA(2)) > 5);
|
|
Assert(Length(WinErrorMessageU(2)) > 5);
|
|
Assert(Length(WinErrorMessage(2)) > 5);
|
|
Assert(WinErrorMessageU(2) = WinErrorMessageA(2));
|
|
|
|
Assert(GetEnvironmentVariableA('PATH') <> '', 'GetEnvironmentVariable');
|
|
Assert(GetEnvironmentVariableU('PATH') <> '', 'GetEnvironmentVariable');
|
|
Assert(GetEnvironmentVariable('PATH') <> '', 'GetEnvironmentVariable');
|
|
Assert(GetEnvironmentVariableU('PATH') = GetEnvironmentVariableA('PATH'));
|
|
|
|
A := GetEnvironmentStringsA;
|
|
B := GetEnvironmentStringsU;
|
|
Assert(Length(A) > 0);
|
|
Assert(Length(B) > 0);
|
|
Assert(Length(A) = Length(B));
|
|
for I := 0 to Length(A) - 1 do
|
|
Assert(A[I] = B[I]);
|
|
|
|
Assert(GetWindowsVersionString <> '', 'GetWindowsVersionString');
|
|
|
|
Assert(GetWindowsProductNameA <> '', 'GetWindowsProductName');
|
|
Assert(GetWindowsProductNameU <> '', 'GetWindowsProductName');
|
|
Assert(GetWindowsProductNameA = GetWindowsProductNameU);
|
|
|
|
{$IFNDEF WIN32}
|
|
// Win32 returns empty string
|
|
Assert(GetWindowsProductIDA <> '', 'GetWindowsProductID');
|
|
Assert(GetWindowsProductIDU <> '', 'GetWindowsProductID');
|
|
Assert(GetWindowsProductIDA = GetWindowsProductIDU);
|
|
{$ENDIF}
|
|
|
|
Assert(GetUserNameA <> '', 'GetUserName');
|
|
Assert(GetUserNameU <> '', 'GetUserName');
|
|
Assert(GetUserName <> '', 'GetUserName');
|
|
Assert(GetUserNameA = GetUserNameU, 'GetUserName');
|
|
|
|
Assert(GetWindowsTemporaryPathA <> '', 'GetWindowsTemporaryPath');
|
|
Assert(GetWindowsTemporaryPathU <> '', 'GetWindowsTemporaryPath');
|
|
Assert(GetWindowsTemporaryPathU = GetWindowsTemporaryPathA);
|
|
|
|
Assert(GetWindowsPathA <> '', 'GetWindowsPath');
|
|
Assert(GetWindowsPathU <> '', 'GetWindowsPath');
|
|
Assert(GetWindowsPathA = GetWindowsPathU, 'GetWindowsPath');
|
|
|
|
Assert(GetWindowsSystemPathA <> '', 'GetWindowsSystemPath');
|
|
Assert(GetWindowsSystemPathU <> '', 'GetWindowsSystemPath');
|
|
Assert(GetWindowsSystemPathA = GetWindowsSystemPathU);
|
|
|
|
Assert(GetProgramFilesPathA <> '', 'GetProgramFilesPath');
|
|
Assert(GetProgramFilesPathU <> '', 'GetProgramFilesPath');
|
|
Assert(GetProgramFilesPathU = GetProgramFilesPathA);
|
|
|
|
Assert(GetCommonFilesPathA <> '', 'GetCommonFilesPath');
|
|
Assert(GetCommonFilesPathU <> '', 'GetCommonFilesPath');
|
|
Assert(GetCommonFilesPathU = GetCommonFilesPathA);
|
|
|
|
Assert(GetApplicationPath <> '', 'GetApplicationPath');
|
|
|
|
Assert(GetHomePathA <> '', 'GetHomePath');
|
|
Assert(GetHomePathU <> '', 'GetHomePath');
|
|
Assert(GetHomePathA = GetHomePathU, 'GetHomePath');
|
|
|
|
Assert(GetCountryCode1A <> '', 'GetCountryCode1');
|
|
Assert(GetCountryCode1U <> '', 'GetCountryCode1');
|
|
Assert(GetCountryCode1A = GetCountryCode1U);
|
|
|
|
Assert(GetCountryCode2A <> '', 'GetCountryCode2');
|
|
Assert(GetCountryCode2U <> '', 'GetCountryCode2');
|
|
|
|
Assert(GetCountryNameA <> '', 'GetCountryName');
|
|
Assert(GetCountryNameU <> '', 'GetCountryName');
|
|
|
|
{$IFDEF TEST_APPVERSIONINFO}
|
|
Assert(GetAppVersionInfoA(viFileVersion) <> '');
|
|
Assert(GetAppVersionInfoU(viFileVersion) <> '');
|
|
Assert(GetAppVersionInfoA(viFileVersion) = GetAppVersionInfoU(viFileVersion));
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TEST_DRIVEC_VALID}
|
|
Assert(GetHardDiskSerialNumberA('C') <> '');
|
|
Assert(GetHardDiskSerialNumberU('C') = GetHardDiskSerialNumberA('C'));
|
|
{$ENDIF}
|
|
|
|
Assert(ContentTypeFromExtentionA('.html') <> '');
|
|
Assert(ContentTypeFromExtentionU('.html') <> '');
|
|
Assert(ContentTypeFromExtentionA('.html') = ContentTypeFromExtentionU('.html'));
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
|
|
initialization
|
|
finalization
|
|
if Assigned(VersionInfoBufA) then
|
|
FreeMem(VersionInfoBufA);
|
|
if Assigned(VersionInfoBufW) then
|
|
FreeMem(VersionInfoBufW);
|
|
end.
|
|
|