公共函数单元

最新推荐文章于 2024-09-18 17:39:25 发布

h98458

最新推荐文章于 2024-09-18 17:39:25 发布

阅读量1.2k

点赞数

分类专栏： Delphi 文章标签： string function integer file exception path

Delphi 专栏收录该内容

5 篇文章

订阅专栏

{
This unit was generated on Sun, 10 Dec 2006 09:45:52 +0000
by the code snippets database at www.delphidabbler.com.
Check the site for updates.

The unit is freeware and may be freely distributed providing
only that this comment is left in the code.
}

unit DDSnippets;

interface

uses
Windows, SysUtils, ShellAPI, Classes, IniFiles, Graphics, UrlMon, Nb30,
ShlObj, ActiveX, Registry;

function DateTimeToWinFileTime(DT: TDateTime): Windows.TFileTime;
{Converts Delphi TDateTime to Windows FILETIME. Raises exception if date time
is not valid or can't be converted.}

function GMTToLocalTime(GMTTime: TDateTime): TDateTime;
{Converts Delphi TDateTime in GMT local time. Raises exception if date time is
not valid or can't be converted.}

function WinFileTimeToDateTime(FT: Windows.TFileTime): TDateTime;
{Converts Windows FILETIME to Delphi TDateTime. Raises exception if file time
is valid or can't be converted.}

function WinFileTimeToDOSFileTime(FT: Windows.TFileTime): Integer;
{Converts a Windows FILETIME to a DOS file time. Raises exception if file time
is not a valid value.}

function WinFileTimeToStr(FT: Windows.TFileTime): string;
{Converts a Windows FILETIME structure to a string. Raises exception if file
time is not a valid value.}

function DriveDisplayName(const Drive: string): string;
{Returns the display name for the drive with the given root path.}

procedure DriveDisplayNames(const List: Classes.TStrings);
{Gets list of display names for all the system's drives and stores in a given
string list.}

function DriveRootPath(const DriveNum: Byte): string;
{Returns root drive path for drive with given number.}

function DriveTypeFromPath(const Path: string): Integer;
{Returns type of drive that contains the given (full) path.}

function HardDiskSerial(const Drive: string): Windows.DWORD;
{Returns the serial number of the hard disk with the given root path or 0 if
the disk is not a hard drive or has no serial number.}

function IsValidDrive(const Drive: string): Boolean;
{Returns true if the given drive path represents a valid drive and false
otherwise.}

function IsValidDriveNum(const DriveNum: Byte): Boolean;
{Returns true if the drive specified by the given number is valid and false
otherwise.}

procedure ListDrives(const List: Classes.TStrings);
{Gets list of the system's drive root paths and stores in a given string list}

function FileToString(const FileName: string): string;
{Stores content of a file in an ANSI string.}

function IsUnicodeFile(const FileName: string): Boolean;
{Checks if a file contains unicode text and returns true if so and false if
not.}

function IsUnicodeStream(const Stm: Classes.TStream): Boolean;
{Checks if a stream contains unicode text at the current position. Returns
true if stream contains unicode and false otherwise.}

function StreamToString(const Stm: Classes.TStream): string;
{Reads content of a stream into an ansi string. Stream is read from current
positions.}

procedure StringToFile(const Str, FileName: string);
{Writes an ansi string to a text file.}

procedure StringToStream(const Str: string; const Stm: Classes.TStream);
{Writes an ansi string into a stream. The string is written at the current
stream position.}

procedure WideStringToUnicodeFile(const Str: WideString;
const FileName: string);
{Writes a wide string to a unicode text file. The text file begins with a
marker to indicate it is unicode.}

procedure CopyFile(const Source, Dest: string);
{Copies Source file to Dest, preserving modification date.}

function DeleteFileWithUndo(const FileName: string): Boolean;
{Deletes given file and sends it to recycle bin. Returns true if file deleted
successfully.}

function DirToPath(const Dir: string): string;
{Returns the given directory with a trailing backslash. If the directory
already ends in backslash it is returned unchanged.}

function DOSToUnixPath(const PathName: string): string;
{Converts a DOS path to a Unix path and returns it.}

procedure EnsureFolders(Path: string);
{Ensures that the given folder and all folders on its path exist, and creates
them if they do not. Uses recursion.}

function GetFileDate(const FName: string): Integer;
{Returns modification date of given file encoded as integer.}

function HasVerInfo(const FileName: string): Boolean;
{Returns true if the given file contains version information and false if
not.}

function IsURLShortcut(const ShortcutFile: string): Boolean;
{Returns true if the given file is a URL shortcut file and false if not.}

function LongToShortFilePath(const LongName: string): string;
{Converts the given long file name to the equivalent shortened DOS style 8.3
path.}

function PathToDir(const Path: string): string;
{Returns the given directory with any single trailing backslash removed. If
the directory does not end in a backslash it is returned unchanged.}

procedure SetFileDate(const FName: string; const ADate: Integer);
{Sets modification date of given file to given integer coded value.}

function ShortToLongFilePath(const FilePath: string): string;
{Converts whole of given DOS style 8.3 path to long file path and returns it.
If path can't be converted then '' is returned.}

function Touch(const FileName: string): Boolean;
{Sets modification date of given file to current date and time. Returns true
if date set successfully or false on error.}

function URLFromShortcut(const Shortcut: string): string;
{Returns the URL referenced by the given URL shortcut file, or the empty
string if the given file is not a shortcut file.}

function ColorToRGBTriple(const C: Graphics.TColor): Windows.TRGBTriple;
{Converts a Delphi TColor value into an RGB triple value.}

function RGBTripleToColor(const C: Windows.TRGBTriple): Graphics.TColor;
{Converts an RGB triple value into a Delphi TColor value.}

function IsValidURLProtocol(const URL: string): Boolean;
{Checks if the given URL is valid per RFC1738. Returns true is valid and false
if not.}

function MakeSafeHTMLText(TheText: string): string;
{Replaces any characters in the given text that are HTML-compatible with
suitable escaped versions and returns modified string.}

function URLDecode(const S: string): string;
{Decodes the given encoded URL or URL query string. Raises exception if the
encoded URL is badly formed.}

function CountDelims(const S, Delims: string): Integer;
{Returns count of all occurences of any of the given delimiter characters in
the string S.}

function IsHexStr(const S: string): Boolean;
{Returns true if string S contains only valid hex digits, false otherwise.}

function GetMacAddress: string;
{Returns MAC address of first ethernet adapter on computer.}

procedure AddToRecentDocs(const FileName: string);
{Adds given file to Recent Documents folder that appears on the Start menu.}

procedure ClearRecentDocs;
{Clears the Recent Documents folder so that no recent documents appear on
Start menu.}

function EmptyRecycleBin: Boolean;
{Empties the recycle bin. Returns returns true if bin is emptied and false if
the function fails.}

function ExecAssociatedApp(const FileName: string): Boolean;
{Executes the application associated with the given file name. Returns true if
application is started successfully and false if not.}

function ExploreFile(const Filename: string): Boolean;
{Starts Windows Explorer to explore given file. Returns true if file is valid
and can be explored, or false otherwise.}

function ExploreFolder(const Folder: string): Boolean;
{Starts Windows Explorer to explore given folder. Returns true if folder is
valid and can be explored, or false otherwise.}

procedure FreePIDL(PIDL: ShlObj.PItemIDList);
{Uses to shell allocator to free the memory used by a given PIDL.}

function IsShellLink(const LinkFileName: string): Boolean;
{Checks if the given file is a shell link.}

function IsSpecialFolderSupported(CSIDL: Integer): Boolean;
{Returns true if the given special folder specified by a CSIDL is supported on
the system and false if not.}

function OpenFolder(const Folder: string): Boolean;
{Opens given folder in Windows Explorer. Returns true if folder is valid and
can be opened, or false otherwise.}

function PIDLToFolderPath(PIDL: ShlObj.PItemIDList): string;
{Returns the full path to a file system folder from a PIDL or '' if the PIDL
refers to a virtual folder.}

function TaskbarHandle: Windows.THandle;
{Returns the window handle of the Windows task bar.}

function CommonFilesFolder: string;
{Returns directory used for common files.}

function GetCurrentVersionRegStr(const ValName: string): string;
{Gets given string value from given subkey of Windows current version registry
key.}

function IsIntResource(const ResID: PChar): Boolean;
{Returns true if the given resource ID is integer value or false if the ID is
a pointer to a zero terminated string.}

function IsMediaCenterOS: Boolean;
{Returns true if the operating system is a Windows Media Center edition or
false if not.}

function IsTabletOS: Boolean;
{Returns true if the operating system is a Windows Tablet edition or false if
not.}

function IsWin9x: Boolean;
{Returns true if the operating system is on the Windows 9x platform (including
Windows 95, 98 and Me) and false if not.}

function IsWinNT: Boolean;
{Returns true if the operating system is Windows NT (including 2000 and XP)
and false if not.}

function IsWow64: Boolean;
{Returns true if the current process is executing as a 32 bit process under
WOW64 on 64 bit Windows.}

function ProgramFilesFolder: string;
{Returns directory used for program files.}

function SystemFolder: string;
{Returns path to Windows system folder.}

function TempFolder: string;
{Returns path to Windows temporary folder.}

function WindowsFolder: string;
{Returns path to Windows folder.}

function WindowsProductID: string;
{Returns the Windows product ID.}

implementation

{ Implementation of public and private routines }

function DateTimeToWinFileTime(DT: TDateTime): Windows.TFileTime;
{Converts Delphi TDateTime to Windows FILETIME. Raises exception if date time
is not valid or can't be converted.}
var
ST: Windows.TSystemTime;
begin
SysUtils.DateTimeToSystemTime(DT, ST);
SysUtils.Win32Check(Windows.SystemTimeToFileTime(ST, Result));
end;

function GMTToLocalTime(GMTTime: TDateTime): TDateTime;
{Converts Delphi TDateTime in GMT local time. Raises exception if date time is
not valid or can't be converted.}
var
GMTST: Windows.TSystemTime;
LocalST: Windows.TSystemTime;
begin
SysUtils.DateTimeToSystemTime(GMTTime, GMTST);
SysUtils.Win32Check(
    Windows.SystemTimeToTzSpecificLocalTime(
    nil, GMTST, LocalST
    )
    );
Result := SysUtils.SystemTimeToDateTime(LocalST);
end;

function WinFileTimeToDateTime(FT: Windows.TFileTime): TDateTime;
{Converts Windows FILETIME to Delphi TDateTime. Raises exception if file time
is valid or can't be converted.}
var
SysTime: Windows.TSystemTime; // stores date/time in system time format
begin
// Convert file time to system time, raising exception on error
SysUtils.Win32Check(Windows.FileTimeToSystemTime(FT, SysTime));
// Convert system time to Delphi date time, raising excpetion on error
Result := SysUtils.SystemTimeToDateTime(SysTime);
end;

function WinFileTimeToDOSFileTime(FT: Windows.TFileTime): Integer;
{Converts a Windows FILETIME to a DOS file time. Raises exception if file time
is not a valid value.}
begin
SysUtils.Win32Check(
    Windows.FileTimeToDosDateTime(
    FT, SysUtils.LongRec(Result).Hi, SysUtils.LongRec(Result).Lo
    )
    );
end;

function WinFileTimeToStr(FT: Windows.TFileTime): string;
{Converts a Windows FILETIME structure to a string. Raises exception if file
time is not a valid value.}
begin
Result := SysUtils.DateTimeToStr(WinFileTimeToDateTime(FT));
end;

function DriveDisplayName(const Drive: string): string;
{Returns the display name for the drive with the given root path.}
var
FI: ShellAPI.TSHFileInfo;             // info about drive
begin
if ShellAPI.SHGetFileInfo(
    PChar(Drive),
    0,
    FI,
    SizeOf(FI),
    ShellAPI.SHGFI_DISPLAYNAME
    ) = 0 then
    SysUtils.RaiseLastWin32Error;
Result := FI.szDisplayName;
end;

procedure DriveDisplayNames(const List: Classes.TStrings);
{Gets list of display names for all the system's drives and stores in a given
string list.}
var
Drives: Classes.TStringList;          // list of drives
Idx: Integer;                         // loops thru drives
begin
// Get list of drives
Drives := Classes.TStringList.Create;
try
    ListDrives(Drives);
    // Loop thru drive list getting drive info
    for Idx := 0 to Pred(Drives.Count) do
      List.Add(DriveDisplayName(Drives[Idx]));
finally
    Drives.Free;
end;
end;

function DriveRootPath(const DriveNum: Byte): string;
{Returns root drive path for drive with given number.}
begin
if DriveNum in [0..25] then
Result := Char(DriveNum + Ord('A')) + ':/'
else
Result := '';
end;

function DriveTypeFromPath(const Path: string): Integer;
{Returns type of drive that contains the given (full) path.}
var
Drive: string; // the drive name
begin
Drive := SysUtils.ExtractFileDrive(Path) + '/';
Result := Integer(Windows.GetDriveType(PChar(Drive)));
end;

function HardDiskSerial(const Drive: string): Windows.DWORD;
{Returns the serial number of the hard disk with the given root path or 0 if
the disk is not a hard drive or has no serial number.}
var
Unused: Windows.DWORD;                // unused parameters
PrevErrorMode: Windows.UINT;          // stores Windows error mode
begin
// Inhibit system dialog appearing on error
PrevErrorMode := Windows.SetErrorMode(
    Windows.SEM_FAILCRITICALERRORS
    );
try
    Result := 0;
    Windows.GetVolumeInformation(
      PChar(Drive), nil, 0, @Result, Unused, Unused, nil, 0
      );
finally
    // Restore old error mode
    Windows.SetErrorMode(PrevErrorMode);
end;
end;

function IsValidDrive(const Drive: string): Boolean;
{Returns true if the given drive path represents a valid drive and false
otherwise.}
begin
Result := DriveTypeFromPath(Drive) <> 1;
end;

function IsValidDriveNum(const DriveNum: Byte): Boolean;
{Returns true if the drive specified by the given number is valid and false
otherwise.}
begin
if DriveNum in [0..25] then
Result := Windows.GetLogicalDrives and (1 shl DriveNum) <> 0
else
Result := False;
end;

procedure ListDrives(const List: Classes.TStrings);
{Gets list of the system's drive root paths and stores in a given string list}
var
Drives: PChar;                        // buffer for list of drives
BufSize: Integer;                     // size of drive buffer
begin
// Get buffer size and allocate it
BufSize := Windows.GetLogicalDriveStrings(0, nil);
GetMem(Drives, BufSize);
try
    // Get #0 delimited drives list and convert to string list
    if Windows.GetLogicalDriveStrings(BufSize, Drives) = 0 then
      SysUtils.RaiseLastWin32Error;
    MultiSzToStrings(Drives, List);
finally
    FreeMem(Drives);
end;
end;

function FileToString(const FileName: string): string;
{Stores content of a file in an ANSI string.}
var
FS: Classes.TFileStream;              // stream used to read file
begin
// Open stream to file and copy stream to string
FS := Classes.TFileStream.Create(
    FileName, SysUtils.fmOpenRead or SysUtils.fmShareDenyNone
    );
try
    Result := StreamToString(FS);
finally
    FS.Free;
end;
end;

function IsUnicodeFile(const FileName: string): Boolean;
{Checks if a file contains unicode text and returns true if so and false if
not.}
var
FS: Classes.TFileStream;              // stream onto file being tested
begin
// Open stream to file and examine stream for unicode marker
FS := Classes.TFileStream.Create(
    FileName, SysUtils.fmOpenRead or SysUtils.fmShareDenyNone
    );
try
    Result := IsUnicodeStream(FS);
finally
    FS.Free;
end;
end;

function IsUnicodeStream(const Stm: Classes.TStream): Boolean;
{Checks if a stream contains unicode text at the current position. Returns
true if stream contains unicode and false otherwise.}
var
StmPos: LongInt;                      // current position in stream
UnicodeMarker: Word;                  // marker that indicates a unicode stream
begin
// Record current location in stream
StmPos := Stm.Position;
// Check if stream large enough to contain unicode marker
if StmPos <= Stm.Size - SizeOf(Word) then
begin
    // Read first word and check if it is the unicode marker
    Stm.ReadBuffer(UnicodeMarker, SizeOf(UnicodeMarker));
    Result := (UnicodeMarker = $FEFF);
    // Restore stream positions
    Stm.Position := StmPos;
end
else
    // Stream too small: can't be unicode
    Result := False;
end;

function StreamToString(const Stm: Classes.TStream): string;
{Reads content of a stream into an ansi string. Stream is read from current
positions.}
var
SS: Classes.TStringStream;            // used to copy stream to string
begin
SS := Classes.TStringStream.Create('');
try
    // Copy given stream to string stream and return value
    SS.CopyFrom(Stm, 0);
    Result := SS.DataString;
finally
    SS.Free;
end;
end;

procedure StringToFile(const Str, FileName: string);
{Writes an ansi string to a text file.}
var
FS: Classes.TFileStream;              // stream used to write file
begin
// Create stream onto file and write to it
FS := Classes.TFileStream.Create(FileName, Classes.fmCreate);
try
    StringToStream(Str, FS);
finally
    FS.Free;
end;
end;

procedure StringToStream(const Str: string; const Stm: Classes.TStream);
{Writes an ansi string into a stream. The string is written at the current
stream position.}
var
SS: Classes.TStringStream;            // used to copy string to stream
begin
// Create stream onto string and copy it to given stream
SS := Classes.TStringStream.Create(Str);
try
    Stm.CopyFrom(SS, Length(Str));
finally
    SS.Free;
end;
end;

function UnicodeFileToWideString(const FileName: string): WideString;
{Reads a file into a wide string an returns it. The routine can handle unicode
files or ansi text files. Ansi files are converted to wide strings.}
var
FS: Classes.TFileStream;              // Stream used to read file
begin
// Open stream onto file and read unicode from it
FS := Classes.TFileStream.Create(
    FileName, SysUtils.fmOpenRead or SysUtils.fmShareDenyNone);
try
    Result := UnicodeStreamToWideString(FS);
finally
    FS.Free;
end;
end;

function UnicodeStreamToWideString(const Stm: Classes.TStream): WideString;
{Reads from a stream into a wide string an returns the string. The routine can
handle unicode or ansi content on the stream. If the text is unicode the word
at the current stream position must be a unicode marker word. Ansi files are
converted to wide strings.}
var
DataSize: LongInt;                    // size of the unicode in bytes
begin
if IsUnicodeStream(Stm) then
begin
    // Data on stream is unicode
    // set size of unicode (excluding marker word)
    DataSize := Stm.Size - Stm.Position - SizeOf(Word);
    // size must be multiple of size of unicode char
    if DataSize mod SizeOf(WideChar) <> 0 then
      Classes.EStreamError.CreateFmt(
        'Remaining data in stream must be a mulitple of %d bytes',
        [SizeOf(WideChar)]
        );
    // Skip over unicode marker
    Stm.Position := Stm.Position + SizeOf(Word);
    // Read stream into result
    SetLength(Result, DataSize div SizeOf(WideChar));
    Stm.ReadBuffer(Windows.PByte(PWideChar(Result))^, DataSize);
end
else
    // Data on stream is not unicode: read it with ansi reader
    // result of StreamToString is automatically converted to WideString
    Result := StreamToString(Stm);
end;

procedure WideStringToUnicodeFile(const Str: WideString;
const FileName: string);
{Writes a wide string to a unicode text file. The text file begins with a
marker to indicate it is unicode.}
var
FS: Classes.TFileStream;              // Stream onto file being created
begin
// Open stream onto file and write unicode to it
FS := Classes.TFileStream.Create(FileName, Classes.fmCreate);
try
    WideStringToUnicodeStream(Str, FS);
finally
    FS.Free;
end;
end;

procedure WideStringToUnicodeStream(const Str: WideString;
const Stm: Classes.TStream);
{Writes a wide string to a stream in unicode format. The output begins with a
marker to indicate it is unicode.}
var
UnicodeMarker: Word;                  // Marker that begins unicode
begin
// Write out unicode marker
UnicodeMarker := $FEFF;
Stm.WriteBuffer(UnicodeMarker, SizeOf(Word));
// Write unicode text
Stm.WriteBuffer(
    Windows.PByte(PWideChar(Str))^, SizeOf(WideChar) * Length(Str)
    );
end;

procedure CopyFile(const Source, Dest: string);
{Copies Source file to Dest, preserving modification date.}
var
SourceStream, DestStream: Classes.TFileStream; // source and dest file streams
begin
DestStream := nil;
// Open source and dest file streams
SourceStream := Classes.TFileStream.Create(
    Source, SysUtils.fmOpenRead or SysUtils.fmShareDenyWrite
    );
try
    DestStream := Classes.TFileStream.Create(
      Dest, Classes.fmCreate or SysUtils.fmShareExclusive
      );
    // Copy file from source to dest
    DestStream.CopyFrom(SourceStream, SourceStream.Size);
    // Set dest file's modification date to same as source file
    SysUtils.FileSetDate(
      DestStream.Handle, SysUtils.FileGetDate(SourceStream.Handle)
      );
finally
    // Close files
    DestStream.Free;
    SourceStream.Free;
end;
end;

procedure CreateURLShortcut(const ShortcutFile, URL: string);
{Creates a URL shortcut file with the given name for the given URL,
overwriting any existing file. An exception is raised if file can't be
created.}
var
F: TextFile;                          // text file
begin
{$I+}                                   // ensure file i/o raises exception on error
// Open new file for writing (overwrites any existing file)
AssignFile(F, ShortcutFile);
Rewrite(F);
try
    // Write file contents: this is simplest basic format of shortcut file
    WriteLn(F, '[InternetShortcut]');
    WriteLn(F, 'URL=', URL);
finally
    // Close file
    CloseFile(F);
end;
end;

function DeleteFiles(const Dir, Wildcard: string): Integer;
{Deletes all files in the directory Dir that match the given wildcard and
returns the number of files deleted. If Wildcard is '' then all files are
deleted. Sub-directories of Dir are not deleted.}
var
Files: Classes.TStringList;           // stores files to be deleted
I: Integer;                           // loops thru files in folder
AFile: string;                        // a file to be deleted
Path: string;                         // path to directory
Attr: Integer;                        // attributes of a file
begin
Result := 0;
// Create list to stores files to be deleted
Files := Classes.TStringList.Create;
try
    // List files per file spec into string list
    if not ListFiles(Dir, Wildcard, Files) then
      Exit;
    // Get path of directory containing files
    Path := DirToPath(Dir);
    // Loop through all files
    for I := 0 to Pred(Files.Count) do
    begin
      // Get name and attributes of file to be deleted
      AFile := Path + Files[I];
      Attr := SysUtils.FileGetAttr(AFile);
      // Delete file if it is not a directory
      if (Attr and SysUtils.faDirectory = 0) then
      begin
        if SysUtils.DeleteFile(AFile) then
          // File deleted: count it
          Inc(Result);
      end;
    end;
finally
    // Tidy up
    Files.Free;
end;
end;

function DeleteFileWithUndo(const FileName: string): Boolean;
{Deletes given file and sends it to recycle bin. Returns true if file deleted
successfully.}
var
FOS: ShellAPI.TSHFileOpStruct;        // contains info about required file operation
begin
// Set up structure that determines file operation
FillChar(FOS, SizeOf(FOS), 0);
with FOS do
begin
    wFunc := ShellAPI.FO_DELETE;        // we're deleting
    pFrom := PChar(FileName + #0);      // this file (#0#0 terminated)
    fFlags := ShellAPI.FOF_ALLOWUNDO    // with facility to undo op
    or ShellAPI.FOF_NOCONFIRMATION      // and we don't want any dialogs
    or ShellAPI.FOF_SILENT;
end;
// Perform the operation
Result := ShellAPI.SHFileOperation(FOS) = 0;
end;

function DirToPath(const Dir: string): string;
{Returns the given directory with a trailing backslash. If the directory
already ends in backslash it is returned unchanged.}
begin
if (Dir <> '') and (Dir[Length(Dir)] <> '/') then
Result := Dir + '/'
else
Result := Dir;
end;

function DOSToUnixPath(const PathName: string): string;
{Converts a DOS path to a Unix path and returns it.}
begin
Result := SysUtils.StringReplace(PathName, '/', '/', [SysUtils.rfReplaceAll]);
end;

procedure EnsureFolders(Path: string);
{Ensures that the given folder and all folders on its path exist, and creates
them if they do not. Uses recursion.}
var
SlashPos: Integer;                    // position of last backslash in path
SubPath: string;                      // immediate parent folder of given path
begin
// Check there's a path to create
if Length(Path) = 0 then
    Exit;
// Remove any trailing '/'
Path := PathToDir(Path);
// Check if folder exists and quit if it does - we're done
if IsDirectory(Path) then
    Exit;
// Recursively call routine on immediate parent folder
// remove bottomost folder from path - ie move up to parent folder
SubPath := Path;
SlashPos := Length(SubPath);
while (SlashPos > 2) and (SubPath[SlashPos] <> '/') do
    Dec(SlashPos);
Delete(SubPath, SlashPos, Length(Path) - SlashPos + 1);
// do recursive call - ensures that parent folder of current path exist
EnsureFolders(SubPath);
// Create this current folder now we know parent folder exists
SysUtils.CreateDir(Path);
end;

function GetFileDate(const FName: string): Integer;
{Returns modification date of given file encoded as integer.}
var
FileH: Integer;                       // file handle
begin
// Open file
FileH := SysUtils.FileOpen(FName, SysUtils.fmOpenRead);
if FileH = -1 then
    // Couldn't open file - return -1 to indicate can't get date
    Result := -1
else
begin
    // File opened OK - record date and close file
    Result := SysUtils.FileGetDate(FileH);
    SysUtils.FileClose(FileH);
end;
end;

function GetFixedFileVerInfo(const FileName: string;
var FFI: Windows.TVSFixedFileInfo): Boolean;
{Extracts fixed version information from a file. If file contains version
information it is returned via FFI parameter and function returns true,
otherwise false is returned and FFI is undefined.}
var
VerInfoBuf: Pointer;                  // points to memory storing version info
VerInfoSize: Integer;                 // size of version info memory
Dummy: Windows.THandle;               // unused parameter required by API function
PFFI: Pointer;                        // points to fixed file info
FFISize: Windows.UINT;                // size of file file info returned from API (unused)
begin
// Assume failure: sets zero result
FillChar(FFI, SizeOf(FFI), 0);
Result := False;
// Get size of version info: there is none if this is zero
VerInfoSize := Windows.GetFileVersionInfoSize(PChar(FileName), Dummy);
if VerInfoSize > 0 then
begin
    // Allocate memory to store ver info
    GetMem(VerInfoBuf, VerInfoSize);
    try
      // Get the version info, filling buffer
      if Windows.GetFileVersionInfo(
        PChar(FileName), Dummy, VerInfoSize, VerInfoBuf
        ) then
      begin
        // Get a pointer to fixed file info
        if Windows.VerQueryValue(VerInfoBuf, '/', PFFI, FFISize) then
        begin
          // Got pointer OK: record file version
          FFI := Windows.PVSFixedFileInfo(PFFI)^;
          Result := True;
        end;
      end;
    finally
      // Dispose of ver info storage
      FreeMem(VerInfoBuf, VerInfoSize);
    end;
end;
end;

function HasVerInfo(const FileName: string): Boolean;
{Returns true if the given file contains version information and false if
not.}
var
Dummy: Windows.THandle; // dummy variable required by API function
begin
// API function returns size of ver info: 0 if none
Result := Windows.GetFileVersionInfoSize(PChar(FileName), Dummy) > 0;
end;

function IsDirectory(const DirName: string): Boolean;
{Returns true if given name is a valid directory and false otherwise. DirName
can be any file system name (with or without trailing path delimiter).}
var
Attr: Integer; // directory's file attributes
begin
Attr := SysUtils.FileGetAttr(DirName);
Result := (Attr <> -1)
and (Attr and SysUtils.faDirectory = SysUtils.faDirectory);
end;

function IsURLShortcut(const ShortcutFile: string): Boolean;
{Returns true if the given file is a URL shortcut file and false if not.}
var
Ini: IniFiles.TIniFile;               // used to read ini files
begin
// File must exist
if SysUtils.FileExists(ShortcutFile) then
begin
    // Open ini file and check value exists
    Ini := IniFiles.TIniFile.Create(ShortcutFile);
    try
      Result := Ini.SectionExists('InternetShortcut')
        and Ini.ValueExists('InternetShortcut', 'URL')
        and (Ini.ReadString('InternetShortcut', 'URL', '') <> '');
    finally
      Ini.Free;
    end;
end
else
    Result := False;
end;

function ListFiles(const Dir, Wildcard: string;
const List: Classes.TStrings): Boolean;
{Gets a list of the files and sub-directories of the given directory that
match the given wild card. The files are appended to the given string list.
Returns true if Dir is a valid directory and False if not. If Wildcard is not
specified, *.* is assumed.}
var
FileSpec: string;                     // search file specification
SR: SysUtils.TSearchRec;              // file search result
Success: Integer;                     // success code for FindXXX routines
begin
Assert(Assigned(List));
// Check if true directory and exit if not
Result := IsDirectory(Dir);
if not Result then
    Exit;
// Build file spec from directory and wildcard
FileSpec := DirToPath(Dir);
if Wildcard = '' then
    FileSpec := FileSpec + '*.*'
else
    FileSpec := FileSpec + Wildcard;
// Initialise search for matching files
Success := SysUtils.FindFirst(FileSpec, SysUtils.faAnyFile, SR);
try
    // Loop for all files in directory
    while Success = 0 do
    begin
      // only add true files or directories to list
      if (SR.Name <> '.') and (SR.Name <> '..')
        and (SR.Attr and SysUtils.faVolumeId = 0) then
        List.Add(SR.Name);
      // get next file
      Success := SysUtils.FindNext(SR);
    end;
finally
    // Tidy up
    SysUtils.FindClose(SR);
end;
end;

function LongToShortFilePath(const LongName: string): string;
{Converts the given long file name to the equivalent shortened DOS style 8.3
path.}
begin
SetLength(Result, Windows.MAX_PATH);
SetLength(
    Result,
    Windows.GetShortPathName(
    PChar(LongName), PChar(Result), Windows.MAX_PATH
    )
    );
end;

function PathToDir(const Path: string): string;
{Returns the given directory with any single trailing backslash removed. If
the directory does not end in a backslash it is returned unchanged.}
begin
Result := Path;
if (Path <> '') and (Path[Length(Path)] = '/') then
Delete(Result, Length(Result), 1);
end;

procedure SetFileDate(const FName: string; const ADate: Integer);
{Sets modification date of given file to given integer coded value.}
var
FileH: Integer;                       // file handle
begin
// Open file
FileH := SysUtils.FileOpen(FName, SysUtils.fmOpenWrite);
if FileH <> -1 then
begin
    // File opened OK - set date and close file
    SysUtils.FileSetDate(FileH, ADate);
    SysUtils.FileClose(FileH);
end;
end;

function ShortToLongFilePath(const FilePath: string): string;
{Converts whole of given DOS style 8.3 path to long file path and returns it.
If path can't be converted then '' is returned.}
var
PrevPath: string;                     // path before last file/dir in FilePath
ExpandedName: string;                 // long form of file name
SR: SysUtils.TSearchRec;              // record used by file find functions
Success: Integer;                     // indicates success in finding a file
// ---------------------------------------------------------------------------
function CountPathDelims(const Name: string): Integer;
    {Counts path separators in given name}
var
    Idx: Integer;                       // loops thru name string
begin
    Result := 0;
    for Idx := 1 to Length(Name) do
      if SysUtils.IsPathDelimiter(Name, Idx) then
        Inc(Result);
end;

function IsServerName(const Name: string): Boolean;
    {Returns true if Names is in form //Server/Share}
begin
    Result := (SysUtils.AnsiPos('//', Name) = 1)
      and (CountPathDelims(Name) = 3);
end;
// ---------------------------------------------------------------------------
begin
// Check if we have a drive, server/share or root path, and exit if so
// (we can't apply file search to any of these, so we return them unchanged
if (FilePath = '')
    or (FilePath = '/')
    or ((Length(FilePath) = 2) and (FilePath[2] = ':'))
    or ((Length(FilePath) = 3) and (FilePath[2] = ':') and (FilePath[3] = '/'))
    or IsServerName(FilePath) then
begin
    Result := FilePath;
    Exit;
end;
// Do a file search on file: this is used to expand name
Success := SysUtils.FindFirst(FilePath, SysUtils.faAnyFile, SR);
try
    if Success = 0 then
      ExpandedName := SR.FindData.cFileName
    else
      ExpandedName := '';
finally
    SysUtils.FindClose(SR);
end;
// Check if there's any part of path we've not handled, and convert it if so
PrevPath := SysUtils.ExtractFileDir(FilePath);
if PrevPath <> '' then
begin
    // We have unprocessed part of path: expand that
    Result := ShortToLongFilePath(PrevPath);
    // Appended currently expanded name to path
    if (Result <> '') and (Result[Length(Result)] <> '/') then
      Result := Result + '/';
    Result := Result + ExpandedName;
end
else
    // No earlier parts of path: just record expanded name
    Result := ExpandedName;
end;

function TempFileName(const Stub: string; const Create: Boolean): string;
{Returns a unique temporary file name in temporary folder. File name includes
first three characters of Stub followed by hexadecimal characters. If Create
is true file is created. Returns empty string on failure.}
begin
// Get temporary folder
SetLength(Result, Windows.MAX_PATH);
Windows.GetTempPath(Windows.MAX_PATH, PChar(Result));
// Get unique temporary file name (it is created as side effect of this call)
if Windows.GetTempFileName(
    PChar(Result), PChar(Stub), 0, PChar(Result)
    ) <> 0 then
begin
    // Succeeded
    Result := PChar(Result);
    if not Create then
      // user doesn't want file creating: so we delete the file
      SysUtils.DeleteFile(Result);
end
else
    // Failed
    Result := '';
end;

function Touch(const FileName: string): Boolean;
{Sets modification date of given file to current date and time. Returns true
if date set successfully or false on error.}
var
FileH: Integer;                       // handle of file
begin
// Assume failure
Result := False;
// Try to open file: bail out if can't open
FileH := SysUtils.FileOpen(
    FileName, SysUtils.fmOpenWrite or SysUtils.fmShareDenyWrite
    );
if FileH = -1 then
    Exit;
try
    // Set date to current date and time: return true if succeed
    if SysUtils.FileSetDate(
      FileH, SysUtils.DateTimeToFileDate(SysUtils.Now())
      ) = 0 then
      Result := True;
finally
    // Close the file
    SysUtils.FileClose(FileH);
end;
end;

function URLFromShortcut(const Shortcut: string): string;
{Returns the URL referenced by the given URL shortcut file, or the empty
string if the given file is not a shortcut file.}
var
Ini: IniFiles.TIniFile;               // object used to read shortcut file
begin
// Return URL item from [InternetShortcut] section of shortcut file
Ini := IniFiles.TIniFile.Create(Shortcut);
try
    try
      Result := Ini.ReadString('InternetShortcut', 'URL', '');
    except;
      // We return '' on error
      Result := '';
    end;
finally
    Ini.Free;
end;
end;

function ColorToRGBTriple(const C: Graphics.TColor): Windows.TRGBTriple;
{Converts a Delphi TColor value into an RGB triple value.}
var
ColorRGB: Integer; // RGB value of C
begin
ColorRGB := Graphics.ColorToRGB(C);
Result.rgbtRed := Windows.GetRValue(ColorRGB);
Result.rgbtGreen := Windows.GetGValue(ColorRGB);
Result.rgbtBlue := Windows.GetBValue(ColorRGB);
end;

procedure DrawTextOutline(const Canvas: Graphics.TCanvas; const X, Y: Integer;
const Text: string);
{Draws specified text in outline on a canvas. The top left corner of the text
is specified by X and Y parameters. Canvas' current brush and pen colours are
used to fill and outline the text respectively. If the canvas' current font is
not a vector font nothing is displayed.}
var
OldBkMode: Integer; // stores previous background mode
begin
OldBkMode := Windows.SetBkMode(Canvas.Handle, Windows.TRANSPARENT);
Windows.BeginPath(Canvas.Handle);
Canvas.TextOut(X, Y, Text);
Windows.EndPath(Canvas.Handle);
Windows.StrokeAndFillPath(Canvas.Handle);
Windows.SetBkMode(Canvas.Handle, OldBkMode);
end;

procedure MakeGreyScale(const SrcBmp: Graphics.TBitmap;
const Advanced: Boolean);
{Converts a colour bitmap into a 24bit greyscale bitmap. Setting the Advanced
flag to true uses a more advanced algorithm for the conversion. When the flag
is false red, blue and green values are simply averaged. The provided colour
bitmap is overwritten by the greyscale bitmap.}
type
// 24 bit bitmap scanline and pointer
TRGBArray = array[0..MaxInt div SizeOf(Windows.TRGBTriple) - 1]
    of Windows.TRGBTriple;
PRGBArray = ^TRGBArray;
var
J: Integer;                           // loops scanlines of bitmap
I: Integer;                           // loops through pixels in scanline
GreyColor: Byte;                      // grey equivalent of a pixel
ScanLine: PRGBArray;                  // references scanline in a bitmap
GreyBmp: Graphics.TBitmap;            // used to build grey bitmap
begin
// Draw colour bitmap in 24 bit format onto temp bitmap
GreyBmp := Graphics.TBitmap.Create;
try
    GreyBmp.PixelFormat := Graphics.pf24bit;
    GreyBmp.Width := SrcBmp.Width;
    GreyBmp.Height := SrcBmp.Height;
    GreyBmp.Canvas.Draw(0, 0, SrcBmp);
    if GreyBmp.PixelFormat <> Graphics.pf24bit then
      raise SysUtils.Exception.Create(
        'MakeGrayScale() can''t convert bitmap to 24 bit'
        );
    // Convert bitmap to greyscale by processing scanlines
    for J := 0 to Pred(GreyBmp.Height) do
    begin
      ScanLine := GreyBmp.ScanLine[j];
      for I := 0 to Pred(GreyBmp.Width) do
      begin
        if Advanced then
          // Advanced greyscale conversion:
          // we use weighting of red, green and blue
          GreyColor := Windows.HiByte(
            ScanLine[i].rgbtRed * 77
            + ScanLine[i].rgbtGreen * 151
            + ScanLine[i].rgbtBlue * 28
            )
        else
          // Basic conversion:
          // we use average of colour values
          GreyColor := (
            ScanLine[i].rgbtRed
            + ScanLine[i].rgbtGreen
            + ScanLine[i].rgbtBlue
            ) div 3;
        ScanLine[i].rgbtRed := GreyColor;
        ScanLine[i].rgbtGreen := GreyColor;
        ScanLine[i].rgbtBlue := GreyColor;
      end;
    end;
    // Copy greyscale bitmap to source
    SrcBmp.Assign(GreyBmp);
finally
    GreyBmp.Free;
end;
end;

function RGBTripleToColor(const C: Windows.TRGBTriple): Graphics.TColor;
{Converts an RGB triple value into a Delphi TColor value.}
begin
Result := Windows.RGB(C.rgbtRed, C.rgbtGreen, C.rgbtBlue);
end;

function BrowseURL(const URL: string): Boolean;
{Activates default browser or email client for given URL. Returns true if
browser/email client is uccessfully launched and false if not. Raises
exception if URL doesn't conform to a known valid protocol.}
begin
if not IsValidURLProtocol(URL) then
raise SysUtils.Exception.CreateFmt('"%s" is not a valid URL', [URL]);
Result := ExecAssociatedApp(URL);
end;

function ColorToHTML(const Color: Graphics.TColor): string;
{Converts a Delphi TColor value into a string suitable for use in HTML or CSS
code. Any system colors (like clBtnFace) are mapped to the actual colour
according to the current Windows settings.}
var
ColorRGB: Integer;
begin
ColorRGB := Graphics.ColorToRGB(Color);
Result := SysUtils.Format(
    '#%0.2X%0.2X%0.2X',
    [Windows.GetRValue(ColorRGB),
    Windows.GetGValue(ColorRGB),
      Windows.GetBValue(ColorRGB)]
      );
end;

function DownloadURLToFile(const URL, FileName: string): Boolean;
{Downloads file at URL and stores in given file. Returns true if download
succeeds and false on failure. A connection to the internet must be open for
download to succeed.}
begin
// URLDownloadFile returns true if URL exists even if file not created
// hence we also check file has been created.
Result := Windows.Succeeded(
UrlMon.URLDownloadToFile(nil, PChar(URL), PChar(FileName), 0, nil)
) and SysUtils.FileExists(FileName);
end;

function IsValidURLProtocol(const URL: string): Boolean;
{Checks if the given URL is valid per RFC1738. Returns true is valid and false
if not.}
const
CNumProtocols = 10;                   // number of known protocols
CProtocols: array[1..CNumProtocols] of string = (
    // Array of valid protocols - per RFC 1738
    'ftp://', 'http://', 'gopher://', 'mailto:', 'news:', 'nntp://',
    'telnet://', 'wais://', 'file://', 'prospero://'
    );
var
I: Integer;                           // loops thru known protocols
begin
// Scan array of protocols checking for a match with start of given URL
Result := False;
for I := 1 to CNumProtocols do
    if Pos(CProtocols[I], SysUtils.LowerCase(URL)) <> 0 then
    begin
      Result := True;
      Break;
    end;
end;

function MakeSafeHTMLText(TheText: string): string;
{Replaces any characters in the given text that are HTML-compatible with
suitable escaped versions and returns modified string.}
var
Idx: Integer;                         // loops thru the given text
begin
Result := '';
for Idx := 1 to Length(TheText) do
    case TheText[Idx] of
      '<':                              // opens tags: replace with special char reference
        Result := Result + '<';
      '>':                              // closes tags: replace with special char reference
        Result := Result + '>';
      '&':                              // begins char references: replace with special char reference
        Result := Result + '&';
      '"':                              // quotes (can be a problem in quoted attributes)
        Result := Result + '"';
      #0..#31, #127..#255:              // control and special chars: replace with encoding
        Result := Result + '&#' + SysUtils.IntToStr(Ord(TheText[Idx])) + ';';
    else                                // compatible text: pass thru
      Result := Result + TheText[Idx];
    end;
end;

function URLDecode(const S: string): string;
{Decodes the given encoded URL or URL query string. Raises exception if the
encoded URL is badly formed.}
var
Idx: Integer;                         // loops thru chars in string
Hex: string;                          // string of hex characters
Code: Integer;                        // hex character code (-1 on error)
begin
// Intialise result and string index
Result := '';
Idx := 1;
// Loop thru string decoding each character
while Idx <= Length(S) do
begin
    case S[Idx] of
      '%':
        begin
          // % should be followed by two hex digits - exception otherwise
          if Idx <= Length(S) - 2 then
          begin
            // there are sufficient digits - try to decode hex digits
            Hex := S[Idx + 1] + S[Idx + 2];
            Code := SysUtils.StrToIntDef('$' + Hex, -1);
            Inc(Idx, 2);
          end
          else
            // insufficient digits - error
            Code := -1;
          // check for error and raise exception if found
          if Code = -1 then
            raise SysUtils.EConvertError.Create(
              'Invalid hex digit in URL'
              );
          // decoded OK - add character to result
          Result := Result + Chr(Code);
        end;
      '+':
        // + is decoded as a space
        Result := Result + ' '
    else
      // All other characters pass thru unchanged
      Result := Result + S[Idx];
    end;
    Inc(Idx);
end;
end;

function URLEncode(const S: string; const InQueryString: Boolean): string;
{Encodes the given string, making it suitable for use in a URL. The function
can encode strings for use in the main part of a URL (where spaces are
encoded as '%20') or in URL query strings (where spaces are encoded as '+'
characters). Set InQueryString to true to encode for a query string.}
var
Idx: Integer;                         // loops thru characters in string
begin
Result := '';
for Idx := 1 to Length(S) do
begin
    case S[Idx] of
      'A'..'Z', 'a'..'z', '0'..'9', '-', '_', '.':
        Result := Result + S[Idx];
      ' ':
        if InQueryString then
          Result := Result + '+'
        else
          Result := Result + '%20';
    else
      Result := Result + '%' + SysUtils.IntToHex(Ord(S[Idx]), 2);
    end;
end;
end;

function CompressWhiteSpace(const S: string): string;
{Returns a copy of given string with all white space characters replaced by
space characters and all sequences of white space replaced by a single space
character.}
var
Idx: Integer;                         // loops thru all characters in string
ResCount: Integer;                    // counts number of characters in result string
PRes: PChar;                          // pointer to characters in result string
const
// The white space characters we convert to spaces
cWhiteSpace = [#9, #10, #11, #12, #13, ' '];
begin
// Set length of result to length of source string and set pointer to it
SetLength(Result, Length(S));
PRes := PChar(Result);
// Reset count of characters in result string
ResCount := 0;
// Loop thru characters of source string
Idx := 1;
while Idx <= Length(S) do
begin
    if S[Idx] in cWhiteSpace then
    begin
      // Current char is white space: replace by space char and count it
      PRes^ := ' ';
      Inc(PRes);
      Inc(ResCount);
      // Skip past any following white space
      Inc(Idx);
      while S[Idx] in cWhiteSpace do
        Inc(Idx);
    end
    else
    begin
      // Current char is not white space: copy it literally and count it
      PRes^ := S[Idx];
      Inc(PRes);
      Inc(ResCount);
      Inc(Idx);
    end;
end;
// Reduce length of result string if it is shorter than source string
if ResCount < Length(S) then
    SetLength(Result, ResCount);
end;

function CountDelims(const S, Delims: string): Integer;
{Returns count of all occurences of any of the given delimiter characters in
the string S.}
var
Idx: Integer;                         //loops thru all characters in string
begin
Result := 0;
for Idx := 1 to Length(S) do
    if SysUtils.IsDelimiter(Delims, S, Idx) then
      Inc(Result);
end;

function ExplodeStr(S: string; const Delim: Char; const List: Classes.TStrings;
const AllowEmpty: Boolean = True): Integer;
{Splits the string S into a list of strings, separated by Delim, and returns
the number of strings in the list. If AllowEmpty is true then any empty
strings are added to the list, while they are ignored if AllowEmpty is
false.}
var
Item: string;                         // current delimted text
Remainder: string;                    // remaining unconsumed part of string
begin
// Clear the list
List.Clear;
// Check we have some entries in the string
if S <> '' then
begin
    // Repeatedly split string until we have no more entries
    while SplitStr(S, Delim, Item, Remainder) do
    begin
      // Add the current string, is required
      if (Item <> '') or AllowEmpty then
        List.Add(Item);
      // Go round again with remainder of string
      S := Remainder;
    end;
    // Add any terminal item
    if (Item <> '') or AllowEmpty then
      List.Add(Item);
end;
// Return number of items read
Result := List.Count;
end;

function IsHexStr(const S: string): Boolean;
{Returns true if string S contains only valid hex digits, false otherwise.}
{Returns true if string S contains only valid hex digits, false otherwise}
const
cHexChars = ['0'..'9', 'A'..'F', 'a'..'f']; // set of valid hex digits
var
Idx: Integer;                         //loops thru all characters in string
begin
Result := True;
for Idx := 1 to Length(S) do
    if not (S[Idx] in cHexChars) then
    begin
      Result := False;
      Break;
    end;
end;

function JoinStr(const SL: Classes.TStrings; const Delim: string;
const AllowEmpty: Boolean = True): string;
{Joins all strings in given string list together into single string separated
by given delimiter. If AllowEmpty is true then any empty strings are included
in output string, but are ignored if false.}
var
Idx: Integer;                         // loops thru all items in string list
begin
Result := '';
for Idx := 0 to Pred(SL.Count) do
begin
    if (SL[Idx] <> '') or AllowEmpty then
      if Result = '' then
        Result := SL[Idx]
      else
        Result := Result + Delim + SL[Idx];
end;
end;

procedure MultiSzToStrings(const MultiSz: PChar;
const Strings: Classes.TStrings);
{Splits out individual strings from given 'MultiSz' strings buffer and adds
each string to the given string list. A MultiSz string is a sequence of #0
delimited strings terminated by an extra #0 character. Does nothing if string
list or MultiSz buffer are nil.}
var
P: PChar;                             // pointer to strings in buffer
begin
// Do nothing in MultiSz is nil
if not Assigned(MultiSz) then
    Exit;
// Scan thru #0 delimited strings until #0#0 found
P := MultiSz;
while P^ <> #0 do
begin
    // add string to list
    Strings.Add(P);
    // move pointer to start of next string if any
    Inc(P, SysUtils.StrLen(P) + 1);
end;
end;

function ParseDelims(const TextLine: string; var StartPos: Integer;
const Delims: string): string;
{Returns the sub-string of TextLine that begins at StartPos and is terminated
by one of the delimiting characters Delims or the end of the string. StartPos
is updated to index of character after delimiter. Returns '' if there is no
sub-string after StartPos.}
var
StringEnd: Integer;                   // tracks end of current string being parsed out
begin
// Find next non-delimiter char - this is where token starts
while (StartPos <= Length(TextLine))
    and SysUtils.IsDelimiter(Delims, TextLine, StartPos) do
    Inc(StartPos);
// Now find next delimiter - this is where token ends
StringEnd := StartPos;
while (StringEnd <= Length(TextLine))
    and not SysUtils.IsDelimiter(Delims, TextLine, StringEnd) do
    Inc(StringEnd);
// Copy result out of string
Result := Copy(TextLine, StartPos, StringEnd - StartPos);
StartPos := StringEnd + 1;
end;

function SplitStr(const S: string; Delim: Char; out S1, S2: string): Boolean;
{Splits the string S at the first occurence of delimiter character Delim and
sets S1 to the sub-string before Delim and S2 to substring following Delim.
If Delim is found in string True is returned, while if Delim is not in string
False is returned, S1 is set to S and S2 is set to ''.}
var
DelimPos: Integer;                    // position of delimiter in source string
begin
// Find position of first occurence of delimter in string
DelimPos := SysUtils.AnsiPos(Delim, S);
if DelimPos > 0 then
begin
    // Delimiter found: do split and return True
    S1 := Copy(S, 1, DelimPos - 1);
    S2 := Copy(S, DelimPos + 1, MaxInt);
    Result := True;
end
else
begin
    // Delimeter not found: return false and set S1 to whole string
    S1 := S;
    S2 := '';
    Result := False;
end;
end;

function StringsToMutliSz(const Strings: Classes.TStrings;
const MultiSz: PChar; const BufSize: Integer): Integer;
{Copies the strings from a given string list and stores in a provided MulitiSz
buffer of a given size. The strings in the buffer are separated by #0 and the
buffer is terminated by an additional #0. Returns 0 on success or required
buffer size if MultiSz is nil or buffer size is too small. To get required
buffer size call function with MultiSz=nil and BufSize=0.}
var
ReqSize: Integer;                     // required buffer size
Idx: Integer;                         // loops thru Strings
P: PChar;                             // pointer into MultiSz
begin
Result := 0;
if not Assigned(Strings) then
    Exit;
// Get required size of buffer
ReqSize := 1;
for Idx := 0 to Pred(Strings.Count) do
    Inc(ReqSize, Length(Strings[Idx]) + 1);
if (BufSize >= ReqSize) and Assigned(MultiSz) then
begin
    // BufSize OK and MultiSz not nil: copy string and return zero
    P := MultiSz;
    for Idx := 0 to Pred(Strings.Count) do
    begin
      // copy current string, #0 terminated
      SysUtils.StrPCopy(P, Strings[Idx]);
      // moves to next pos in buffer
      Inc(P, Length(Strings[Idx]) + 1);
    end;
    // add terminating additional #0
    P^ := #0;
end
else
    // BufSize too small or MultiSz is nil: return required size
    Result := ReqSize;
end;

function GetMacAddress: string;
{Returns MAC address of first ethernet adapter on computer.}
type
// This type is defined in MSDN sample code, but tests have found this is
// not needed (on XP Pro) and Adapter can be of type TAdapterStatus. This
// method use the type in case other OSs require it
TAStat = packed record
    Adapt: Nb30.TAdapterStatus;
    NameBuff: array[0..29] of Nb30.TNameBuffer;
end;
var
Adapter: TAStat;                      // info about a network adapter
AdapterList: Nb30.TLanaEnum;          // numbers for current LAN adapters
Ncb: Nb30.TNCB;                       // network control block descriptor
I: Integer;                           // loops thru all adapters in list
// ---------------------------------------------------------------------------
function NetBiosSucceeded(const RetCode: AnsiChar): Boolean;
begin
    // Check RetCode is good NetBios function return value
    Result := Windows.UCHAR(RetCode) = Nb30.NRC_GOODRET;
end;
// ---------------------------------------------------------------------------
begin
// Assume not adapter
Result := '';
// Get list of adapters
FillChar(Ncb, SizeOf(Ncb), 0);
Ncb.ncb_command := AnsiChar(Nb30.NCBENUM);
Ncb.ncb_buffer := PAnsiChar(@AdapterList);
Ncb.ncb_length := SizeOf(AdapterList);
if not NetBiosSucceeded(Nb30.Netbios(@Ncb)) then
    Exit;
// Get status of each adapter, exiting when first valid one reached
// MSDN cautions us not to assume lana[0] is valid
for I := 0 to Pred(Integer(AdapterList.length)) do
begin
    // reset the adapter
    FillChar(Ncb, SizeOf(Ncb), 0);
    Ncb.ncb_command := AnsiChar(Nb30.NCBRESET);
    Ncb.ncb_lana_num := AdapterList.lana[I];
    if not NetBiosSucceeded(Nb30.Netbios(@Ncb)) then
      Exit;
    // get status of adapter
    FillChar(Ncb, SizeOf(Ncb), 0);
    Ncb.ncb_command := AnsiChar(Nb30.NCBASTAT);
    Ncb.ncb_lana_num := AdapterList.lana[I];
    Ncb.ncb_callname := '*               ';
    Ncb.ncb_buffer := PAnsiChar(@Adapter);
    Ncb.ncb_length := SizeOf(Adapter);
    if NetBiosSucceeded(Nb30.Netbios(@Ncb)) then
    begin
      // we have a MAC address: return it
      with Adapter.Adapt do
        Result := SysUtils.Format(
          '%.2x-%.2x-%.2x-%.2x-%.2x-%.2x',
          [
          Ord(adapter_address[0]),
            Ord(adapter_address[1]),
            Ord(adapter_address[2]),
            Ord(adapter_address[3]),
            Ord(adapter_address[4]),
            Ord(adapter_address[5])
            ]
            );
      Exit;
    end;
end;
end;

function IsLockKeyOn(const KeyCode: Integer): Boolean;
{Detects if a given lock key is on and returns true if so. An exception is
raised if KeyCode is not a valid lock key code. Valid lock key codes are
VK_CAPITAL, VK_NUMLOCK and VK_SCROLL.}
begin
if not (
    KeyCode in [Windows.VK_CAPITAL, Windows.VK_NUMLOCK, Windows.VK_SCROLL]
    ) then
    raise SysUtils.Exception.Create('Invalid lock key specified.');
Result := Odd(Windows.GetKeyState(KeyCode));
end;

procedure SetLockKeyState(KeyCode: Integer; IsOn: Boolean);
{Sets the given lock key state to given value. Passing True switches lock key
on and passing False switches it off. An exception is raised if KeyCode is
not a valid lock key code. Valid lock key codes are VK_CAPITAL, VK_NUMLOCK
and VK_SCROLL.}
// ---------------------------------------------------------------------------
procedure MoveKey(KeyCode: Integer; Up: Boolean);
var
    Flags: Integer;                     // flags for MapVirtualKey()
begin
    // Set up flags
    Flags := Windows.KEYEVENTF_EXTENDEDKEY;
    if Up then
      Flags := Flags or Windows.KEYEVENTF_KEYUP;
    // Simulate key movement
    Windows.keybd_event(
      KeyCode,
      Windows.MapVirtualkey(KeyCode, 0),
      Flags,
      0
      );
end;
// ---------------------------------------------------------------------------
begin
if not (
    KeyCode in [Windows.VK_CAPITAL, Windows.VK_NUMLOCK, Windows.VK_SCROLL]
    ) then
    raise SysUtils.Exception.Create('Invalid lock key specified.');
if IsLockKeyOn(KeyCode) <> IsOn then
begin
    // Need to change state: press & release key
    MoveKey(KeyCode, False);
    MoveKey(KeyCode, True);
end;
end;

procedure AddToRecentDocs(const FileName: string);
{Adds given file to Recent Documents folder that appears on the Start menu.}
begin
ShlObj.SHAddToRecentDocs(ShlObj.SHARD_PATH, PChar(FileName));
end;

procedure ClearRecentDocs;
{Clears the Recent Documents folder so that no recent documents appear on
Start menu.}
begin
ShlObj.SHAddToRecentDocs(ShlObj.SHARD_PATH, nil);
end;

function CreateShellLink(const LinkFileName, AssocFileName, Desc, WorkDir,
Args, IconFileName: string; const IconIdx: Integer): Boolean;
{Creates a shell link named LinkFileName that is a shortcut to file
AssocFileName with descriprion Desc. The shortcut activates its file in the
given working directory and passes the given command line Args to
AssocFileName. If an icon file and index offset are provided the specified
icon is used for the shortcut. True is returned on success and false on
error.}
var
SL: ShlObj.IShellLink;                // shell link object
PF: ActiveX.IPersistFile;             // persistant file interface to shell link object
begin
// Assume failure
Result := False;
// Ensure COM is initialised
ActiveX.CoInitialize(nil);
try
    // Create shell link object
    if ActiveX.Succeeded(
      ActiveX.CoCreateInstance(
      ShlObj.CLSID_ShellLink,
      nil,
      ActiveX.CLSCTX_INPROC_SERVER,
      ShlObj.IShellLink, SL
      )
      ) then
    begin
      // Store required properties of shell link
      SL.SetPath(PChar(AssocFileName));
      SL.SetDescription(PChar(Desc));
      SL.SetWorkingDirectory(PChar(WorkDir));
      SL.SetArguments(PChar(Args));
      if (IconFileName <> '') and (IconIdx >= 0) then
        SL.SetIconLocation(PChar(IconFileName), IconIdx);
      // Create persistant file interface to shell link to save link file
      PF := SL as ActiveX.IPersistFile;
      Result := ActiveX.Succeeded(
        PF.Save(PWideChar(WideString(LinkFileName)), True)
        );
    end;
finally
    // Finalize COM
    ActiveX.CoUninitialize;
end;
end;

function EmptyRecycleBin: Boolean;
{Empties the recycle bin. Returns returns true if bin is emptied and false if
the function fails.}
const
// Flags passed to SHEmptyRecycleBin
SHERB_NOCONFIRMATION = $00000001;
SHERB_NOPROGRESSUI = $00000002;
SHERB_NOSOUND = $00000004;
// DLL containing function
cDLLName = 'Shell32.dll';
// Function name
cFnName = 'SHEmptyRecycleBinA';
type
// Prototype of API function
TSHEmptyRecycleBin = function(
    Wnd: Windows.HWND;
    pszRootPath: PChar;
    dwFlags: Windows.DWORD
    ): HRESULT; stdcall;
var
SHEmptyRecycleBin: TSHEmptyRecycleBin; // API function address
DLLHandle: Windows.THandle;           // Handle of required DLL
begin
// Assume failure
Result := False;
// Load required DLL
DLLHandle := Windows.LoadLibrary(cDLLName);
if DLLHandle <> 0 then
begin
    try
      // Get reference of API function from DLL
      @SHEmptyRecycleBin := Windows.GetProcAddress(DLLHandle, cFnName);
      if Assigned(@SHEmptyRecycleBin) then
      begin
        // Try to empty recycle bin
        Result := Windows.Succeeded(
          SHEmptyRecycleBin(
          0,
          nil,
          SHERB_NOCONFIRMATION or SHERB_NOSOUND or SHERB_NOPROGRESSUI
          )
          );
      end;
    finally
      Windows.FreeLibrary(DLLHandle);
    end;
end;
end;

function ExecAndWait(const CommandLine: string): Boolean;
{Executes the given command line and waits for the program started by the
command line to exit. Returns true if the program returns a zero exit code
and false if the program doesn't start or returns a non-zero error code.}
var
StartupInfo: Windows.TStartupInfo;    // start-up info passed to process
ProcessInfo: Windows.TProcessInformation; // info about the process
ProcessExitCode: Windows.DWord;       // process's exit code
begin
// Set default error result
Result := False;
// Initialise startup info structure to 0, and record length
FillChar(StartupInfo, SizeOf(StartupInfo), 0);
StartupInfo.cb := SizeOf(StartupInfo);
// Execute application commandline
if Windows.CreateProcess(nil, PChar(CommandLine),
    nil, nil, False, 0, nil, nil,
    StartupInfo, ProcessInfo) then
begin
    try
      // Now wait for application to complete
      if Windows.WaitForSingleObject(ProcessInfo.hProcess, INFINITE)
        = WAIT_OBJECT_0 then
        // It's completed - get its exit code
        if Windows.GetExitCodeProcess(ProcessInfo.hProcess,
          ProcessExitCode) then
          // Check exit code is zero => successful completion
          if ProcessExitCode = 0 then
            Result := True;
    finally
      // Tidy up
      Windows.CloseHandle(ProcessInfo.hProcess);
      Windows.CloseHandle(ProcessInfo.hThread);
    end;
end;
end;

function ExecAssociatedApp(const FileName: string): Boolean;
{Executes the application associated with the given file name. Returns true if
application is started successfully and false if not.}
begin
Result := ShellAPI.ShellExecute(
    0,
    nil,
    PChar(FileName),
    nil,
    nil,
    Windows.SW_SHOW
    ) > 32;
end;

function ExploreFile(const Filename: string): Boolean;
{Starts Windows Explorer to explore given file. Returns true if file is valid
and can be explored, or false otherwise.}
var
Params: string;                       // params passed to explorer
begin
if SysUtils.FileExists(Filename) then
begin
    Params := '/n, /e, /select, ' + Filename;
    Result := ShellAPI.ShellExecute(
      0, 'open', 'explorer', PChar(Params), '', Windows.SW_SHOWNORMAL
      ) > 32;
end
else
    // Error: filename does not exist
    Result := False;
end;

function ExploreFolder(const Folder: string): Boolean;
{Starts Windows Explorer to explore given folder. Returns true if folder is
valid and can be explored, or false otherwise.}
begin
if SysUtils.FileGetAttr(Folder) and faDirectory = faDirectory then
    // Folder is valid directory: try to explore it
    Result := ShellAPI.ShellExecute(
      0, 'explore', PChar(Folder), nil, nil, Windows.SW_SHOWNORMAL
      ) > 32
else
    // Folder is not a directory: error
    Result := False;
end;

function FileFromShellLink(const LinkFileName: string): string;
{Returns the fully specified name of the file associated with the given shell
link (shortcut) file. Returns '' if the file is not a shell link or if it is
a shortcut to a non-file shell object.}
var
SL: ShlObj.IShellLink;                // shell link object
ResolvedFileBuf: array[0..Windows.MAX_PATH] of AnsiChar;
// buffer to receive linked file name
FindData: Windows.TWin32FindData;     // dummy required for IShellLink.GetPath()
begin
// Assume can't get name of file
Result := '';
// Ensure COM is initialized
ActiveX.CoInitialize(nil);
try
    // Try to get interface to shell link: fails if file is not shell link
    SL := LoadShellLink(LinkFileName);
    if not Assigned(SL) then
      Exit;
    // Get file path from link object and exit if this fails
    if ActiveX.Failed(
      SL.GetPath(ResolvedFileBuf, Windows.MAX_PATH, FindData, 0)
      ) then
      Exit;
    // Return file name
    Result := ResolvedFileBuf;
finally
    // Finalize COM
    ActiveX.CoUninitialize;
end;
end;

function FindAssociatedApp(const Doc: string): string;
{Returns the fully specified path of the program associated with the given
document file name. Requires ShellAPI. Returns empty string if no such
associated application.}
var
PExecFile: array[0..Windows.MAX_PATH] of Char; // buffer to hold exe name
begin
// Win API call in ShellAPI
if ShellAPI.FindExecutable(PChar(Doc), nil, PExecFile) < 32 then
    // No associated program found
    Result := ''
else
    // Return program file name
    Result := PExecFile;
end;

procedure FreePIDL(PIDL: ShlObj.PItemIDList);
{Uses to shell allocator to free the memory used by a given PIDL.}
var
Malloc: ActiveX.IMalloc;              // shell's allocator
begin
// Try to get shell allocator
if Windows.Succeeded(ShlObj.SHGetMalloc(Malloc)) then
    // Use allocator to free PIDL: Malloc is freed by Delphi
    Malloc.Free(PIDL);
end;

function IsShellLink(const LinkFileName: string): Boolean;
{Checks if the given file is a shell link.}
begin
// Ensure COM is initialized
ActiveX.CoInitialize(nil);
try
    // Valid shell link if we can load it
    Result := Assigned(LoadShellLink(LinkFileName));
finally
    // Finalize COM
    ActiveX.CoUninitialize;
end;
end;

function IsSpecialFolderSupported(CSIDL: Integer): Boolean;
{Returns true if the given special folder specified by a CSIDL is supported on
the system and false if not.}
var
PIDL: ShlObj.PItemIDList;             // PIDL of the special folder
begin
// Try to get PIDL for folder: fails if not supported
Result := Windows.Succeeded(
    ShlObj.SHGetSpecialFolderLocation(0, CSIDL, PIDL)
    );
if Result then
    // Free the PIDL using shell allocator
    FreePIDL(PIDL);
end;

function LoadShellLink(const LinkFileName: string): ShlObj.IShellLink;
{Loads a shell link file into a shell link object and returns the IShellLink
interface of the object. If the given file is not a shell link nil is
returned. The returned object can be used to access information about the
shell link.}
var
PF: ActiveX.IPersistFile;             // persistent file interface to shell link object
begin
// Create shell link object
if ActiveX.Succeeded(
    ActiveX.CoCreateInstance(
    ShlObj.CLSID_ShellLink,
    nil,
    ActiveX.CLSCTX_INPROC_SERVER,
    ShlObj.IShellLink,
    Result
    )
    ) then
begin
    // Try to load the shell link: succeeds only of file is shell link
    PF := Result as ActiveX.IPersistFile;
    if ActiveX.Failed(
      PF.Load(PWideChar(WideString(LinkFileName)), ActiveX.STGM_READ)
      ) then
      Result := nil;                    // this frees the shell link object
end
else
    Result := nil;
end;

function OpenFolder(const Folder: string): Boolean;
{Opens given folder in Windows Explorer. Returns true if folder is valid and
can be opened, or false otherwise.}
begin
if SysUtils.FileGetAttr(Folder) and faDirectory = faDirectory then
    // Folder is valid directory: try to open it
    Result := ShellAPI.ShellExecute(
      0, 'open', PChar(Folder), nil, nil, Windows.SW_SHOWNORMAL
      ) > 32
else
    // Folder is not a directory: error
    Result := False;
end;

function PIDLToFolderPath(PIDL: ShlObj.PItemIDList): string;
{Returns the full path to a file system folder from a PIDL or '' if the PIDL
refers to a virtual folder.}
begin
// Set max length of return string
SetLength(Result, Windows.MAX_PATH);
// Get the path
if ShlObj.SHGetPathFromIDList(PIDL, PChar(Result)) then
Result := PChar(Result)
else
Result := '';
end;

function ShowFindFilesDlg(const Folder: string): Boolean;
{Displays the Windows find files dialog box ready for searching the given
folder. Returns true if dialog is shown and false if can't be shown (e.g. if
given folder is not valid).}
begin
Result := ShellAPI.ShellExecute(
0, 'find', PChar(Folder), '', '', Windows.SW_SHOW
) > 32;
end;

function SpecialFolderPath(CSIDL: Integer): string;
{Returns the full path to a special file system folder specified by a CSIDL
constant FolderID or '' if the special folder is virtual or CSIDL is not
supported.}
var
PIDL: ShlObj.PItemIDList;             // PIDL of the special folder
begin
Result := '';
// Get PIDL for required folder
if Windows.Succeeded(
    ShlObj.SHGetSpecialFolderLocation(0, CSIDL, PIDL)
    ) then
begin
    try
      // Get path from PIDL
      Result := PIDLToFolderPath(PIDL);
    finally
      // Free the PIDL using shell allocator
      FreePIDL(PIDL);
    end;
end
end;

function TaskAllocWideString(const S: string): Windows.PWChar;
{Converts a given ANSI string to a wide string and stores in a buffer
allocated by the Shell's task allocator. If the buffer needs to be freed
IMalloc.Free should be used to do this.}
var
StrLen: Integer;                      // length of string in bytes
begin
// Store length of string allowing for terminal #0
StrLen := Length(S) + 1;
// Alloc buffer for wide string using task allocator
Result := ActiveX.CoTaskMemAlloc(StrLen * SizeOf(WideChar));
if Assigned(Result) then
    // Convert string to wide string and store in buffer
    StringToWideChar(S, Result, StrLen);
end;

function TaskbarHandle: Windows.THandle;
{Returns the window handle of the Windows task bar.}
begin
Result := Windows.FindWindow('Shell_TrayWnd', nil);
end;

function CommonFilesFolder: string;
{Returns directory used for common files.}
begin
Result := GetCurrentVersionRegStr('CommonFilesDir');
end;

function GetCurrentVersionRegStr(const ValName: string): string;
{Gets given string value from given subkey of Windows current version registry
key.}
const
cWdwCurrentVer = '/Software/Microsoft/Windows/CurrentVersion';
begin
Result := GetRegistryString(
    Windows.HKEY_LOCAL_MACHINE,
    cWdwCurrentVer,
    ValName
    );
end;

function GetRegistryString(const RootKey: Windows.HKEY;
const SubKey, Name: string): string;
{Gets a string value from the registry from the given root and sub key.
Converts integers to strings and raises exception for binary and unknown
value types. Returns '' if the sub key or value name are not known.}
var
Reg: Registry.TRegistry;              // registry access object
ValueInfo: Registry.TRegDataInfo;     // info about registry value
begin
Result := '';
// Open registry at required root key
Reg := Registry.TRegistry.Create;
try
    Reg.RootKey := RootKey;
    // Open registry key and check value exists
    if Reg.OpenKeyReadOnly(SubKey)
      and Reg.ValueExists(Name) then
    begin
      // Check if registry value is string or integer
      Reg.GetDataInfo(Name, ValueInfo);
      case ValueInfo.RegData of
        Registry.rdString, Registry.rdExpandString:
          // string value: just return it
          Result := Reg.ReadString(Name);
        Registry.rdInteger:
          // integer value: convert to string
          Result := SysUtils.IntToStr(Reg.ReadInteger(Name));
      else
        // unsupported value: raise exception
        raise SysUtils.Exception.Create(
          'Unsupported registry type'
          );
      end;
    end;
finally
    // Close registry
    Reg.Free;
end;
end;

function IsIntResource(const ResID: PChar): Boolean;
{Returns true if the given resource ID is integer value or false if the ID is
a pointer to a zero terminated string.}
begin
Result := (Windows.HiWord(Windows.DWORD(ResID)) = 0);
end;

function IsMediaCenterOS: Boolean;
{Returns true if the operating system is a Windows Media Center edition or
false if not.}
const
SM_MEDIACENTER = 87; // metrics flag not defined in Windows unit
begin
Result := Windows.GetSystemMetrics(SM_MEDIACENTER) <> 0;
end;

function IsTabletOS: Boolean;
{Returns true if the operating system is a Windows Tablet edition or false if
not.}
const
SM_TABLETPC = 86; // metrics flag not defined in Windows unit
begin
Result := Windows.GetSystemMetrics(SM_TABLETPC) <> 0;
end;

function IsWin9x: Boolean;
{Returns true if the operating system is on the Windows 9x platform (including
Windows 95, 98 and Me) and false if not.}
begin
Result := SysUtils.Win32Platform = Windows.VER_PLATFORM_WIN32_WINDOWS;
end;

function IsWinNT: Boolean;
{Returns true if the operating system is Windows NT (including 2000 and XP)
and false if not.}
begin
Result := (SysUtils.Win32Platform = Windows.VER_PLATFORM_WIN32_NT);
end;

function IsWow64: Boolean;
{Returns true if the current process is executing as a 32 bit process under
WOW64 on 64 bit Windows.}
type
TIsWow64Process = function(           // Type of IsWow64Process API fn
    Handle: Windows.THandle; var Res: Windows.BOOL
    ): Windows.BOOL; stdcall;
var
IsWow64Result: Windows.BOOL;          // Result from IsWow64Process
IsWow64Process: TIsWow64Process;      // IsWow64Process fn reference
begin
// Try to load required function from kernel32
IsWow64Process := Windows.GetProcAddress(
    Windows.GetModuleHandle('kernel32'), 'IsWow64Process'
    );
if Assigned(IsWow64Process) then
begin
    // Function is implemented: call it
    if not IsWow64Process(
      Windows.GetCurrentProcess, IsWow64Result
      ) then
      raise SysUtils.Exception.Create('IsWow64: bad process handle');
    // Return result of function
    Result := IsWow64Result;
end
else
    // Function not implemented: can't be running on Wow64
    Result := False;
end;

function ProgramFilesFolder: string;
{Returns directory used for program files.}
begin
Result := GetCurrentVersionRegStr('ProgramFilesDir');
end;

function SystemFolder: string;
{Returns path to Windows system folder.}
begin
SetLength(Result, Windows.MAX_PATH);
SetLength(
Result, Windows.GetSystemDirectory(PChar(Result), Windows.MAX_PATH)
);
end;

function TempFolder: string;
{Returns path to Windows temporary folder.}
begin
SetLength(Result, Windows.MAX_PATH);
SetLength(
Result, Windows.GetTempPath(Windows.MAX_PATH, PChar(Result))
);
end;

function WindowsFolder: string;
{Returns path to Windows folder.}
begin
SetLength(Result, Windows.MAX_PATH);
SetLength(
Result, Windows.GetWindowsDirectory(PChar(Result), Windows.MAX_PATH)
);
end;

function WindowsProductID: string;
{Returns the Windows product ID.}
const
// Registry keys for Win 9x/NT
cRegKey: array[Boolean] of string = (
    'Software/Microsoft/Windows/CurrentVersion',
    'Software/Microsoft/Windows NT/CurrentVersion'
    );
// Registry key name
cName = 'ProductID';
begin
Result := GetRegistryString(
    Windows.HKEY_LOCAL_MACHINE, cRegKey[IsWinNT], cName
    );
end;

end.

本文来自优快云博客，转载请标明出处：http://blog.youkuaiyun.com/HsuChong/archive/2007/03/13/1528248.aspx