Windows

Code:

uses ShlOBJ;

procedure TForm1.Button1Click(Sender: TObject);

var

  s : string;

begin

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

  SHAddToRecentDocs(SHARD_PATH, pChar(s));

end;

Code:

function c_GetTempPath: String;

var

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

begin

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

end;

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;

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;

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:

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:

uses

{©Drkb v.3}

windows, messages, ShellAPI;

const

ClassName = 'MyClockWndClass';

var

hTrayClock,Window:hWnd;

idTM:cardinal;

function SysDateToStr: string;

const

sDateFmt = 'dddd, d MMMM yyyy';

var

ST : TSystemTime;

begin

GetLocalTime(ST);

SetLength(Result, MAX_PATH);

GetDateFormat(LOCALE_USER_DEFAULT,0, @ST,pchar(sDateFmt), @Result[1], MAX_PATH);

end;

function SysTimeToStr:string;

const

  sTimeFmt = 'HH:mm';

var

ST : TSystemTime;

begin

GetLocalTime(ST);

SetLength(Result,15);

GetTimeFormat(LOCALE_USER_DEFAULT,0,@st,sTimeFmt,@Result[1],15);

end;

procedure TimerProc(wnd:HWND;uMsg,idEvent,dwTime:UINT);stdcall;

begin

InvalidateRect(wnd,nil,true);

end;

procedure RecalcWndPos;

var

r:TRect;

X,Y:integer;

begin

X:=GetSystemMetrics(SM_CXDLGFRAME);

Y:=GetSystemMetrics(SM_CYDLGFRAME);

GetWindowRect(hTrayClock,r);

SetWindowPos(Window,0,r.Left+X,r.Top+Y, r.Right-r.Left,r.Bottom-r.Top-Y,0);

end;

function AppWndProc(wnd: HWND; uMsg:DWORD; wParam: WPARAM; lParam: LPARAM): Longint; stdcall;

var

DC      : HDC;

ps      :TPaintStruct;

pt      :TPoint;

r       :TRect;

Cmd     : LongBool;

hm:HMenu;

begin

Result := 0;

case uMsg of

WM_SETTINGCHANGE: if wParam=SPI_SETWORKAREA then RecalcWndPos;

WM_PAINT:

   begin

    DC:=BeginPaint(wnd,ps);

    GetClientRect(wnd,r);

    SetBkMode(DC,TRANSPARENT);

    SetTextColor(DC,RGB(255,255,0));

    DrawText(DC,PChar(SysTimeToStr),-1,r,DT_SINGLELINE or DT_CENTER or DT_VCENTER);

    EndPaint(wnd,ps);

    exit;

   end;

WM_RBUTTONDOWN:

begin

  hm:=CreatePopupMenu;

  pt.X:=LOWORD(lParam);

  pt.Y:=HIWORD(lParam);

  ClientToScreen(wnd,pt);

  Insertmenu(hm,0,MF_BYPOSITION or MF_STRING,$101,'Exit');

  Insertmenu(hm,0,MF_BYPOSITION or MF_SEPARATOR,0,nil);

  Insertmenu(hm,0,MF_BYPOSITION or MF_STRING,$102,'Date/Time Settings');

  Insertmenu(hm,0,MF_BYPOSITION or MF_SEPARATOR,0,nil);

  Insertmenu(hm,0,MF_BYPOSITION or MF_STRING,dword(-1),PChar(SysDateToStr));

  SetMenuDefaultItem(hm,0,1);

  Cmd:=TrackPopupMenu(hM,TPM_LEFTALIGN or TPM_RIGHTBUTTON or

                 TPM_RETURNCMD,pt.X,pt.Y,0,Window,nil);

   case longint(Cmd) of

   $101: SendMessage(wnd,wm_destroy,0,0);

   $102: ShellExecute(0,nil,'control.exe','date/time',nil,SW_SHOW);

   end;

  DestroyMenu(hm);

end;

WM_DESTROY:

    begin

     PostQuitMessage(wparam);

     KillTimer(wnd,idTM);

    end

end;

Result := DefWindowProc(wnd, uMsg, wParam, lParam);

end;

procedure InitInstance;

var

AppWinClass: TWndClass;

begin

with AppWinClass do

begin

   style:= CS_VREDRAW or CS_HREDRAW;

   lpfnWndProc:= @AppWndProc;

   cbClsExtra:= 0;

   cbWndExtra:= 0;

   hInstance:= hInstance;

   hIcon:= LoadIcon(0,IDI_APPLICATION);

   hCursor:= LoadCursor(0,IDC_ARROW);

   hbrBackground:= GetStockObject(BLACK_BRUSH);

   lpszMenuName:= nil;

   lpszClassName:= ClassName;

end;

if RegisterClass(AppWinClass)=0 then Halt(1)

end;

procedure InitApplication;

begin

hTrayClock:=FindWindowEx(FindWindowEx(FindWindow('Shell_TrayWnd',nil),0,'TrayNotifyWnd',nil),0,'TrayClockWClass',nil);

Window := CreateWindow(ClassName,nil, WS_POPUP or WS_DLGFRAME, 0,0,0,0, hTrayClock,0,HInstance,nil);

If Window=0 then halt(1);

RecalcWndPos;

end;

procedure InitWindow;

begin

idTM:=SetTimer(Window,1,1000,@TimerProc);

ShowWindow(Window, SW_SHOWNORMAL);

UpdateWindow(Window);

InvalidateRect(Window,nil,True)

end;

procedure MsgLoop;

var

Message:TMsg;

begin

while GetMessage(Message, 0, 0, 0) do

   begin

     TranslateMessage(Message);

     DispatchMessage(Message);

   end;

Halt(Message.wParam)

end;

begin

InitInstance;

InitApplication;

InitWindow;

MsgLoop

end.

Code:

procedure TForm1.Button1Click(Sender: TObject);

begin

SHAddToRecentDocs(SHARD_PATH, 0);

end;