Code:

Type TSystemPath=(Desktop,StartMenu,Programs,Startup,Personal, winroot, winsys);

{©Drkb v.3®Vit (Vitaly Nevzorov) }

 

...

Function GetSystemPath(SystemPath:TSystemPath):string;

var p: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');

Winroot:begin

GetMem(p,255);

GetWindowsDirectory(p,254);

result:=Strpas(p);

Freemem(p);

end;

WinSys:begin

GetMem(p,255);

GetSystemDirectory(p,254);

result:=Strpas(p);

Freemem(p);

end;

end;

finally

CloseKey;

free;

end;

if (result<>'') and (result[length(result)]<>'\') then result:=result+'\';

end;

 

Code:

function GetWindowsFolder:string;

{©Drkb v.3, ®Vit (Vitaly Nevzorov) }

 

var p:PChar;

begin

GetMem(p, MAX_PATH);

result:='';

if GetWindowsDirectory(p, MAX_PATH)>0 then

   result:=string(p);

FreeMem(p);

end;

 

 

Используйте функцию SHAddToRecentDocs.

Code:

uses ShlOBJ;

 

procedure TForm1.Button1Click(Sender: TObject);

var

  s : string;

begin

  s := 'C:\DownLoad\ntkfaq.html';

  SHAddToRecentDocs(SHARD_PATH, pChar(s));

end;

 

Для этого можно воспользоваться API функцией SHAddToRecentDocs:

Code:

procedure TForm1.Button1Click(Sender: TObject);

begin

SHAddToRecentDocs(SHARD_PATH, 0);

end;

Не забудьте включить ShlObj в Unit

 

Мне нужно программно установить некоторые файлы с установочного диска Windows. На многих компьютерах CAB-файлы установки Windows находятся в каком-то каталоге на жестком диске, на других - Windows был установлен с CD. Как узнать откуда была установленна Windows?

 

 

Предположим Вам захотелось, чтобы Ваше программа сама умела добавлять файлы "recent documents list" (для тех, кто в танке - это такая менюшка, которая появляется при нажатии на кнопку Пуск(Start) и наведении мышкой на "Документы" (Documents). Сама функция API-шная, так что применять её можно в любом компиляторе.

Добавляем следующий код в интерфейсную часть формы:

 

Code:

uses

ActiveX, ShlObj;

 

procedure TForm1.Button1Click(Sender: TObject);

var

pShell, ShellFolder: IShellFolder;

pidl: PITEMIDLIST;

PMalloc: IMalloc;

sName: string;

EnumIDList: IEnumIDList;

pceltFetched: ULONG;

lpName: TStrRet;

slDirectories: TStringList;

begin

slDirectories := TStringList.Create;

try

   SHGetDesktopFolder(ShellFolder);

   SHGetSpecialFolderLocation(0,CSIDL_DRIVES, pidl);

   SHGetMalloc(PMalloc);

   ShellFolder.BindToObject(pidl, nil, IID_IShellFolder, Pointer(pShell));

   pShell.EnumObjects(0,SHCONTF_FOLDERS, EnumIDList);

   while EnumIDList.Next(1,pidl, pceltFetched) = S_ok do

   begin

     pceltFetched := 0;

     lpName.uType := 0;

     pShell.GetDisplayNameOf(pidl, SHGDN_FORPARSING, lpName);

     sName := lpName.pOleStr;

     slDirectories.Add(sName);

   end;

   ListBox1.Items.Assign(sldirectories);

finally

   pMalloc._Release;

   pMalloc := nil;

   slDirectories.Free;

end;

 

 

Code:

function c_GetTempPath: String;

var

Buffer: array[0..1023] of Char;

begin

SetString(Result, Buffer, GetTempPath(Sizeof(Buffer)-1,Buffer));

end;

 

 

этот код так же можно использовать для:

GetCurrentDirectory

GetSystemDirectory

GetWindowsDirectory

 

Code:

uses ..., WinInet;

{©Drkb v.3}

 

procedure DeleteCache;

var

lpEntryInfo: PInternetCacheEntryInfo;

hCacheDir: LongWord;

dwEntrySize: LongWord;

begin

dwEntrySize := 0;

FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);

GetMem(lpEntryInfo, dwEntrySize);

try

   if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize;

   hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);

   if hCacheDir <> 0 then

   try

     repeat

       DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName);

       FreeMem(lpEntryInfo, dwEntrySize);

       dwEntrySize := 0;

       FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize);

       GetMem(lpEntryInfo, dwEntrySize);

       if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize;

     until not FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize);

   finally

     FindCloseUrlCache(hCacheDir);

   end;

finally

   FreeMem(lpEntryInfo, dwEntrySize);

end;

end;

 

 

Автор Rouse_