Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 21.08.2008, 17:47
FreeUser FreeUser вне форума
Начинающий
 
Регистрация: 13.08.2008
Сообщения: 119
Репутация: 10
По умолчанию Как найти рабочий стол?

Есть ли типа GetWindowsDirectory но для рабочего стола?
Перерыл литературу. А почему то такой полезной функции не нашел.
Ответить с цитированием
  #2  
Старый 21.08.2008, 17:51
Аватар для The Shadow
The Shadow The Shadow вне форума
Продвинутый
 
Регистрация: 11.06.2007
Адрес: Уфа, Россия
Сообщения: 793
Репутация: 35
По умолчанию

В реестре вроде где то записано...
__________________
Что делать, когда сломался комп:
1. Если вы юзер - делать ноги.
2. Если ремонтник - делать деньги.
3. Если вы программист - делать вид, что так было задумано.
Ответить с цитированием
  #3  
Старый 21.08.2008, 17:57
FreeUser FreeUser вне форума
Начинающий
 
Регистрация: 13.08.2008
Сообщения: 119
Репутация: 10
По умолчанию

Только написав запрос на английском нашел

Код:
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;

_ttp://www.sql.ru/forum/actualthread.aspx?tid=342673

Очень расписали. Тема снята.
Ответить с цитированием
  #4  
Старый 21.08.2008, 18:08
FreeUser FreeUser вне форума
Начинающий
 
Регистрация: 13.08.2008
Сообщения: 119
Репутация: 10
По умолчанию

Точнее полный вариант выглядит так

Код:
procedure TForm1.FormCreate(Sender: TObject);
var 
  shellMalloc: IMalloc; 
  ppidl: PItemIdList; 
  DesktopPath: string; 
begin 
  ppidl := nil; 
  try 
    if SHGetMalloc(shellMalloc) = NOERROR then 
    begin 
      SHGetSpecialFolderLocation(Form1.Handle, CSIDL_DESKTOP, ppidl); 
      SetLength(DesktopPath, MAX_PATH); 
      if not SHGetPathFromIDList(ppidl, PChar(DesktopPath)) then 
        raise exception.create('SHGetPathFromIDList failed : invalid pidl'); 
      SetLength(DesktopPath, lStrLen(PChar(DesktopPath))); 
    end; 
  finally 
   if ppidl <> nil then 
         shellMalloc.free(ppidl); 
  end;
 
label11.Caption:=DesktopPath; //тут string'ом сидит путь до рабочего стола

end;
Ответить с цитированием
  #5  
Старый 21.08.2008, 18:49
Аватар для M.A.D.M.A.N.
M.A.D.M.A.N. M.A.D.M.A.N. вне форума
Sir Richard Abramson
 
Регистрация: 05.04.2008
Сообщения: 5,505
Версия Delphi: XE10
Репутация: выкл
По умолчанию

Вот еще на всякий случай
Код:
type
  TSystemPath = (spDesktop, spStartMenu,
    spPrograms, spStartup, spPersonal, spAppData,
    spFonts, spSendTo, spRecent, spFavorites, spCache,
    spCookies, spHistory, spNetHood, spPrintHood,
    spTemplates, spLocADat, spWindRoot, spWindSys,
    spTempPath, spRootDir, spProgFiles, spComFiles,
    spConfigPath, spDevicePath, spMediaPath, spWallPaper);
.........
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
        spDesktop: Result   := ReadString('Desktop');
        spStartMenu: Result := ReadString('Start Menu');
        spPrograms: Result  := ReadString('Programs');
        spStartup: Result   := ReadString('Startup');
        spPersonal: Result  := ReadString('Personal');
        spAppData: Result   := ReadString('AppData');
        spFonts: Result     := ReadString('Fonts');
        spSendTo: Result    := ReadString('SendTo');
        spRecent: Result    := ReadString('Recent');
        spFavorites: Result := ReadString('Favorites');
        spCache: Result     := ReadString('Cache');
        spCookies: Result   := ReadString('Cookies');
        spHistory: Result   := ReadString('History');
        spNetHood: Result   := ReadString('NetHood');
        spPrintHood: Result := ReadString('PrintHood');
        spTemplates: Result := ReadString('Templates');
        spLocADat: Result   := ReadString('Local AppData');
        spWindRoot:
          begin
            GetMem(ph, 255);
            GetWindowsDirectory(ph, 254);
            Result := Strpas(ph);
            Freemem(ph);
          end;
        spWindSys:
          begin
            GetMem(ph, 255);
            GetSystemDirectory(ph, 254);
            Result := Strpas(ph);
            Freemem(ph);
          end;
        spTempPath:
          begin
            GetMem(ph, 255);
            GetTempPath(254, ph);
            Result := Strpas(ph);
            Freemem(ph);
          end;
        spRootDir:
          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
        spProgFiles: Result := ReadString('ProgramFilesDir');
        spComFiles: Result := ReadString('CommonFilesDir');
        spConfigPath: Result := ReadString('ConfigPath');
        spDevicePath: Result := ReadString('DevicePath');
        spMediaPath: Result := ReadString('MediaPath');
        spWallPaper: Result := ReadString('WallPaperDir');
      end;
    finally
      CloseKey;
      Free;
    end;
{  if (Result <> '') and (Result[Length(Result)] <> '\') then
    Result := Result + '\';}
end;
__________________
— Как тебя понимать?
— Понимать меня не обязательно. Обязательно меня любить и кормить вовремя.


На Delphi, увы, больше не программирую.
Рекомендуемая литература по программированию
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 04:34.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025