通过 SHGetSpecialFolderLocation、SHGetPathFromIDList 函数获取常用路径

本例效果图:

---

代码文件:

---

unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;



type

  TForm1 = class(TForm)

    Memo1: TMemo;

    procedure FormCreate(Sender: TObject);

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



uses ShlObj; {SHGetSpecialFolderLocation、SHGetPathFromIDList 函数来自这个单元}



{获取常用路径的函数}

function GetPath(FID: Integer): string;

var

  pidl: PItemIDList;

  path: array[0..MAX_PATH] of Char;

begin

  SHGetSpecialFolderLocation(0, FID, pidl);

  SHGetPathFromIDList(pidl, path);

  Result := path;

end;



{测试时, 我把 SHGetSpecialFolderLocation 函数需要的参数定义成了一个常数数组}

const

  arr: array[0..57] of Integer = (

    CSIDL_DESKTOP                 , { = $0000 }

    CSIDL_INTERNET                , { = $0001 }

    CSIDL_PROGRAMS                , { = $0002 }

    CSIDL_CONTROLS                , { = $0003 }

    CSIDL_PRINTERS                , { = $0004 }

    CSIDL_PERSONAL                , { = $0005 }

    CSIDL_FAVORITES               , { = $0006 }

    CSIDL_STARTUP                 , { = $0007 }

    CSIDL_RECENT                  , { = $0008 }

    CSIDL_SENDTO                  , { = $0009 }

    CSIDL_BITBUCKET               , { = $000a }

    CSIDL_STARTMENU               , { = $000b }

    CSIDL_MYDOCUMENTS             , { = $000c }

    CSIDL_MYMUSIC                 , { = $000d }

    CSIDL_MYVIDEO                 , { = $000e }

    CSIDL_DESKTOPDIRECTORY        , { = $0010 }

    CSIDL_DRIVES                  , { = $0011 }

    CSIDL_NETWORK                 , { = $0012 }

    CSIDL_NETHOOD                 , { = $0013 }

    CSIDL_FONTS                   , { = $0014 }

    CSIDL_TEMPLATES               , { = $0015 }

    CSIDL_COMMON_STARTMENU        , { = $0016 }

    CSIDL_COMMON_PROGRAMS         , { = $0017 }

    CSIDL_COMMON_STARTUP          , { = $0018 }

    CSIDL_COMMON_DESKTOPDIRECTORY , { = $0019 }

    CSIDL_APPDATA                 , { = $001a }

    CSIDL_PRINTHOOD               , { = $001b }

    CSIDL_LOCAL_APPDATA           , { = $001c }

    CSIDL_ALTSTARTUP              , { = $001d }

    CSIDL_COMMON_ALTSTARTUP       , { = $001e }

    CSIDL_COMMON_FAVORITES        , { = $001f }

    CSIDL_INTERNET_CACHE          , { = $0020 }

    CSIDL_COOKIES                 , { = $0021 }

    CSIDL_HISTORY                 , { = $0022 }

    CSIDL_COMMON_APPDATA          , { = $0023 }

    CSIDL_WINDOWS                 , { = $0024 }

    CSIDL_SYSTEM                  , { = $0025 }

    CSIDL_PROGRAM_FILES           , { = $0026 }

    CSIDL_MYPICTURES              , { = $0027 }

    CSIDL_PROFILE                 , { = $0028 }

    CSIDL_SYSTEMX86               , { = $0029 }

    CSIDL_PROGRAM_FILESX86        , { = $002a }

    CSIDL_PROGRAM_FILES_COMMON    , { = $002b }

    CSIDL_PROGRAM_FILES_COMMONX86 , { = $002c }

    CSIDL_COMMON_TEMPLATES        , { = $002d }

    CSIDL_COMMON_DOCUMENTS        , { = $002e }

    CSIDL_COMMON_ADMINTOOLS       , { = $002f }

    CSIDL_ADMINTOOLS              , { = $0030 }

    CSIDL_CONNECTIONS             , { = $0031 }

    CSIDL_COMMON_MUSIC            , { = $0035 }

    CSIDL_COMMON_PICTURES         , { = $0036 }

    CSIDL_COMMON_VIDEO            , { = $0037 }

    CSIDL_RESOURCES               , { = $0038 }

    CSIDL_RESOURCES_LOCALIZED     , { = $0039 }

    CSIDL_COMMON_OEM_LINKS        , { = $003a }

    CSIDL_CDBURN_AREA             , { = $003b }

    CSIDL_COMPUTERSNEARME         , { = $003d }

    CSIDL_PROFILES                  { = $003e }

  );



{测试}

procedure TForm1.FormCreate(Sender: TObject);

var

  i: Integer;

  s: string;

begin

  Memo1.Clear;

  for i := 0 to Length(Arr) - 1 do

  begin

    s := GetPath(Arr[i]);

    if s<>'' then Memo1.Lines.Add(Format('%d:'#9'%s', [Arr[i], s]));

  end;

end;



end.


 
   

窗体文件:

---

object Form1: TForm1

  Left = 0

  Top = 0

  Caption = 'Form1'

  ClientHeight = 318

  ClientWidth = 465

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Tahoma'

  Font.Style = []

  OldCreateOrder = False

  OnCreate = FormCreate

  PixelsPerInch = 96

  TextHeight = 13

  object Memo1: TMemo

    Left = 0

    Top = 0

    Width = 465

    Height = 318

    Align = alClient

    Lines.Strings = (

      'Memo1')

    ScrollBars = ssBoth

    TabOrder = 0

    ExplicitWidth = 409

  end

end