tntwindows.pas

TNT Components Source

function Tnt_GetFileVersionInfoSizeW(lptstrFilename: PWideChar; var lpdwHandle: DWORD): DWORD;

{TNT-WARN GetFileVersionInfo}
{TNT-WARN GetFileVersionInfoA}
{TNT-WARN GetFileVersionInfoW}
function Tnt_GetFileVersionInfoW(lptstrFilename: PWideChar; dwHandle, dwLen: DWORD;
  lpData: Pointer): BOOL;

const
  VQV_FIXEDFILEINFO = '\';
  VQV_VARFILEINFO_TRANSLATION = '\VarFileInfo\Translation';
  VQV_STRINGFILEINFO = '\StringFileInfo';

  VER_COMMENTS         = 'Comments';
  VER_INTERNALNAME     = 'InternalName';
  VER_PRODUCTNAME      = 'ProductName';
  VER_COMPANYNAME      = 'CompanyName';
  VER_LEGALCOPYRIGHT   = 'LegalCopyright';
  VER_PRODUCTVERSION   = 'ProductVersion';
  VER_FILEDESCRIPTION  = 'FileDescription';
  VER_LEGALTRADEMARKS  = 'LegalTrademarks';
  VER_PRIVATEBUILD     = 'PrivateBuild';
  VER_FILEVERSION      = 'FileVersion';
  VER_ORIGINALFILENAME = 'OriginalFilename';
  VER_SPECIALBUILD     = 'SpecialBuild';

{TNT-WARN VerQueryValue}
{TNT-WARN VerQueryValueA}
{TNT-WARN VerQueryValueW}
function Tnt_VerQueryValueW(pBlock: Pointer; lpSubBlock: PWideChar;
  var lplpBuffer: Pointer; var puLen: UINT): BOOL;

type
  TSHNameMappingHeaderA = record
   cNumOfMappings: Cardinal;
   lpNM: PSHNAMEMAPPINGA;
  end;
  PSHNameMappingHeaderA = ^TSHNameMappingHeaderA;

  TSHNameMappingHeaderW = record
   cNumOfMappings: Cardinal;
   lpNM: PSHNAMEMAPPINGW;
  end;
  PSHNameMappingHeaderW = ^TSHNameMappingHeaderW;

{TNT-WARN SHFileOperation}
{TNT-WARN SHFileOperationA}
{TNT-WARN SHFileOperationW} // <-- no stub on early Windows 95
function Tnt_SHFileOperationW(var lpFileOp: TSHFileOpStructW): Integer;

{TNT-WARN SHFreeNameMappings}
procedure Tnt_SHFreeNameMappings(hNameMappings: THandle);

{TNT-WARN SHBrowseForFolder}
{TNT-WARN SHBrowseForFolderA}
{TNT-WARN SHBrowseForFolderW} // <-- no stub on early Windows 95
function Tnt_SHBrowseForFolderW(var lpbi: TBrowseInfoW): PItemIDList;

{TNT-WARN SHGetPathFromIDList}
{TNT-WARN SHGetPathFromIDListA}
{TNT-WARN SHGetPathFromIDListW} // <-- no stub on early Windows 95
function Tnt_SHGetPathFromIDListW(pidl: PItemIDList; pszPath: PWideChar): BOOL;

{TNT-WARN SHGetFileInfo}
{TNT-WARN SHGetFileInfoA}
{TNT-WARN SHGetFileInfoW} // <-- no stub on early Windows 95
function Tnt_SHGetFileInfoW(pszPath: PWideChar; dwFileAttributes: DWORD;
  var psfi: TSHFileInfoW; cbFileInfo, uFlags: UINT): DWORD;

// ......... introduced .........
function Tnt_Is_IntResource(ResStr: LPCWSTR): Boolean;

function LANGIDFROMLCID(lcid: LCID): WORD;
function MAKELANGID(usPrimaryLanguage, usSubLanguage: WORD): WORD;
function MAKELCID(wLanguageID: WORD; wSortID: WORD = SORT_DEFAULT): LCID;
function PRIMARYLANGID(lgid: WORD): WORD;
function SORTIDFROMLCID(lcid: LCID): WORD;
function SUBLANGID(lgid: WORD): WORD;

implementation

uses
  SysUtils, Math, TntSysUtils,
  {$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} TntWideStrUtils;

function _PAnsiCharWithNil(const S: AnsiString): PAnsiChar;
begin
  if S = '' then
    Result := nil {Win9x needs nil for some parameters instead of empty strings}
  else
    Result := PAnsiChar(S);
end;

function _PWideCharWithNil(const S: WideString): PWideChar;
begin
  if S = '' then
    Result := nil {Win9x needs nil for some parameters instead of empty strings}
  else
    Result := PWideChar(S);
end;

function _WStr(lpString: PWideChar; cchCount: Integer): WideString;
begin
  if cchCount = -1 then
    Result := lpString
  else
    Result := Copy(WideString(lpString), 1, cchCount);
end;

procedure _MakeWideWin32FindData(var WideFindData: TWIN32FindDataW; AnsiFindData: TWIN32FindDataA);
begin
  CopyMemory(@WideFindData, @AnsiFindData,
    Integer(@WideFindData.cFileName) - Integer(@WideFindData));
  WStrPCopy(WideFindData.cFileName, AnsiFindData.cFileName);
  WStrPCopy(WideFindData.cAlternateFileName, AnsiFindData.cAlternateFileName);
end;

function Tnt_SetWindowTextW(hWnd: HWND; lpString: PWideChar): BOOL;
begin
  if Win32PlatformIsUnicode then
    Result := SetWindowTextW{TNT-ALLOW SetWindowTextW}(hWnd, lpString)
  else
    Result := SetWindowTextA{TNT-ALLOW SetWindowTextA}(hWnd, PAnsiChar(AnsiString(lpString)));
end;

//-----------------------------

type
  TPathLengthResultOption = (poAllowDirectoryMode, poZeroSmallBuff, poExactCopy, poExactCopySubPaths);
  TPathLengthResultOptions = set of TPathLengthResultOption;

procedure _ExactStrCopyW(pDest, pSource: PWideChar; Count: Integer);
var
  i: integer;
begin
  for i := 1 to Count do begin
    pDest^ := pSource^;
    Inc(PSource);
    Inc(pDest);
  end;
end;

procedure _ExactCopySubPaths(pDest, pSource: PWideChar; Count: Integer);
var
  i: integer;
  OriginalSource: PWideChar;
  PNextSlash: PWideChar;
begin
  if Count >= 4 then begin
    OriginalSource := pSource;
    PNextSlash := WStrScan(pSource, '\');
    for i := 1 to Count - 1 do begin
      // determine next path delimiter
      if pSource > pNextSlash then begin
        PNextSlash := WStrScan(pSource, '\');
      end;
      // leave if no more sub paths
      if (PNextSlash = nil)
      or ((pNextSlash - OriginalSource) >= Count) then begin
        exit;
      end;
      // copy char
      pDest^ := pSource^;
      Inc(PSource);
      Inc(pDest);
    end;
  end;
end;

function _HandlePathLengthResult(nBufferLength: DWORD; lpBuffer: PWideChar; const AnsiBuff: AnsiString; Options: TPathLengthResultOptions): Integer;
var
  WideBuff: WideString;
begin
  WideBuff := AnsiBuff;
  if nBufferLength > Cardinal(Length(WideBuff)) then begin
    // normal
    Result := Length(WideBuff);
    WStrLCopy(lpBuffer, PWideChar(WideBuff), nBufferLength);
  end else if (poExactCopy in Options) then begin
    // exact
    Result := nBufferLength;
    _ExactStrCopyW(lpBuffer, PWideChar(WideBuff), nBufferLength);
  end else begin
    // other
    if (poAllowDirectoryMode in Options)
    and (nBufferLength = Cardinal(Length(WideBuff))) then begin
      Result := Length(WideBuff) + 1;
      WStrLCopy(lpBuffer, PWideChar(WideBuff), nBufferLength - 1);
    end else begin
      Result := Length(WideBuff) + 1;
      if (nBufferLength > 0) then begin
        if (poZeroSmallBuff in Options) then
          lpBuffer^ := #0
        else if (poExactCopySubPaths in Options) then
          _ExactCopySubPaths(lpBuffer, PWideChar(WideBuff), nBufferLength);
      end;
    end;
  end;
end;

function _HandleStringLengthResult(nBufferLength: DWORD; lpBuffer: PWideChar; const AnsiBuff: AnsiString; Options: TPathLengthResultOptions): Integer;
var
  WideBuff: WideString;
begin
  WideBuff := AnsiBuff;
  if nBufferLength >= Cardinal(Length(WideBuff)) then begin
    // normal
    Result := Length(WideBuff);
    WStrLCopy(lpBuffer, PWideChar(WideBuff), nBufferLength);
  end else if nBufferLength = 0 then
    Result := Length(WideBuff)
  else
    Result := 0;
end;

//-------------------------------------------

function Tnt_RemoveDirectoryW(lpPathName: PWideChar): BOOL;
begin
  if Win32PlatformIsUnicode then
    Result := RemoveDirectoryW{TNT-ALLOW RemoveDirectoryW}(PWideChar(lpPathName))
  else
    Result := RemoveDirectoryA{TNT-ALLOW RemoveDirectoryA}(PAnsiChar(AnsiString(lpPathName)));
end;

function Tnt_GetShortPathNameW(lpszLongPath: PWideChar; lpszShortPath: PWideChar;
  cchBuffer: DWORD): DWORD;
var
  AnsiBuff: AnsiString;
begin
  if Win32PlatformIsUnicode then
    Result := GetShortPathNameW{TNT-ALLOW GetShortPathNameW}(lpszLongPath, lpszShortPath, cchBuffer)
  else begin
    SetLength(AnsiBuff, MAX_PATH * 2);
    SetLength(AnsiBuff, GetShortPathNameA{TNT-ALLOW GetShortPathNameA}(PAnsiChar(AnsiString(lpszLongPath)),
      PAnsiChar(AnsiBuff), Length(AnsiBuff)));
    Result := _HandlePathLengthResult(cchBuffer, lpszShortPath, AnsiBuff, [poExactCopySubPaths]);
  end;
end;

function Tnt_GetFullPathNameW(lpFileName: PWideChar; nBufferLength: DWORD;
  lpBuffer: PWideChar; var lpFilePart: PWideChar): DWORD;
var
  AnsiBuff: AnsiString;
  AnsiFilePart: PAnsiChar;
  AnsiLeadingChars: Integer;
  WideLeadingChars: Integer;
begin
  if Win32PlatformIsUnicode then
    Result := GetFullPathNameW{TNT-ALLOW GetFullPathNameW}(lpFileName, nBufferLength, lpBuffer, lpFilePart)
  else begin
    SetLength(AnsiBuff, MAX_PATH * 2);
    SetLength(AnsiBuff, GetFullPathNameA{TNT-ALLOW GetFullPathNameA}(PAnsiChar(AnsiString(lpFileName)),
      Length(AnsiBuff), PAnsiChar(AnsiBuff), AnsiFilePart));
    Result := _HandlePathLengthResult(nBufferLength, lpBuffer, AnsiBuff, [poZeroSmallBuff]);
    // deal w/ lpFilePart
    if (AnsiFilePart = nil) or (nBufferLength < Result) then
      lpFilePart := nil
    else begin
      AnsiLeadingChars := AnsiFilePart - PAnsiChar(AnsiBuff);
      WideLeadingChars := Length(WideString(Copy(AnsiBuff, 1, AnsiLeadingChars)));
      lpFilePart := lpBuffer + WideLeadingChars;
    end;
  end;
end;

function Tnt_CreateFileW(lpFileName: PWideChar; dwDesiredAccess, dwShareMode: DWORD;
  lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD;
    hTemplateFile: THandle): THandle;
begin
  if Win32PlatformIsUnicode then
    Result := CreateFileW{TNT-ALLOW CreateFileW}(lpFileName, dwDesiredAccess, dwShareMode,
      lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
  else
    Result := CreateFileA{TNT-ALLOW CreateFileA}(PAnsiChar(AnsiString(lpFileName)), dwDesiredAccess, dwShareMode,
      lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
end;

function Tnt_FindFirstFileW(lpFileName: PWideChar; var lpFindFileData: TWIN32FindDataW): THandle;
var
  Ansi_lpFindFileData: TWIN32FindDataA;
begin
  if Win32PlatformIsUnicode then
    Result := FindFirstFileW{TNT-ALLOW FindFirstFileW}(lpFileName, lpFindFileData)
  else begin
    Result := FindFirstFileA{TNT-ALLOW FindFirstFileA}(PAnsiChar(AnsiString(lpFileName)),
      Ansi_lpFindFileData);
    if Result <> INVALID_HANDLE_VALUE then
      _MakeWideWin32FindData(lpFindFileData, Ansi_lpFindFileData);
  end;
end;

function Tnt_FindNextFileW(hFindFile: THandle; var lpFindFileData: TWIN32FindDataW): BOOL;
var
  Ansi_lpFindFileData: TWIN32FindDataA;
begin
  if Win32PlatformIsUnicode then
    Result := FindNextFileW{TNT-ALLOW FindNextFileW}(hFindFile, lpFindFileData)
  else begin
    Result := FindNextFileA{TNT-ALLOW FindNextFileA}(hFindFile, Ansi_lpFindFileData);
    if Result then
      _MakeWideWin32FindData(lpFindFileData, Ansi_lpFindFileData);
  end;
end;

function Tnt_GetFileAttributesW(lpFileName: PWideChar): DWORD;
begin
  if Win32PlatformIsUnicode then
    Result := GetFileAttributesW{TNT-ALLOW GetFileAttributesW}(lpFileName)
  else
    Result := GetFileAttributesA{TNT-ALLOW GetFileAttributesA}(PAnsiChar(AnsiString(lpFileName)));
end;

function Tnt_SetFileAttributesW(lpFileName: PWideChar; dwFileAttributes: DWORD): BOOL;
begin
  if Win32PlatformIsUnicode then
    Result := SetFileAttributesW{TNT-ALLOW SetFileAttributesW}(lpFileName, dwFileAttributes)
  else
    Result := SetFileAttributesA{TNT-ALLOW SetFileAttributesA}(PAnsiChar(AnsiString(lpFileName)), dwFileAttributes);
end;

function Tnt_CreateDirectoryW(lpPathName: PWideChar;
  lpSecurityAttributes: PSecurityAttributes): BOOL;
begin
  if Win32PlatformIsUnicode then
    Result := CreateDirectoryW{TNT-ALLOW CreateDirectoryW}(lpPathName, lpSecurityAttributes)
  else
    Result := CreateDirectoryA{TNT-ALLOW CreateDirectoryA}(PAnsiChar(AnsiString(lpPathName)), lpSecurityAttributes);
end;

function Tnt_MoveFileW(lpExistingFileName, lpNewFileName: PWideChar): BOOL;
begin
  if Win32PlatformIsUnicode then
    Result := MoveFileW{TNT-ALLOW MoveFileW}(lpExistingFileName, lpNewFileName)
  else
    Result := MoveFileA{TNT-ALLOW MoveFileA}(PAnsiChar(AnsiString(lpExistingFileName)), PAnsiChar(AnsiString(lpNewFileName)));
end;

function Tnt_CopyFileW(lpExistingFileName, lpNewFileName: PWideChar; bFailIfExists: BOOL): BOOL;
begin
  if Win32PlatformIsUnicode then
    Result := CopyFileW{TNT-ALLOW CopyFileW}(lpExistingFileName, lpNewFileName, bFailIfExists)
  else
    Result := CopyFileA{TNT-ALLOW CopyFileA}(PAnsiChar(AnsiString(lpExistingFileName)),
      PAnsiChar(AnsiString(lpNewFileName)), bFailIfExists);
end;

function Tnt_DeleteFileW(lpFileName: PWideChar): BOOL;
begin
  if Win32PlatformIsUnicode then
    Result := DeleteFileW{TNT-ALLOW DeleteFileW}(lpFileName)
  else
    Result := DeleteFileA{TNT-ALLOW DeleteFileA}(PAnsiChar(AnsiString(lpFileName)));
end;

function Tnt_DrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer;
  var lpRect: TRect; uFormat: UINT): Integer;
begin
  if Win32PlatformIsUnicode then
    Result := DrawTextW{TNT-ALLOW DrawTextW}(hDC, lpString, nCount, lpRect, uFormat)
  else
    Result := DrawTextA{TNT-ALLOW DrawTextA}(hDC,
      PAnsiChar(AnsiString(_WStr(lpString, nCount))), -1, lpRect, uFormat);
end;