Arsip: [ASK] How to get Special folder

 
user image
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... :)
user image
more 15 years ago

madi

hehe,.. yg paling gampang pake jcl http://homepages.codegear.com/jedi/jcl/
user image
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;
user image
more 15 years ago

awawa

thanks bro...
more ...
  • Pages:
  • 1
Share to

Random Topic

Local Business Directory, Search Engine Submission & SEO Tools FreeWebSubmission.com SonicRun.com