tntwindows.pas

TNT Components Source

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

function Tnt_GetStringTypeExW(Locale: LCID; dwInfoType: DWORD;
  lpSrcStr: PWideChar; cchSrc: Integer; var lpCharType): BOOL; 
var
  AStr: AnsiString;
begin
  if Win32PlatformIsUnicode then
    Result := GetStringTypeExW{TNT-ALLOW GetStringTypeExW}(Locale, dwInfoType, lpSrcStr, cchSrc, lpCharType)
  else begin
    AStr := _WStr(lpSrcStr, cchSrc);
    Result := GetStringTypeExA{TNT-ALLOW GetStringTypeExA}(Locale, dwInfoType,
      PAnsiChar(AStr), -1, lpCharType);
  end;
end;

function Win9x_LoadStringW(hInstance: HINST; uID: UINT; lpBuffer: PWideChar; nBufferMax: Integer): Integer;
// This function originated by the WINE Project.
//   It was translated to Pascal by Francisco Leong.
//     It was further modified by Troy Wolbrink.
var
  hmem: HGLOBAL;
  hrsrc: THandle;
  p: PWideChar;
  string_num, i: Integer;
  block: Integer;
begin
  Result := 0;
  // Netscape v3 fix...
  if (HIWORD(uID) = $FFFF) then begin
    uID := UINT(-(Integer(uID)));
  end;
  // figure block, string_num
  block := ((uID shr 4) and $FFFF) + 1; // bits 4 - 19, mask out bits 20 - 31, inc by 1
  string_num := uID and $000F;
  // get handle & pointer to string block
  hrsrc := FindResource{TNT-ALLOW FindResource}(hInstance, MAKEINTRESOURCE(block), RT_STRING);
  if (hrsrc <> 0) then
  begin
    hmem := LoadResource(hInstance, hrsrc);
    if (hmem <> 0) then
    begin
      p := LockResource(hmem);
      // walk the block to the requested string
      for i := 0 to string_num - 1 do begin
        p := p + Integer(p^) + 1;
      end;
      Result := Integer(p^); { p points to the length of string }
      Inc(p); { p now points to the actual string }
      if (lpBuffer <> nil) and (nBufferMax > 0) then
      begin
        Result := min(nBufferMax - 1, Result); { max length to copy }
        if (Result > 0) then begin
          CopyMemory(lpBuffer, p, Result * sizeof(WideChar));
        end;
        lpBuffer[Result] := WideChar(0); { null terminate }
      end;
    end;
  end;
end;

function Tnt_LoadStringW(hInstance: HINST; uID: UINT; lpBuffer: PWideChar; nBufferMax: Integer): Integer;
begin
  if Win32PlatformIsUnicode then
    Result := Windows.LoadStringW{TNT-ALLOW LoadStringW}(hInstance, uID, lpBuffer, nBufferMax)
  else
    Result := Win9x_LoadStringW(hInstance, uID, lpBuffer, nBufferMax);
end;

function Tnt_InsertMenuItemW(hMenu: HMENU; uItem: DWORD; fByPosition: BOOL; lpmii: TMenuItemInfoW): BOOL;
begin
  if Win32PlatformIsUnicode then
    Result := InsertMenuItemW{TNT-ALLOW InsertMenuItemW}(hMenu, uItem, fByPosition, lpmii)
  else begin
    TMenuItemInfoA(lpmii).dwTypeData := PAnsiChar(AnsiString(lpmii.dwTypeData));
    Result := InsertMenuItemA{TNT-ALLOW InsertMenuItemA}(hMenu, uItem, fByPosition, TMenuItemInfoA(lpmii));
  end;
end;

function Tnt_ExtractIconExW(lpszFile: PWideChar; nIconIndex: Integer;
  var phiconLarge, phiconSmall: HICON; nIcons: UINT): UINT;
begin
  if Win32PlatformIsUnicode then
    Result := ExtractIconExW{TNT-ALLOW ExtractIconExW}(lpszFile,
      nIconIndex, phiconLarge, phiconSmall, nIcons)
  else
    Result := ExtractIconExA{TNT-ALLOW ExtractIconExA}(PAnsiChar(AnsiString(lpszFile)),
      nIconIndex, phiconLarge, phiconSmall, nIcons);
end;

function Tnt_ExtractAssociatedIconW(hInst: HINST; lpIconPath: PWideChar;
  var lpiIcon: Word): HICON;
begin
  if Win32PlatformIsUnicode then
    Result := ExtractAssociatedIconW{TNT-ALLOW ExtractAssociatedIconW}(hInst, lpIconPath, lpiIcon)
  else
    Result := ExtractAssociatedIconA{TNT-ALLOW ExtractAssociatedIconA}(hInst,
      PAnsiChar(AnsiString(lpIconPath)), lpiIcon)
end;

function Tnt_GetFileVersionInfoSizeW(lptstrFilename: PWideChar; var lpdwHandle: DWORD): DWORD;
begin
  if Win32PlatformIsUnicode then
    Result := GetFileVersionInfoSizeW{TNT-ALLOW GetFileVersionInfoSizeW}(lptstrFilename, lpdwHandle)
  else
    Result := GetFileVersionInfoSizeA{TNT-ALLOW GetFileVersionInfoSizeA}(PAnsiChar(AnsiString(lptstrFilename)), lpdwHandle);
end;

function Tnt_GetFileVersionInfoW(lptstrFilename: PWideChar; dwHandle, dwLen: DWORD;
  lpData: Pointer): BOOL;
begin
  if Win32PlatformIsUnicode then
    Result := GetFileVersionInfoW{TNT-ALLOW GetFileVersionInfoW}(lptstrFilename, dwHandle, dwLen, lpData)
  else
    Result := GetFileVersionInfoA{TNT-ALLOW GetFileVersionInfoA}(PAnsiChar(AnsiString(lptstrFilename)), dwHandle, dwLen, lpData);
end;

var
  Last_VerQueryValue_String: WideString;

function Tnt_VerQueryValueW(pBlock: Pointer; lpSubBlock: PWideChar;
  var lplpBuffer: Pointer; var puLen: UINT): BOOL;
var
  AnsiBuff: AnsiString;
begin
  if Win32PlatformIsUnicode then
    Result := VerQueryValueW{TNT-ALLOW VerQueryValueW}(pBlock, lpSubBlock, lplpBuffer, puLen)
  else begin
    Result := VerQueryValueA{TNT-ALLOW VerQueryValueA}(pBlock, PAnsiChar(AnsiString(lpSubBlock)), lplpBuffer, puLen);
    if WideTextPos(VQV_STRINGFILEINFO, lpSubBlock) <> 1 then
    else begin
      {  /StringFileInfo, convert ansi result to unicode }
      SetString(AnsiBuff, PAnsiChar(lplpBuffer), puLen);
      Last_VerQueryValue_String := AnsiBuff;
      lplpBuffer := PWideChar(Last_VerQueryValue_String);
      puLen := Length(Last_VerQueryValue_String);
    end;
  end;
end;

//---------------------------------------------------------------------------------------
//  Wide functions from Shell32.dll should be loaded dynamically (no stub on early Win95)
//---------------------------------------------------------------------------------------

type
  TSHFileOperationW = function(var lpFileOp: TSHFileOpStructW): Integer; stdcall;
  TSHBrowseForFolderW = function(var lpbi: TBrowseInfoW): PItemIDList; stdcall;
  TSHGetPathFromIDListW = function(pidl: PItemIDList; pszPath: PWideChar): BOOL; stdcall;
  TSHGetFileInfoW = function(pszPath: PWideChar; dwFileAttributes: DWORD;
    var psfi: TSHFileInfoW; cbFileInfo, uFlags: UINT): DWORD; stdcall;

var
  Safe_SHFileOperationW: TSHFileOperationW = nil;
  Safe_SHBrowseForFolderW: TSHBrowseForFolderW = nil;
  Safe_SHGetPathFromIDListW: TSHGetPathFromIDListW = nil;
  Safe_SHGetFileInfoW: TSHGetFileInfoW = nil;

var Shell32DLL: HModule = 0;

procedure LoadWideShell32Procs;
begin
  if Shell32DLL = 0 then begin
    Shell32DLL := WinCheckH(Tnt_LoadLibraryW('shell32.dll'));
    Safe_SHFileOperationW := WinCheckP(GetProcAddress(Shell32DLL, 'SHFileOperationW'));
    Safe_SHBrowseForFolderW := WinCheckP(GetProcAddress(Shell32DLL, 'SHBrowseForFolderW'));
    Safe_SHGetPathFromIDListW := WinCheckP(GetProcAddress(Shell32DLL, 'SHGetPathFromIDListW'));
    Safe_SHGetFileInfoW := WinCheckP(GetProcAddress(Shell32DLL, 'SHGetFileInfoW'));
  end;
end;

function Tnt_SHFileOperationW(var lpFileOp: TSHFileOpStructW): Integer;
var
  AnsiFileOp: TSHFileOpStructA;
  MapCount: Integer;
  PAnsiMap: PSHNameMappingA;
  PWideMap: PSHNameMappingW;
  OldPath: WideString;
  NewPath: WideString;
  i: integer;
begin
  if Win32PlatformIsUnicode then begin
    LoadWideShell32Procs;
    Result := Safe_SHFileOperationW(lpFileOp);
  end else begin
    AnsiFileOp := TSHFileOpStructA(lpFileOp);
    // convert PChar -> PWideChar
    if lpFileOp.pFrom = nil then
      AnsiFileOp.pFrom := nil
    else
      AnsiFileOp.pFrom := PAnsiChar(AnsiString(ExtractStringArrayStr(lpFileOp.pFrom)));
    if lpFileOp.pTo = nil then
      AnsiFileOp.pTo := nil
    else
      AnsiFileOp.pTo := PAnsiChar(AnsiString(ExtractStringArrayStr(lpFileOp.pTo)));
    AnsiFileOp.lpszProgressTitle := PAnsiChar(AnsiString(lpFileOp.lpszProgressTitle));
    Result := SHFileOperationA{TNT-ALLOW SHFileOperationA}(AnsiFileOp);
    // return struct results
    lpFileOp.fAnyOperationsAborted := AnsiFileOp.fAnyOperationsAborted;
    lpFileOp.hNameMappings := nil;
    if (AnsiFileOp.hNameMappings <> nil)
    and ((FOF_WANTMAPPINGHANDLE and AnsiFileOp.fFlags) <> 0) then begin
      // alloc mem
      MapCount := PSHNameMappingHeaderA(AnsiFileOp.hNameMappings).cNumOfMappings;
      lpFileOp.hNameMappings :=
        AllocMem(SizeOf({hNameMappings}Cardinal) + SizeOf(TSHNameMappingW) * MapCount);
      PSHNameMappingHeaderW(lpFileOp.hNameMappings).cNumOfMappings := MapCount;
      // init pointers
      PAnsiMap := PSHNameMappingHeaderA(AnsiFileOp.hNameMappings).lpNM;
      PWideMap := PSHNameMappingHeaderW(lpFileOp.hNameMappings).lpNM;
      for i := 1 to MapCount do begin
        // old path
        OldPath := Copy(PAnsiMap.pszOldPath, 1, PAnsiMap.cchOldPath);
        PWideMap.pszOldPath := WStrNew(PWideChar(OldPath));
        PWideMap.cchOldPath := WStrLen(PWideMap.pszOldPath);
        // new path
        NewPath := Copy(PAnsiMap.pszNewPath, 1, PAnsiMap.cchNewPath);
        PWideMap.pszNewPath := WStrNew(PWideChar(NewPath));
        PWideMap.cchNewPath := WStrLen(PWideMap.pszNewPath);
        // next record
        Inc(PAnsiMap);
        Inc(PWideMap);
      end;
    end;
  end;
end;

procedure Tnt_SHFreeNameMappings(hNameMappings: THandle);
var
  i: integer;
  MapCount: Integer;
  PWideMap: PSHNameMappingW;
begin
  if Win32PlatformIsUnicode then
    SHFreeNameMappings{TNT-ALLOW SHFreeNameMappings}(hNameMappings)
  else begin
    // free strings
    MapCount := PSHNameMappingHeaderW(hNameMappings).cNumOfMappings;
    PWideMap := PSHNameMappingHeaderW(hNameMappings).lpNM;
    for i := 1 to MapCount do begin
      WStrDispose(PWideMap.pszOldPath);
      WStrDispose(PWideMap.pszNewPath);
      Inc(PWideMap);
    end;
    // free struct
    FreeMem(Pointer(hNameMappings));
  end;
end;

function Tnt_SHBrowseForFolderW(var lpbi: TBrowseInfoW): PItemIDList;
var
  AnsiInfo: TBrowseInfoA;
  AnsiBuffer: array[0..MAX_PATH] of AnsiChar;
begin
  if Win32PlatformIsUnicode then begin
    LoadWideShell32Procs;
    Result := Safe_SHBrowseForFolderW(lpbi);
  end else begin
    AnsiInfo := TBrowseInfoA(lpbi);
    AnsiInfo.lpszTitle := PAnsiChar(AnsiString(lpbi.lpszTitle));
    if lpbi.pszDisplayName <> nil then
      AnsiInfo.pszDisplayName := AnsiBuffer;
    Result := SHBrowseForFolderA{TNT-ALLOW SHBrowseForFolderA}(AnsiInfo);
    if lpbi.pszDisplayName <> nil then
      WStrPCopy(lpbi.pszDisplayName, AnsiInfo.pszDisplayName);
    lpbi.iImage := AnsiInfo.iImage;
  end;
end;

function Tnt_SHGetPathFromIDListW(pidl: PItemIDList; pszPath: PWideChar): BOOL;
var
  AnsiPath: AnsiString;
begin
  if Win32PlatformIsUnicode then begin
    LoadWideShell32Procs;
    Result := Safe_SHGetPathFromIDListW(pidl, pszPath);
  end else begin
    SetLength(AnsiPath, MAX_PATH);
    Result := SHGetPathFromIDListA{TNT-ALLOW SHGetPathFromIDListA}(pidl, PAnsiChar(AnsiPath));
    if Result then
      WStrPCopy(pszPath, PAnsiChar(AnsiPath))
  end;
end;

function Tnt_SHGetFileInfoW(pszPath: PWideChar; dwFileAttributes: DWORD;
  var psfi: TSHFileInfoW; cbFileInfo, uFlags: UINT): DWORD;
var
  SHFileInfoA: TSHFileInfoA;
begin
  if Win32PlatformIsUnicode then begin
    LoadWideShell32Procs;
    Result := Safe_SHGetFileInfoW(pszPath, dwFileAttributes, psfi, cbFileInfo, uFlags)
  end else begin
    Result := SHGetFileInfoA{TNT-ALLOW SHGetFileInfoA}(PAnsiChar(AnsiString(pszPath)),
      dwFileAttributes, SHFileInfoA, SizeOf(TSHFileInfoA), uFlags);
    // update pfsi...
    ZeroMemory(@psfi, SizeOf(TSHFileInfoW));
    psfi.hIcon := SHFileInfoA.hIcon;
    psfi.iIcon := SHFileInfoA.iIcon;
    psfi.dwAttributes := SHFileInfoA.dwAttributes;
    WStrPLCopy(psfi.szDisplayName, SHFileInfoA.szDisplayName, MAX_PATH);
    WStrPLCopy(psfi.szTypeName, SHFileInfoA.szTypeName, 80);
  end;
end;


function Tnt_Is_IntResource(ResStr: LPCWSTR): Boolean;
begin
  Result := HiWord(Cardinal(ResStr)) = 0;
end;

function LANGIDFROMLCID(lcid: LCID): WORD;
begin
  Result := LoWord(lcid);
end;

function MAKELANGID(usPrimaryLanguage, usSubLanguage: WORD): WORD;
begin
  Result := (usSubLanguage shl 10) or usPrimaryLanguage;
end;

function MAKELCID(wLanguageID: WORD; wSortID: WORD = SORT_DEFAULT): LCID;
begin
  Result := MakeLong(wLanguageID, wSortID);
end;

function PRIMARYLANGID(lgid: WORD): WORD;
begin
  Result := lgid and $03FF;
end;

function SORTIDFROMLCID(lcid: LCID): WORD;
begin
  Result := HiWord(lcid);
end;

function SUBLANGID(lgid: WORD): WORD;
begin
  Result := lgid shr 10;
end;

initialization

finalization
  if Shell32DLL <> 0 then
    FreeLibrary(Shell32DLL);

end.