Arsip: [ASK] How to get Special folder

more 14 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 14 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
Last Articles
Last Topic
- PascalTalk #6: (Podcast) Kuliah IT di luar negeri, susah gak sih?
by LuriDarmawan in Tutorial & Community Project more 2 years ago - PascalTalk #5: UX: Research, Design and Engineer
by LuriDarmawan in Tutorial & Community Project more 2 years ago - PascalTalk #4: Obrolan Ringan Seputar IT
by LuriDarmawan in Tutorial & Community Project more 2 years ago - PascalTalk #2: Membuat Sendiri SMART HOME
by LuriDarmawan in Tutorial & Community Project more 2 years ago - PascalTalk #3: RADically Fast and Easy Mobile Apps Development with Delphi
by LuriDarmawan in Tutorial & Community Project more 2 years ago - PascalTalk #1: Pemanfaatan Artificial Intelligence di Masa Covid-19
by LuriDarmawan in Tutorial & Community Project more 2 years ago - Tempat Latihan Posting
by LuriDarmawan in OOT more 3 years ago - Archive
- Looping lagi...
by idhiel in Hal umum tentang Pascal Indonesia more 10 years ago - [ask] koneksi ke ODBC user Dsn saat runtime dengan ado
by halimanh in FireBird more 10 years ago - Validasi menggunakan data tanggal
by mas_kofa in Hal umum tentang Pascal Indonesia more 10 years ago
Random Topic
- Nanya SQL...
by reminder2k1 in MySQL more 14 years ago - Barcode
by Chep_Rytheone in Tip n Trik Pemrograman more 17 years ago - activex delphi
by gigit in Hal umum tentang Pascal Indonesia more 14 years ago - Program Teks Berjalan di Desktop Windows
by hunter20040 in OpenSource dan Gratis more 14 years ago - quantity mysql
by belajaraja in Enginering more 15 years ago - Gimana cara dapetin daftar DSN/Alias?
by arioss in Tip n Trik Pemrograman more 17 years ago - hasil SELECT ga muncul semua
by ekseumaineur in MySQL more 17 years ago - tolongi donk !!!
by sapta in Tip n Trik Pemrograman more 15 years ago - Searhing Menggunakan Fungsi FILTERING...
by ii_irwan in Hal umum tentang Pascal Indonesia more 13 years ago - Buat Master Detail???
by mrsatan_26 in Reporting more 13 years ago