Arsip: [ASK] How to get Special folder

more 16 years ago
awawa
Hallo ada yang tau ngk cara mendapatkan special folder lengkap yg ada di windows... sebelumnya minta maaf klo gw post hal ini mungkin terjadi double post... mohon bantuanya yah
oh iya terus special foldernya kita tampilin di message box misal : message box %homepath% gimana caranya yah. gw pemula ne di delphi jd perlu bantuannya... :)

more 16 years ago
madi
klo mau experiment ya pake ini :d
uses
ActiveX, ShlObj;
procedure TForm1.Button1Click(Sender: TObject);
// Replace CSIDL_HISTORY with the constants below
var
Allocator: IMalloc;
SpecialDir: PItemIdList;
FBuf: array of Char;
PerDir: string;
begin
if SHGetMalloc(Allocator) = NOERROR then
begin
SHGetSpecialFolderLocation(Form1.Handle, CSIDL_HISTORY, SpecialDir);
SHGetPathFromIDList(SpecialDir, @FBuf[0]);
Allocator.Free(SpecialDir);
ShowMessage(string(FBuf));
end;
end;
// With Windows Me/2000, the SHGetSpecialFolderLocation function
// is superseded by ShGetFolderLocation.
// function to get the desktop folder location:
function GetDeskTopPath : string;
var
shellMalloc: IMalloc;
ppidl: PItemIdList;
PerDir: string;
begin
ppidl := nil;
try
if SHGetMalloc(shellMalloc) = NOERROR then
begin
SHGetSpecialFolderLocation(Form1.Handle, CSIDL_DESKTOP, ppidl);
SetLength(Result, MAX_PATH);
if not SHGetPathFromIDList(ppidl, PChar(Result)) then
raise exception.create('SHGetPathFromIDList failed : invalid pidl');
SetLength(Result, lStrLen(PChar(Result)));
end;
finally
if ppidl <> nil then
shellMalloc.free(ppidl);
end;
end;
{
Constants:
CSIDL_DESKTOP
CSIDL_INTERNET
CSIDL_PROGRAMS
CSIDL_CONTROLS
CSIDL_PRINTERS
CSIDL_PERSONAL
CSIDL_FAVORITES
CSIDL_STARTUP
CSIDL_RECENT
CSIDL_SENDTO
CSIDL_BITBUCKET
CSIDL_STARTMENU
CSIDL_DESKTOPDIRECTORY
CSIDL_DRIVES
CSIDL_NETWORK
CSIDL_NETHOOD
CSIDL_FONTS
CSIDL_TEMPLATES
CSIDL_COMMON_STARTMENU
CSIDL_COMMON_PROGRAMS
CSIDL_COMMON_STARTUP
CSIDL_COMMON_DESKTOPDIRECTORY
CSIDL_APPDATA
CSIDL_PRINTHOOD
CSIDL_ALTSTARTUP
CSIDL_COMMON_ALTSTARTUP
CSIDL_COMMON_FAVORITES
CSIDL_INTERNET_CACHE
CSIDL_COOKIES
CSIDL_HISTORY
}
{ * }
{ Read paths from registry. by LENIN INC }
uses
Windows, SysUtils, Registry;
type
TSystemPath = (Desktop, StartMenu,
Programs, Startup, Personal, AppData,
Fonts, SendTo, Recent, Favorites, Cache,
Cookies, History, NetHood, PrintHood,
Templates, LocADat, WindRoot, WindSys,
TempPath, RootDir, ProgFiles, ComFiles,
ConfigPath, DevicePath, MediaPath, WallPaper);
function GetSystemPath(SystemPath: TSystemPath): string;
var
ph: PChar;
begin
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
OpenKey('\Software\Microsoft\Windows\CurrentVersion' +
'Explorer\Shell Folders', True);
case SystemPath of
Desktop: Result := ReadString('Desktop');
StartMenu: Result := ReadString('Start Menu');
Programs: Result := ReadString('Programs');
Startup: Result := ReadString('Startup');
Personal: Result := ReadString('Personal');
AppData: Result := ReadString('AppData');
Fonts: Result := ReadString('Fonts');
SendTo: Result := ReadString('SendTo');
Recent: Result := ReadString('Recent');
Favorites: Result := ReadString('Favorites');
Cache: Result := ReadString('Cache');
Cookies: Result := ReadString('Cookies');
History: Result := ReadString('History');
NetHood: Result := ReadString('NetHood');
PrintHood: Result := ReadString('PrintHood');
Templates: Result := ReadString('Templates');
LocADat: Result := ReadString('Local AppData');
WindRoot:
begin
GetMem(ph, 255);
GetWindowsDirectory(ph, 254);
Result := Strpas(ph);
Freemem(ph);
end;
WindSys:
begin
GetMem(ph, 255);
GetSystemDirectory(ph, 254);
Result := Strpas(ph);
Freemem(ph);
end;
TempPath:
begin
GetMem(ph, 255);
GetTempPath(254, ph);
Result := Strpas(ph);
Freemem(ph);
end;
RootDir:
begin
GetMem(ph, 255);
GetSystemDirectory(ph, 254);
Result := (Copy(Strpas(ph), 1, 2));
Freemem(ph);
end;
end;
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion', True);
case SystemPath of
ProgFiles: Result := ReadString('ProgramFilesDir');
ComFiles: Result := ReadString('CommonFilesDir');
ConfigPath: Result := ReadString('ConfigPath');
DevicePath: Result := ReadString('DevicePath');
MediaPath: Result := ReadString('MediaPath');
WallPaper: Result := ReadString('WallPaperDir');
end;
finally
CloseKey;
Free;
end;
if (Result <> '') and (Result[Length(Result)] <> '') then
Result := Result + '';
end;
//Use
procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption := GetSystemPath(DevicePath);
end;
more ...
- Pages:
- 1
reply |
Report Obsolete
AI Forward

🚀 We're thrilled to partner with Alibaba Cloud for "AI Forward - Alibaba Cloud Global Developer Summit 2025" in Jakarta! Join us and explore the future of AI. Register now:
https://int.alibabacloud.com/m/1000400772/
#AlibabaCloud #DeveloperSummit #Jakarta #AIFORWARD
Last Articles
Last Topic
- PascalTalk #6: (Podcast) Kuliah IT di luar negeri, susah gak sih?
by LuriDarmawan in Tutorial & Community Project more 4 years ago - PascalTalk #5: UX: Research, Design and Engineer
by LuriDarmawan in Tutorial & Community Project more 4 years ago - PascalTalk #4: Obrolan Ringan Seputar IT
by LuriDarmawan in Tutorial & Community Project more 4 years ago - PascalTalk #2: Membuat Sendiri SMART HOME
by LuriDarmawan in Tutorial & Community Project more 4 years ago - PascalTalk #3: RADically Fast and Easy Mobile Apps Development with Delphi
by LuriDarmawan in Tutorial & Community Project more 4 years ago - PascalTalk #1: Pemanfaatan Artificial Intelligence di Masa Covid-19
by LuriDarmawan in Tutorial & Community Project more 4 years ago - Tempat Latihan Posting
by LuriDarmawan in OOT more 5 years ago - Archive
- Looping lagi...
by idhiel in Hal umum tentang Pascal Indonesia more 12 years ago - [ask] koneksi ke ODBC user Dsn saat runtime dengan ado
by halimanh in FireBird more 12 years ago - Validasi menggunakan data tanggal
by mas_kofa in Hal umum tentang Pascal Indonesia more 12 years ago
Random Topic
- Create Chart Series at runtime
by delphicode in OOT more 15 years ago - Icon berubah saat di klik
by felly in Kritik & Saran more 16 years ago - INNER joint di DBF
by nurez in Lain-lain more 17 years ago - ask program sederhana client server
by don2103 in MsSQL more 14 years ago - Menentukan Jumlah Yang Difilter Pada Query ?
by umarbakri in Hal umum tentang Pascal Indonesia more 17 years ago - Membuat report untuk kertas continous, gimana caranya ya?
by ecka in Tutorial & Community Project more 18 years ago - manggil application yg sama dgn shellexecute
by jordan in Hal umum tentang Pascal Indonesia more 17 years ago - Koneksi Client to ke Server using Interbase....newbie
by cheetoozz in Hal umum tentang Pascal Indonesia more 18 years ago - How to reduce delphi EXE size?
by rydzâ„¢ in Tip n Trik Pemrograman more 17 years ago - Gimana Cara Menghentikan Printer ?
by holmes in Tip n Trik Pemrograman more 19 years ago