[fpc-pascal]Win32: converting lptstr to string

Nikolai Zhubr s001 at hotbox.ru
Tue Apr 27 00:58:08 CEST 2004


Hi,
Monday, 26 April, 2004, 23:25:07, Inpromptu  wrote:
>  Hi:
 
>  I was looking the demo sources, and I found c:\pp\demo\win32\edit.pp VERY interesting. So, i decide to try shBrowseForFolder instead of GetOpenFilename, but I don't know wath I'm doing wrong...
 
>  This is my humble little program... be nice with the criticims... !
 
>  {----------begin of program------------}
>  program myprogram;
>  uses windows;
>   const
>       COINIT_APARTMENTTHREADED=2;{from
>  http://msdn.microsoft.com/library/default.asp?url=/library/en-us/com/htm/cme_a2d_4oqc.asp }
 
>  var 
>     myDir:browseinfo; {from
>  http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/structures/browseinfo.asp }
[trim]
Ok, enough advertising microsoft.com for now... ;-)
See some working example below, hope it helps.
Don't forget to specify -Sd option.
-- 
Best regards,
 Nikolai Zhubr

program SelDir;

const
  shell32 = 'shell32.dll';
  S_OK    = $00000000;
  MAX_PATH = 260;
  BIF_RETURNONLYFSDIRS   = $0001;

type
  HWND = LongInt;
  BOOL = LongBool;

  PItemIDList = pointer;

  TBrowseinfo = record
    hwndOwner: HWND;
    pidlRoot: PItemIDList;
    pszDisplayName: PAnsiChar;  { Return display name of item selected. }
    lpszTitle: PAnsiChar;      { text to go in the banner over the tree. }
    ulFlags: longint;           { Flags that control the return stuff }
    lpfn: pointer;
    lParam: longint;          { extra info that's passed back in callbacks }
    iImage: longint;         { output var: where to return the Image index. }
  end;

  __IMalloc_Alloc   = function (__Self: pointer; cb: Longint): Pointer; stdcall;
  __IMalloc_Realloc = function (__Self: pointer; pv: Pointer; cb: Longint): Pointer; stdcall;
  __IMalloc_Free    = procedure(__Self: pointer; pv: Pointer); stdcall;

  IMalloc = ^__IMalloc2;
  __IMalloc2 = ^__IMalloc;
  __IMalloc = record
    rsrv1, rsrv2, rsrv3: longint;
    Alloc: __IMalloc_Alloc;
    Realloc: __IMalloc_Realloc;
    Free: __IMalloc_Free;
  end;

function SHBrowseForFolder(var lpbi: TBrowseInfo): PItemIDList; stdcall;
  external shell32 name 'SHBrowseForFolderA';
function SHGetPathFromIDList(pidl: PItemIDList; pszPath: PChar): BOOL; stdcall;
  external shell32 name 'SHGetPathFromIDListA';
function SHGetMalloc(var ppMalloc: IMalloc): longint; stdcall;
  external shell32 name 'SHGetMalloc';

function SelectDirectory(const Caption: string; const Root: String): string;
var
  BrowseInfo: TBrowseInfo;
  Buffer: PChar;
  ItemIDList: PItemIDList;
  ShellMalloc: IMalloc;
begin
  Result := '';
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
  begin
    Buffer := ShellMalloc^.Alloc(ShellMalloc, MAX_PATH);
    try
      with BrowseInfo do
      begin
        pidlRoot := nil;
        hwndOwner:= 0 ;
        pszDisplayName := Buffer;
        lpszTitle := PChar(Caption);
        ulFlags := BIF_RETURNONLYFSDIRS;
      end;
      ItemIDList := ShBrowseForFolder(BrowseInfo);
      if ItemIDList <> nil then
      begin
        ShGetPathFromIDList(ItemIDList, Buffer);
        ShellMalloc^.Free(ShellMalloc, ItemIDList);
        result := Buffer;
      end;
    finally
      ShellMalloc^.Free(ShellMalloc, Buffer);
    end;
  end;
end;

begin
  writeln ('Started...');
  writeln ('Path = ', SelectDirectory('MyCaption', ''));
end.






More information about the fpc-pascal mailing list