tntwindows.pas

TNT Components Source

function Tnt_GetDiskFreeSpaceW(lpRootPathName: PWideChar; var lpSectorsPerCluster,
  lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters: DWORD): BOOL;
begin
  if Win32PlatformIsUnicode then
    Result := GetDiskFreeSpaceW{TNT-ALLOW GetDiskFreeSpaceW}(lpRootPathName,
      lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters)
  else
    Result := GetDiskFreeSpaceA{TNT-ALLOW GetDiskFreeSpaceA}(PAnsiChar(AnsiString(lpRootPathName)),
      lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters)
end;

function Tnt_GetVolumeInformationW(lpRootPathName: PWideChar; lpVolumeNameBuffer: PWideChar;
  nVolumeNameSize: DWORD; lpVolumeSerialNumber: PDWORD;
    var lpMaximumComponentLength, lpFileSystemFlags: DWORD; lpFileSystemNameBuffer: PWideChar;
      nFileSystemNameSize: DWORD): BOOL;
var
  AnsiFileSystemNameBuffer: AnsiString;
  AnsiVolumeNameBuffer: AnsiString;
  AnsiBuffLen: DWORD;
begin
  if Win32PlatformIsUnicode then
    Result := GetVolumeInformationW{TNT-ALLOW GetVolumeInformationW}(lpRootPathName, lpVolumeNameBuffer, nVolumeNameSize, lpVolumeSerialNumber, lpMaximumComponentLength, lpFileSystemFlags, lpFileSystemNameBuffer, nFileSystemNameSize)
  else begin
    SetLength(AnsiVolumeNameBuffer, MAX_COMPUTERNAME_LENGTH + 1);
    SetLength(AnsiFileSystemNameBuffer, MAX_COMPUTERNAME_LENGTH + 1);
    AnsiBuffLen := Length(AnsiFileSystemNameBuffer);
    Result := GetVolumeInformationA{TNT-ALLOW GetVolumeInformationA}(PAnsiChar(AnsiString(lpRootPathName)), PAnsiChar(AnsiVolumeNameBuffer), AnsiBuffLen, lpVolumeSerialNumber, lpMaximumComponentLength, lpFileSystemFlags, PAnsiChar(AnsiFileSystemNameBuffer), AnsiBuffLen);
    if Result then begin
      SetLength(AnsiFileSystemNameBuffer, AnsiBuffLen);
      if (nFileSystemNameSize <= AnsiBuffLen) or (Length(AnsiFileSystemNameBuffer) = 0) then
        Result := False
      else begin
        WStrPLCopy(lpFileSystemNameBuffer, AnsiFileSystemNameBuffer, nFileSystemNameSize);
        WStrPLCopy(lpVolumeNameBuffer, AnsiVolumeNameBuffer, nVolumeNameSize);
      end;
    end;
  end;
end;

function Tnt_GetModuleFileNameW(hModule: HINST; lpFilename: PWideChar; nSize: DWORD): DWORD;
var
  AnsiBuff: AnsiString;
begin
  if Win32PlatformIsUnicode then
    Result := GetModuleFileNameW{TNT-ALLOW GetModuleFileNameW}(hModule, lpFilename, nSize)
  else begin
    SetLength(AnsiBuff, MAX_PATH);
    SetLength(AnsiBuff, GetModuleFileNameA{TNT-ALLOW GetModuleFileNameA}(hModule, PAnsiChar(AnsiBuff), Length(AnsiBuff)));
    Result := _HandlePathLengthResult(nSize, lpFilename, AnsiBuff, [poExactCopy]);
  end;
end;

function Tnt_GetTempPathW(nBufferLength: DWORD; lpBuffer: PWideChar): DWORD;
var
  AnsiBuff: AnsiString;
begin
  if Win32PlatformIsUnicode then
    Result := GetTempPathW{TNT-ALLOW GetTempPathW}(nBufferLength, lpBuffer)
  else begin
    SetLength(AnsiBuff, MAX_PATH);
    SetLength(AnsiBuff, GetTempPathA{TNT-ALLOW GetTempPathA}(Length(AnsiBuff), PAnsiChar(AnsiBuff)));
    Result := _HandlePathLengthResult(nBufferLength, lpBuffer, AnsiBuff, [poAllowDirectoryMode, poZeroSmallBuff]);
  end;
end;

function Tnt_GetTempFileNameW(lpPathName, lpPrefixString: PWideChar; uUnique: UINT;
  lpTempFileName: PWideChar): UINT;
var
  AnsiBuff: AnsiString;
begin
  if Win32PlatformIsUnicode then
    Result := GetTempFileNameW{TNT-ALLOW GetTempFileNameW}(lpPathName, lpPrefixString, uUnique, lpTempFileName)
  else begin
    SetLength(AnsiBuff, MAX_PATH);
    Result := GetTempFileNameA{TNT-ALLOW GetTempFileNameA}(PAnsiChar(AnsiString(lpPathName)), PAnsiChar(lpPrefixString), uUnique, PAnsiChar(AnsiBuff));
    AnsiBuff := PAnsiChar(AnsiBuff);
    _HandlePathLengthResult(MAX_PATH, lpTempFileName, AnsiBuff, [poZeroSmallBuff]);
  end;
end;

function Tnt_GetWindowsDirectoryW(lpBuffer: PWideChar; uSize: UINT): UINT;
var
  AnsiBuff: AnsiString;
begin
  if Win32PlatformIsUnicode then
    Result := GetWindowsDirectoryW{TNT-ALLOW GetWindowsDirectoryW}(lpBuffer, uSize)
  else begin
    SetLength(AnsiBuff, MAX_PATH);
    SetLength(AnsiBuff, GetWindowsDirectoryA{TNT-ALLOW GetWindowsDirectoryA}(PAnsiChar(AnsiBuff), Length(AnsiBuff)));
    Result := _HandlePathLengthResult(uSize, lpBuffer, AnsiBuff, []);
  end;
end;

function Tnt_GetSystemDirectoryW(lpBuffer: PWideChar; uSize: UINT): UINT;
var
  AnsiBuff: AnsiString;
begin
  if Win32PlatformIsUnicode then
    Result := GetSystemDirectoryW{TNT-ALLOW GetSystemDirectoryW}(lpBuffer, uSize)
  else begin
    SetLength(AnsiBuff, MAX_PATH);
    SetLength(AnsiBuff, GetSystemDirectoryA{TNT-ALLOW GetSystemDirectoryA}(PAnsiChar(AnsiBuff), Length(AnsiBuff)));
    Result := _HandlePathLengthResult(uSize, lpBuffer, AnsiBuff, []);
  end;
end;

function Tnt_GetCurrentDirectoryW(nBufferLength: DWORD; lpBuffer: PWideChar): DWORD;
var
  AnsiBuff: AnsiString;
begin
  if Win32PlatformIsUnicode then
    Result := GetCurrentDirectoryW{TNT-ALLOW GetCurrentDirectoryW}(nBufferLength, lpBuffer)
  else begin
    SetLength(AnsiBuff, MAX_PATH);
    SetLength(AnsiBuff, GetCurrentDirectoryA{TNT-ALLOW GetCurrentDirectoryA}(Length(AnsiBuff), PAnsiChar(AnsiBuff)));
    Result := _HandlePathLengthResult(nBufferLength, lpBuffer, AnsiBuff, [poAllowDirectoryMode, poZeroSmallBuff]);
  end;
end;

function Tnt_SetCurrentDirectoryW(lpPathName: PWideChar): BOOL;
begin
  if Win32PlatformIsUnicode then
    Result := SetCurrentDirectoryW{TNT-ALLOW SetCurrentDirectoryW}(lpPathName)
  else
    Result := SetCurrentDirectoryA{TNT-ALLOW SetCurrentDirectoryA}(PAnsiChar(AnsiString(lpPathName)));
end;

function Tnt_GetComputerNameW(lpBuffer: PWideChar; var nSize: DWORD): BOOL;
var
  AnsiBuff: AnsiString;
  AnsiBuffLen: DWORD;
begin
  if Win32PlatformIsUnicode then
    Result := GetComputerNameW{TNT-ALLOW GetComputerNameW}(lpBuffer, nSize)
  else begin
    SetLength(AnsiBuff, MAX_COMPUTERNAME_LENGTH + 1);
    AnsiBuffLen := Length(AnsiBuff);
    Result := GetComputerNameA{TNT-ALLOW GetComputerNameA}(PAnsiChar(AnsiBuff), AnsiBuffLen);
    if Result then begin
      SetLength(AnsiBuff, AnsiBuffLen);
      if (nSize <= AnsiBuffLen) or (Length(AnsiBuff) = 0) then begin
        nSize := AnsiBuffLen + 1;
        Result := False;
      end else begin
        WStrPLCopy(lpBuffer, AnsiBuff, nSize);
        nSize := WStrLen(lpBuffer);
      end;
    end;
  end;
end;

function Tnt_GetUserNameW(lpBuffer: PWideChar; var nSize: DWORD): BOOL;
var
  AnsiBuff: AnsiString;
  AnsiBuffLen: DWORD;
begin
  if Win32PlatformIsUnicode then
    Result := GetUserNameW{TNT-ALLOW GetUserNameW}(lpBuffer, nSize)
  else begin
    SetLength(AnsiBuff, 255);
    AnsiBuffLen := Length(AnsiBuff);
    Result := GetUserNameA{TNT-ALLOW GetUserNameA}(PAnsiChar(AnsiBuff), AnsiBuffLen);
    if Result then begin
      SetLength(AnsiBuff, AnsiBuffLen);
      if (nSize <= AnsiBuffLen) or (Length(AnsiBuff) = 0) then begin
        nSize := AnsiBuffLen + 1;
        Result := False;
      end else begin
        WStrPLCopy(lpBuffer, AnsiBuff, nSize);
        nSize := WStrLen(lpBuffer);
      end;
    end;
  end;
end;

function Tnt_ShellExecuteW(hWnd: HWND; Operation, FileName, Parameters,
  Directory: PWideChar; ShowCmd: Integer): HINST;
begin
  if Win32PlatformIsUnicode then
    Result := ShellExecuteW{TNT-ALLOW ShellExecuteW}(hWnd, _PWideCharWithNil(WideString(Operation)),
      FileName, Parameters,
        Directory, ShowCmd)
  else begin
    Result := ShellExecuteA{TNT-ALLOW ShellExecuteA}(hWnd, _PAnsiCharWithNil(AnsiString(Operation)),
      _PAnsiCharWithNil(AnsiString(FileName)), _PAnsiCharWithNil(AnsiString(Parameters)),
        _PAnsiCharWithNil(AnsiString(Directory)), ShowCmd)
  end;
end;

function Tnt_LoadLibraryW(lpLibFileName: PWideChar): HMODULE;
begin
  if Win32PlatformIsUnicode then
    Result := LoadLibraryW{TNT-ALLOW LoadLibraryW}(lpLibFileName)
  else
    Result := LoadLibraryA{TNT-ALLOW LoadLibraryA}(PAnsiChar(AnsiString(lpLibFileName)));
end;

function Tnt_LoadLibraryExW(lpLibFileName: PWideChar; hFile: THandle; dwFlags: DWORD): HMODULE;
begin
  if Win32PlatformIsUnicode then
    Result := LoadLibraryExW{TNT-ALLOW LoadLibraryExW}(lpLibFileName, hFile, dwFlags)
  else
    Result := LoadLibraryExA{TNT-ALLOW LoadLibraryExA}(PAnsiChar(AnsiString(lpLibFileName)), hFile, dwFlags);
end;

function Tnt_CreateProcessW(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
  lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
    bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
      lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfoW;
        var lpProcessInformation: TProcessInformation): BOOL;
var
  AnsiStartupInfo: TStartupInfoA;
begin
  if Win32PlatformIsUnicode then begin
    Result := CreateProcessW{TNT-ALLOW CreateProcessW}(lpApplicationName, lpCommandLine,
      lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment,
        lpCurrentDirectory, lpStartupInfo, lpProcessInformation)
  end else begin
    CopyMemory(@AnsiStartupInfo, @lpStartupInfo, SizeOf(TStartupInfo));
    AnsiStartupInfo.lpReserved := _PAnsiCharWithNil(AnsiString(lpStartupInfo.lpReserved));
    AnsiStartupInfo.lpDesktop := _PAnsiCharWithNil(AnsiString(lpStartupInfo.lpDesktop));
    AnsiStartupInfo.lpTitle := _PAnsiCharWithNil(AnsiString(lpStartupInfo.lpTitle));
    Result := CreateProcessA{TNT-ALLOW CreateProcessA}(_PAnsiCharWithNil(AnsiString(lpApplicationName)),
      _PAnsiCharWithNil(AnsiString(lpCommandLine)),
        lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment,
          _PAnsiCharWithNil(AnsiString(lpCurrentDirectory)), AnsiStartupInfo, lpProcessInformation);
  end;
end;

function Tnt_GetCurrencyFormatW(Locale: LCID; dwFlags: DWORD; lpValue: PWideChar;
  lpFormat: PCurrencyFmtW; lpCurrencyStr: PWideChar; cchCurrency: Integer): Integer;
const
  MAX_ANSI_BUFF_SIZE = 64; // can a currency string actually be larger?
var
  AnsiFormat: TCurrencyFmtA;
  PAnsiFormat: PCurrencyFmtA;
  AnsiBuff: AnsiString;
begin
  if Win32PlatformIsUnicode then
    Result := GetCurrencyFormatW{TNT-ALLOW GetCurrencyFormatW}(Locale, dwFlags, lpValue, lpFormat, lpCurrencyStr, cchCurrency)
  else begin
    if lpFormat = nil then
      PAnsiFormat := nil
    else begin
      ZeroMemory(@AnsiFormat, SizeOf(AnsiFormat));
      AnsiFormat.NumDigits        := lpFormat.NumDigits;
      AnsiFormat.LeadingZero      := lpFormat.LeadingZero;
      AnsiFormat.Grouping         := lpFormat.Grouping;
      AnsiFormat.lpDecimalSep     := PAnsiChar(AnsiString(lpFormat.lpDecimalSep));
      AnsiFormat.lpThousandSep    := PAnsiChar(AnsiString(lpFormat.lpThousandSep));
      AnsiFormat.NegativeOrder    := lpFormat.NegativeOrder;
      AnsiFormat.PositiveOrder    := lpFormat.PositiveOrder;
      AnsiFormat.lpCurrencySymbol := PAnsiChar(AnsiString(lpFormat.lpCurrencySymbol));
      PAnsiFormat := @AnsiFormat;
    end;
    SetLength(AnsiBuff, MAX_ANSI_BUFF_SIZE);
    SetLength(AnsiBuff, GetCurrencyFormatA{TNT-ALLOW GetCurrencyFormatA}(Locale, dwFlags,
      PAnsiChar(AnsiString(lpValue)), PAnsiFormat, PAnsiChar(AnsiBuff), MAX_ANSI_BUFF_SIZE));
    Result := _HandleStringLengthResult(cchCurrency, lpCurrencyStr, AnsiBuff, []);
  end;
end;

function Tnt_CompareStringW(Locale: LCID; dwCmpFlags: DWORD; lpString1: PWideChar;
  cchCount1: Integer; lpString2: PWideChar; cchCount2: Integer): Integer;
var
  WideStr1, WideStr2: WideString;
  AnsiStr1, AnsiStr2: AnsiString;
begin
  if Win32PlatformIsUnicode then
    Result := CompareStringW{TNT-ALLOW CompareStringW}(Locale, dwCmpFlags, lpString1, cchCount1, lpString2, cchCount2)
  else begin
    WideStr1 := _WStr(lpString1, cchCount1);
    WideStr2 := _WStr(lpString2, cchCount2);
    if (dwCmpFlags = 0) then begin
      // binary comparison
      if WideStr1 < WideStr2 then
        Result := 1
      else if WideStr1 = WideStr2 then
        Result := 2
      else
        Result := 3;
    end else begin
      AnsiStr1 := WideStr1;
      AnsiStr2 := WideStr2;
      Result := CompareStringA{TNT-ALLOW CompareStringA}(Locale, dwCmpFlags,
        PAnsiChar(AnsiStr1), -1, PAnsiChar(AnsiStr2), -1);
    end;
  end;
end;

function Tnt_CharUpperW(lpsz: PWideChar): PWideChar;
var
  AStr: AnsiString;
  WStr: WideString;
begin
  if Win32PlatformIsUnicode then
    Result := CharUpperW{TNT-ALLOW CharUpperW}(lpsz)
  else begin
    if HiWord(Cardinal(lpsz)) = 0 then begin
      // literal char mode
      Result := lpsz;
      if IsWideCharMappableToAnsi(WideChar(lpsz)) then begin
        AStr := WideChar(lpsz); // single character may be more than one byte
        CharUpperA{TNT-ALLOW CharUpperA}(PAnsiChar(AStr));
        WStr := AStr; // should always be single wide char
        if Length(WStr) = 1 then
          Result := PWideChar(WStr[1]);
      end
    end else begin
      // null-terminated string mode
      Result := lpsz;
      while lpsz^ <> #0 do begin
        lpsz^ := WideChar(Tnt_CharUpperW(PWideChar(lpsz^)));
        Inc(lpsz);
      end;
    end;
  end;
end;

function Tnt_CharUpperBuffW(lpsz: PWideChar; cchLength: DWORD): DWORD;
var
  i: integer;
begin
  if Win32PlatformIsUnicode then
    Result := CharUpperBuffW{TNT-ALLOW CharUpperBuffW}(lpsz, cchLength)
  else begin
    Result := cchLength;
    for i := 1 to cchLength do begin
      lpsz^ := WideChar(Tnt_CharUpperW(PWideChar(lpsz^)));
      Inc(lpsz);
    end;
  end;
end;

function Tnt_CharLowerW(lpsz: PWideChar): PWideChar;
var
  AStr: AnsiString;
  WStr: WideString;
begin
  if Win32PlatformIsUnicode then
    Result := CharLowerW{TNT-ALLOW CharLowerW}(lpsz)
  else begin
    if HiWord(Cardinal(lpsz)) = 0 then begin
      // literal char mode
      Result := lpsz;
      if IsWideCharMappableToAnsi(WideChar(lpsz)) then begin
        AStr := WideChar(lpsz); // single character may be more than one byte
        CharLowerA{TNT-ALLOW CharLowerA}(PAnsiChar(AStr));
        WStr := AStr; // should always be single wide char
        if Length(WStr) = 1 then
          Result := PWideChar(WStr[1]);
      end
    end else begin
      // null-terminated string mode
      Result := lpsz;
      while lpsz^ <> #0 do begin
        lpsz^ := WideChar(Tnt_CharLowerW(PWideChar(lpsz^)));
        Inc(lpsz);
      end;
    end;
  end;
end;