[fpc-pascal]divining windows system paths

Full_Name memsom at post.interalpha.co.uk
Thu Nov 1 11:15:21 CET 2001


Quoting the reverend <the.reverend at coastgames.com>:

> how can i divine the path to the desktop for the current user?  i want my
> program to deploy a report file to the desktop without asking the user for
> the path.  can someone help me?  i know someone has to know how to do this.


This is the method used in Delphi, you might get this to work in FPC, but I 
doubt it will in anything other that 1.1:

////////////////////////////////////////////////////////////////////////////
const
  CSIDL_DESKTOPDIRECTORY = $0010; //comes from unit 'shlObj'
  shell32 = 'shell32.dll'; //comes from unit 'shlObj'

type
  { TSHItemID -- Item ID } //comes from unit 'shlObj'
  PSHItemID = ^TSHItemID;
  _SHITEMID = record
    cb: Word;                         { Size of the ID (including cb itself) }
    abID: array[0..0] of Byte;        { The item ID (variable length) }
  end;
  TSHItemID = _SHITEMID;
  SHITEMID = _SHITEMID;

  //comes from unit 'shlObj'
  { TItemIDList -- List if item IDs (combined with 0-terminator) } 
  PItemIDList = ^TItemIDList;
  _ITEMIDLIST = record
     mkid: TSHItemID;
   end;
  TItemIDList = _ITEMIDLIST;
  ITEMIDLIST = _ITEMIDLIST;

  //comes from unit 'ActiveX'
  IMalloc = interface(IUnknown)
    ['{00000002-0000-0000-C000-000000000046}']
    function Alloc(cb: Longint): Pointer; stdcall;
    function Realloc(pv: Pointer; cb: Longint): Pointer; stdcall;
    procedure Free(pv: Pointer); stdcall;
    function GetSize(pv: Pointer): Longint; stdcall;
    function DidAlloc(pv: Pointer): Integer; stdcall;
    procedure HeapMinimize; stdcall;
  end;

//comes from unit 'shlObj'
function SHGetSpecialFolderLocation(hwndOwner: HWND; nFolder: Integer; var 
ppidl: PItemIDList): HResult; stdcall; external shell32 
name 'SHGetSpecialFolderLocation';

//comes from unit 'shlObj'
function SHGetPathFromIDList(pidl: PItemIDList; pszPath: PChar): BOOL; stdcall; 
external shell32 name 'SHGetPathFromIDListA';

//comes from unit 'shlObj'
function SHGetMalloc(var ppMalloc: IMalloc): HResult; stdcall; external shell32 
name 'SHGetMalloc';

//Can't remember where from, somewhere on the 'net. I altered it to 
//give the desktop dir.. there are other ID that can be used instead,
//(gets things like 'Program files', 'windows', 'windows\system' etc)
function GetDesktopPath: string;
var
  PIDL: PItemIDList;
  Path: LPSTR;
  AMalloc: IMalloc;
begin
  Path := StrAlloc(MAX_PATH);
  try
    SHGetSpecialFolderLocation(Application.handle,
                               //replace this for other paths.. 
                               CSIDL_DESKTOPDIRECTORY, 
                               PIDL
                               );
    if SHGetPathFromIDList(PIDL, Path) then
      Result := Path;
    SHGetMalloc(AMalloc); //this will cause you a problem...
    AMalloc.Free(PIDL);   //as will this...
  finally
    StrDispose(Path);
  end;
end;

//////////////////////////////////////////////////////////////////////


You may be able to get away with dropping the IMalloc calls. I really don't 
know. You may end up crashing/screwing up Explorer though, as Explorer ('the 
shell') has to explicitly release all memory it allocates.

Hope that helps..

Matt

--

"Computer games don't affect kids; I mean if Pac-Man affected us as kids, 
we'd all be running around in darkened rooms, munching magic pills and 
listening to repetitive electronic music." 
Kristian Wilson, 
Nintendo, Inc, 1989

-----BEGIN GEEK CODE BLOCK-----
Version: 3.12
GCS d? s+++:+ a- C++ UL+ P L++ E---- W- N+ o+ K- w 
O- M V PS PE-- Y PGP- t- 5-- X- R- tv+ b+ DI++ D+ 
G e++ h--- r+++ y+++ 
------END GEEK CODE BLOCK------




More information about the fpc-pascal mailing list