Arsip: [ASK] How to get Special folder
more 15 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 15 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 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
- Coneksi Zeos gagal
by p2bf in Tip n Trik Pemrograman more 17 years ago - [Ask] Akses MySQL pake ADO
by ryan in MySQL more 17 years ago - Nanya File dalam File
by Hadoitz in Tutorial & Community Project more 16 years ago - Print MEMO............
by fissas in MySQL more 17 years ago - Program setting dial-up menggunakan delphi
by em052007 in Bedah Kasus more 16 years ago - error ADOCommand1.CommandText
by tAtA in Tip n Trik Pemrograman more 16 years ago - SQL Query Error-where=(fieldnya integer)
by abu_nawm in MySQL more 15 years ago - Nginput user and password conection otomatis
by fissas in MsSQL more 16 years ago - Backup Restore data dengan delphi SQL Server sebagai db
by iizy in Tip n Trik Pemrograman more 15 years ago - TatukGis
by dadanarifin in Multimedia & Graphic Enhancement more 14 years ago