Belgeler menüsüne bir dosya ekleme

uses kısmına ShlOBJ unitini ekleyin; 

procedure TForm1.Button1Click(Sender: TObject);
var
  s : string;
begin
  s := 'C:\DownLoad\deneme.html';
  SHAddToRecentDocs(SHARD_PATH, pChar(s));
end;

 Belgeler menüsünü temizleme

uses kısmına ShlOBJ unitini ekleyin; 

SHAddToRecentDocs(SHARD_PATH, nil);

 Duvar kağıdını değiştirmek 

var
  s: string;
begin
  s := 'c:\windows\cars.bmp';
  SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar(s),0);

 Başlat butonunu gizlemek veya kullanılmaz hale getirmek 

procedure TForm1.Button1Click(Sender: TObject);
var
  Rgn : hRgn;
begin
  // Başlat butonunu gizle
  Rgn := CreateRectRgn(0, 0, 0, 0);
  SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil),
                                       0,
                                      'Button',
                                       nil),
                                       Rgn,
                                       true);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  //Gizlenen Başlat butonunu eski haline döndürmek için
  SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil),
                                       0,
                                      'Button',
                                       nil),
                                       0,
                                       true);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  //Başlat butonunu kullanılmaz yap
  EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),
                                       0,
                                       'Button',
                                       nil),
                                       false);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  //Kullanılmaz yapılan Başlat butonunu eski haline getirmek için
  EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),
                                       0,
                                       'Button',
                                       nil),
                                       true);
end;

 Bir programın çalıştırılması

WinExec('c:\windows\calc.exe',sw_show);
WinExec('C:\WINDOWS\NOTEPAD.EXE C:\WINDOWS\WIN.INI', SW_SHOWNORMAL);
WinExec('COMMAND.COM', SW_SHOWNORMAL);
WinExec('COMMAND.COM /C DIR *.*', SW_SHOWNORMAL);

 Harddiskin seri numarasının bulunması 

procedure TForm1.Button1Click(Sender: TObject);
var
  VolumeSerialNumber : DWORD;
  MaximumComponentLength : DWORD;
  FileSystemFlags : DWORD;
  SerialNumber : string;
begin
  GetVolumeInformation('C:\',
                                     nil,
                                     0,
                                     @VolumeSerialNumber,
                                     MaximumComponentLength,
                                     FileSystemFlags,
                                     nil,
                                     0);
  SerialNumber := IntToHex(HiWord(VolumeSerialNumber), 4) + '-' +
                           IntToHex(LoWord(VolumeSerialNumber), 4);
  Memo1.Lines.Add(SerialNumber);
end;

 Windows ve System klasörlerinin bulunması 

procedure TForm1.Button1Click(Sender: TObject);
var
  a : Array[0..144] of char;
begin
  GetWindowsDirectory(a, sizeof(a));
  ShowMessage(StrPas(a));
  GetSystemDirectory(a, sizeof(a));
  ShowMessage(StrPas(a));
end;

 Windows lisans bilgilerinin (isim ve şirket) bulunması

uses kısmına Registry unitini ekleyin; 

procedure TForm1.Button1Click(Sender:TObject);
var
  reg: TRegIniFile;
begin
  reg := TRegIniFile.create('SOFTWARE\MICROSOFT\MS SETUP (ACME)\');
  Memo1.Lines.Add(reg.ReadString('USER INFO', 'DefName', 'Mustafa ŞİMŞEK'));
  Memo1.Lines.Add(reg.ReadString('USER INFO', 'DefCompany', ''));
  reg.free;
end;

 Speakerdan Beep sesi çıkartma 

MessageBeep(word(-1));

 Bir Denetim Masası uygulamasını çalıştırmak

Control Panel uygulamaları Windows\System klasörü altında bulunur. *.CPL uzantılı dosyalardır. Bu uygulamaları Control.Exe programı ile çalıştırabilirsiniz. Bazı Control Panel uygulamaları Windows\System klasöründe bulunmaz. Bunların ismini vererek çalıştırabilirsiniz. 

WinExec('C:\WINDOWS\CONTROL.EXE TIMEDATE.CPL', sw_ShowNormal);
WinExec('C:\WINDOWS\CONTROL.EXE MOUSE', sw_ShowNormal);
WinExec('C:\WINDOWS\CONTROL.EXE PRINTERS', sw_ShowNormal);
Windows 9x ve NT'de ortak olarak kullanılan bazı denetim masası uygulamaları

access.cpl:

Erişilebilirlik

appwiz.cpl:

Program ekle/kaldır

desk.cpl:

Görüntü

intl.cpl:

Bölgesel ayarlar

joy.cpl:

Oyun çubuğu

main.cpl:

Fare 

mmsys.cpl:

Çoklu ortam 

modem.cpl:

Modem

sysdm.cpl:

Sistem

timedate.cpl:

Tarih/Saat

 Windows'u kapatmak veya yeniden başlatmak(reboot)

Win9x'te bilgisayarı kapatmak veya yeninden başlatmak için :

ExitWindowsEx(EWX_SHUTDOWN,0);     //yeniden başlatmak için EWX_REBOOT

 Ekran koruyucusunu kapatmak ve açmak 

//kapatmak için
SystemParametersInfo(SPI_SETSCREENSAVEACTIVE,
                     0,
                     nil,
                     0);
//açmak için
SystemParametersInfo(SPI_SETSCREENSAVEACTIVE,
                     1,
                     nil,
                     0);

Ekran kartım kaç rengi destekliyor

Ekran kartınızın kaç rengi desteklediğini aşağıdaki kodla bulabilirsiniz.

(1 shl (GetDeviceCaps(Form1.Canvas.Handle, BITSPIXEL) *  
          GetDeviceCaps(Form1.Canvas.Handle, PLANES)));

 Windows Gezginini istediğiniz bir klasörle açma 
uses kısmına ShellApi unitini ekleyin. 
ShellExecute(0,
                  'explore',
                  'C:\WINDOWS',   //buraya açmak istediğiniz klasörü yazın.
                  nil,
                  nil,
                  SW_SHOWNORMAL);

Windows'un Bul (Find File) diyalog penceresini istediğiniz bir klasörle açma

Windows'ta Başlat->Bul->Dosyalar ve Klasörler ile açtığınız Bul diyalog penceresini Delphi içerisinden hem de istediğiniz yolu vererek çalıştırabilirsiniz.

uses kısmına ddeman unitini ekleyin.

procedure TForm1.Button1Click(Sender: TObject);
begin
  with TDDEClientConv.Create(Self) do begin
    ConnectMode := ddeManual;
    ServiceApplication := 'explorer.exe';
    SetLink( 'Folders', 'AppProperties');
    OpenLink;
    ExecuteMacro('[FindFolder(, C:\DOWNLOAD)]', False);  //diyalog açıldığında konum kısmında
    CloseLink;                                                             //olmasını istediğiniz klasör.
    Free;
  end;
end;

Pencerenin kapatma düğmesini etkisiz hale getirme

Pencerenin başlık çubuğunda bulunan kapatma düğmesini (X) etkisiz hale getirebilirsiniz. Aynı zamanda sistem menüsündeki Kapat(Close) seçeneğide kaybolur. Bunun için aşağıdaki gibi bir kod yazmalısınız.

procedure TForm1.Button1Click(Sender: TObject);
var
  hwndHandle : THANDLE;
  hMenuHandle : HMENU;
begin
  hwndHandle := FindWindow(nil, 'Form1');  //Form1 pencerenin başlığını göstermektedir.
  if (hwndHandle <> 0) then begin             //Burayı uygulamanıza göre değiştirin
    hMenuHandle := GetSystemMenu(hwndHandle, FALSE);
    if (hMenuHandle <> 0) then
      DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
  end;
end; 

 Uygulamam Windows her açıldığında otomatik çalışsın 
uses kısmına Registry unitini ekleyin. 
{$IFNDEF WIN32}
const MAX_PATH = 144;
{$ENDIF}

procedure TForm1.Button1Click(Sender: TObject);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.LazyWrite := false;
  reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',false);
  reg.WriteString('Uygulamam', uygulamanızın_yolu_ve_adı); 
  reg.CloseKey;
  reg.free;
end;

Klasöre Gözat diyalogunu kullanarak bir klasörü seçme

uses kısmına ShellAPI ve ShlObj unitlerini ekleyin.

procedure TForm1.Button1Click(Sender: TObject);
var
  TitleName : string;
  lpItemID : PItemIDList;
  BrowseInfo : TBrowseInfo;
  DisplayName : array[0..MAX_PATH] of char;
  TempPath : array[0..MAX_PATH] of char;
begin
  FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
  BrowseInfo.hwndOwner := Form1.Handle;
  BrowseInfo.pszDisplayName := @DisplayName;
  TitleName := 'Lütfen bir klasör seçin';
  BrowseInfo.lpszTitle := PChar(TitleName);
  BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
  lpItemID := SHBrowseForFolder(BrowseInfo);
  if lpItemId <> nil then begin
    SHGetPathFromIDList(lpItemID, TempPath);
    ShowMessage(TempPath);
    GlobalFreePtr(lpItemID);
  end;
end;

Bir web adresini açma

uses kısmına Shellapi unitini ekleyin; 

ShellExecute(Handle,
                   'open',
                   'http://www.geocities.com/siliconvalley/campus/4958/',
                    nil,
                    nil,
                    sw_ShowMaximized);

 Bir DOS programını çalıştırma ve çalışması bitince penceresini kapatma

WinExec('command.com /c progdos.exe',sw_ShowNormal); //progdos.exe çalıştırılıyor.

(* eğer ikinci paremetreyi sw_Hide yaparsanız kullanıcı programın çalıştığını görmez. *)

 Alt + Tab ve Ctrl + Esc tuşlarının kullanılmaz hale getirilmesi 

var
  OldVal : LongInt;
begin
  SystemParametersInfo (97, Word (True), @OldVal, 0) 
(* Word(False) ile kullanırsanız tuşları tekrar kullanabilirsiniz. *)

 Bir menü öğesine resim ekleme 

procedure TForm1.FormCreate(Sender: TObject);
var
  Bmp1 : TPicture;
begin
  Bmp1 := TPicture.Create;
  Bmp1.LoadFromFile('c:\deneme\turkey.bmp');
  SetMenuItemBitmaps( deneme1.Handle,
                      0,
                      MF_BYPOSITION,
                      Bmp1.Bitmap.Handle,
                      Bmp1.Bitmap.Handle);
end;

Ağ ortamında makinenin ismini bulma

procedure TForm1.Button1Click(Sender: TObject);
var
  Makine_ismi:array[0..255] of char;
  BufferSize:DWORD;
begin
  BufferSize:=SizeOf(Makine_ismi);
  GetComputerName(@Makine_ismi,BufferSize);
  Showmessage(Makine_ismi);
end;

Ağ ortamında login olmuş kullanıcı ismini bulma

procedure TForm1.Button1Click(Sender: TObject);
var
  Kullanici_ismi:array[0..255] of char;
  BufferSize:DWORD;
begin
  BufferSize:=SizeOf(Kullanici_ismi);
  GetUserName(@Kullanici_ismi,BufferSize);
  Showmessage(Kullanici_ismi);
end;

Ekran çözünürlüğünü nasıl öğrenirim

Screen.Width   //yatay çözünürlük
Screen.Height  //dikey çözünürlük 

MessageDlg('Şu anda ' + IntToStr( Screen.Width ) +' x '+
                                 IntToStr( Screen.Height )+' çözünürlükte çalışıyorsunuz',
                 mtInformation, [mbOk], 0 );

Taskbar'ın (Görev çubuğu) AutoHide özelliği açık mı, kapalı mı?

uses kısmına ShellAPI unitini ekleyin.

procedure TForm1.Button1Click(Sender: TObject);
var
  ABData : TAppBarData;
begin
  ABData.cbSize := sizeof(ABData);
  if (SHAppBarMessage(ABM_GETSTATE, ABData) and ABS_AUTOHIDE) > 0 then
     Showmessage('Autohide özelliği açık');
end;

Programım biraz beklesin

Bazı işlemlerden sonra diğer bir işlemi çalıştırmadan önce bir süre beklemek istersiniz. Bu gibi durumlarda Sleep komutunu kullanabilirsiniz. Burada verilen değer milisaniye cinsindendir. (1 saniye=1000 milisaniye)

Sleep(10000)    //10 saniye bekler

Caps lock tuşu açık mı, kapalı mı?

if (GetKeyState(VK_CAPITAL) and $01)<>0 then
    Showmessage ('caps lock açık');

İmleci (cursor) gizleyip, tekrar gösterme

ShowCursor(False) //imleci gizler
ShowCursor(True)  //imleci tekrardan gösterir.

Ekran görüntüsünü alın

procedure TForm1.Button1Click(Sender: TObject);
var
  DCDesk: HDC;
begin
  DCDesk:=GetWindowDC(GetDesktopWindow);
  BitBlt(Form1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,DCDesk, 0, 0,SRCCOPY);
  ReleaseDC(GetDesktopWindow, DCDesk);
end;

Not: Yukarıdaki kod ekran görünütüsünü form üstüne alır. Image bileşeni içine ekran görüntüsünü almak için form üzerine bir image bileşeni yerleştirin ve  Form1.Canvas.Handle yerine Image1.Canvas.Handle yazın.

Map Network Drive diyalogunu açma

WNetConnectionDialog ( 0, RESOURCETYPE_DISK );

Bir dosyayı bağlantılı olduğu uygulama ile açma

uses kısmına shellapi unitini ekleyin.

shellexecute(0,'open', 'c:\test\2.avi','','',SW_NORMAL);

Temp klasörünü bulma

procedure TForm1.Button1Click(Sender: TObject);
var
  temp_klasor: array[0..MAX_PATH] of char;
begin
  GetTempPath(SizeOf(temp_klasor), @temp_klasor);
  ShowMessage(temp_klasor);
end;

Ekran koruyucuyu çalıştırmak

PostMessage(GetDesktopWindow, WM_SYSCOMMAND, SC_SCREENSAVE, 0);

Güç koruma modunda (Power Safe Mode) çalışan monitörü kapatıp açma

Monitörü kapatmak için :

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);

Monitörü açmak için :

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1);

Windows Tarih/Saat Özellikleri (Date/Time Properties) iletişim kutusunu açma

Winexec('Control.exe Date/Time',sw_shownormal);

Windows'ta yüklü bulunan yazıcıları listeleme 

uses kısmına printers unitini ekleyin

procedure TForm1.Button1Click(Sender: TObject);
var
  Printer:TPrinter;
begin
  Printer:=TPrinter.Create;
  Listbox1.Items.Assign(Printer.Printers)
end;

{Bu ipucu Abdurrahman Sinanoğlu tarafından gönderilmiştir}

Programımın Windows NT'de çalıştığını nasıl tespit ederim

if Win32Platform = VER_PLATFORM_WIN32_NT then
  ShowMessage ('NT''de çalışıyorsunuz!');

Windows oturumunu kapatma (log off)

ExitWindows (0,0);

CPU tipini nasıl tespit ederim

uses kısmına Registry unitini ekleyin. Aşağıdaki fonksiyon ile CPU tipini bulabilirsiniz.

function CPUType: string;
var
  Reg: TRegistry;
begin
  CPUType := '';
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\Hardware\Description\System\CentralProcessor\0', False) then
      CPUType := Reg.ReadString('Identifier');
  finally
    Reg.Free;
  end;
end;

Bir klasördeki tüm dosyaları silme

uses kımına ShellApi komutunu ekleyin. Aşağıdaki kod bir klasördeki tüm dosyaları çöp tenekesine atar. Daha fazla seçenek için Delphi yardıma başvurun.

procedure TumDosyalariSil;
var
  T:TSHFileOpStruct;
begin
  fillchar(T, sizeof(T), 0 );
  with T do begin
    Wnd:=0;
    wFunc:=FO_DELETE;
    pFrom:='E:\Temp\TestDel\*.*'#0;
    fFlags:=FOF_ALLOWUNDO or FOF_FILESONLY or
            FOF_SILENT or FOF_NOCONFIRMATION;
  end;
  SHFileOperation(T);
end;

Windows NT/2000/XP'yi Kapatmak

2000 ve XP'de bilgisayarı kapatmak için gerekli yetkiye sahip olmanız lazım. Aşağıda kodla bilgisayarı kapatabilirsiniz. 

var
   tkHandle : THandle;
   BufferLun,ret : DWORD;
   tk,tkPrevious : TTokenPrivileges;
   LID : TLargeInteger;
   LUID : TLuIDAndAttributes;
   versione : TOSVersionInfo;
begin
   BufferLun := 1024;
   ret := 0;
   versione.dwOSVersionInfoSize := sizeof(versione);
   GetVersionEx(versione);
   if versione.dwPlatformId = VER_PLATFORM_WIN32_NT then
         begin
         tkHandle := GetCurrentProcess;
         OpenProcessToken(tkHandle,TOKEN_ALL_ACCESS,tkHandle);
         LookupPrivilegeValue(PChar(''),PChar('SeShutDownPrivilege'),LID);
         LUID.Luid := LID;
         LUID.Attributes := SE_PRIVILEGE_ENABLED;
         tk.PrivilegeCount := 1;
         tk.Privileges[0] := LUID;
         AdjustTokenPrivileges(tkHandle,False,tk,BufferLun,tkPrevious,ret);
      end;
      ExitWindowsEx(EWX_SHUTDOWN or EWX_PowerOff,0);
   end;

*.wav (ses) dosyalarını çaldırmak

Bu iş için PlaySound isimli api'yi kullanabilirsiniz. Api geniş bir parametre aralığına sahip, detaylar için Delphi ile gelen Win32 yardım dosyasına bakabilirsiniz.

PlaySound('C:\WINDOWS\MEDIA\Windows Start.wav', 0, Snd_FileName or Snd_Async);

Programımın simgesi Tray'de (saatin yanında) gözüksün

Bu işi yapan birçok bileşen var. Bunlardan en iyisi artık bedava olarak dağıtılan TurboPower ShellShock paketi içindeki tray bileşeni. Bu paketi indirip kurun. İndirme detayları için sitedeki 3. Parti bileşenler kısmındaki TurboPower yazısına bakabilirsiniz.

Programım Windows 2000/Xp'de düzgün çalışıyor, Win9x'te TComboBox bileşeninde xxx.Items.String EReadError veriyor

Bu hata genellikle sistem kaynakları yetersiz olduğu zaman alınmakta. Win 9x'te sistem kaynakları biraz sınırlı.

Diğer programlarda bu tip hatalar almıyorsanız, programınızda aldığınız kaynakları ve bunları işi bittiği anda serbest bırakıp bırakmadığınızı kontrol edin.

Win9x'te user ve gdi kaynakları hala sınırlı. TWinControl sınıfından türeyen componentlerin hepsi handle'a sahiptir. Win9x'te handle sayısı 16K ile sınırlı. Ayrıca glyph, image, imagelist ve font gibi componentler de gdi kaynaklarını kullanırlar. Bu da sınırlı Win9x'te. Aşağıdaki noktalara dikkat edin.

1. Kesin çözüm 2000 veya XP'ye terfi. Eğer işyeri ise güvenlik gibi başka nedenlerle bu en iyi çözüm olacaktır. Biliyorsunuz Win9x'in hedef kitlesi ev kullanıcıları.

2. Formları otomatik create etmeyin. Gerektiği zaman oluşturup işi bitince yok edin.

3. TWinControl'den türeyen bileşenler yerine grafik componentler kullanın. Mesela Panel yerine Bevel kullanın. Grafik componentlerin handle'ları olmadığı için Windows kaynaklarını kullanmazlar.

4. Kendi oluşturduğuz nesneleri yok edin. Mesela bir stringlist oluşturup, daha sonra yok etmezseniz program kapatılsa bile hafızada kalmaya devam eder. Aynı kodu programda bir çok kez çağırıyorsanız gerisini siz düşünün.

5. Windows'ta resource monitör isimli bir program var. Yüklü değilse Program ekle/Kaldır windows kısmından kurabilirsiniz. Burdan user ve gdi resource kısmını takip ederek nerelerde kaynakların kritik noktalara indiğini takip edip önlem alabilirsiniz.

6. Herşey yolunda olsa bile eğer bir formda çok fazla bileşen veya resim vs. varsa buda etkileyebilir. Geçenlerde birisi 1600 tane buton olan bir formdan bahsediyordu.

Başka bir uygulamayı kapatmak

Programatik olarak başka bir uygulamayı kapatmak için, uygulamay WM_QUIT mesajı göndermeniz lazım.

function KillApp(const sCapt: PChar) : boolean;
 var AppHandle:THandle;
begin
 AppHandle:=FindWindow(Nil, sCapt);
 Result:=PostMessage(AppHandle, WM_QUIT, 0, 0);
end;
 

Kullanılışı :

if not KillApp('Pencere başlığı') then
 ShowMessage('Uygulama kapatılamadı!');

CD'nin takılıp çıkarıldığından haberdar olma

Bunun için WM_DEVICECHANGE mesajlarını yakalamamız lazım.

private kısmına aşağıdaki satırı ekleyin :

procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;

bu da yakalama kısmı :

procedure TForm1.WMDeviceChange (var Msg: TMessage);
const
  CD_IN = $8000;
  CD_OUT = $8004;
var
  Mesaj : String;
begin
  inherited;
  case Msg.wParam of
    CD_IN : Mesaj := 'CD takıldı';
    CD_OUT : Mesaj := 'CD çıkarıldı';
  end;
  ShowMessage(Mesaj);
end;

Sürücü (drive) tipini belirlemek

Formun üzerine bir memo ve bir buton koyun ve aşağıdaki kodu yazın.

procedure TForm1.Button1Click(Sender: TObject);
var
  Drive: Char;
  DriveLetter: String[4];
begin
  for Drive := 'A' to 'Z' do
    begin
      DriveLetter := Drive + ':\';
      case GetDriveType(PChar(Drive + ':\')) of
        DRIVE_REMOVABLE: Memo1.Lines.Add(DriveLetter + ' Disket Sürücü(Floppy Drive)');
        DRIVE_FIXED: Memo1.Lines.Add(DriveLetter + ' Sabit disk(Fixed Drive)');
        DRIVE_REMOTE: Memo1.Lines.Add(DriveLetter + ' Ağ sürücüsü(Network Drive)');
        DRIVE_CDROM: Memo1.Lines.Add(DriveLetter + ' CD-Rom(CD-ROM Drive)');
        DRIVE_RAMDISK: Memo1.Lines.Add(DriveLetter + ' RAM Disk');
      end;
    end;
end;

Bir fontu (.ttf) Windows'a kurmadan uygulamanızda kullanma

Formun OnCreate ve OnClose olaylarına aşağıdaki kodları yazın.

procedure TForm1.FormCreate(Sender: TObject);
begin
 AddFontResource('c:\FONTS\MyFont.TTF');
 SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;

procedure TForm1.FormClose (Sender: TObject; var Action: TCloseAction);
begin
 RemoveFontResource('C:\FONTS\MyFont.TTF');
 SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;

Bir Klasördeki Dosyaları Başka Bir Klasöre Kopyalama

uses kısmına ShellApi unitini ekleyin.

procedure TForm1.Button1Click(Sender: TObject);
var
  OpStruc: TSHFileOpStruct;
  frombuf, tobuf: Array [0..128] of Char;
Begin
  {The fillchars make sure the parameters are terminated by at least
   two #0 characters, this is required since each parameter can hold
   a list of zero-terminated strings, the extra #0 terminates the
   list. }
  fillChar( OpStruc, Sizeof(OpStruc), 0 );
  FillChar( frombuf, Sizeof(frombuf), 0 );
  FillChar( tobuf, Sizeof(tobuf), 0 );
  StrPCopy( frombuf, 'c:\deneme\*.*' );
  StrPCopy( tobuf, 'd:\deneme' );
  With OpStruc DO Begin
    Wnd:= Handle;
    wFunc:= FO_COPY;
    pFrom:= @frombuf;
    pTo:=@tobuf;
    fFlags:= FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
  end;
  ShFileOperation( OpStruc );
end;

Windows'un Özel Klasörlerini Açma

Aşağıdaki kodla Bilgisayarım, Masaüstü, Yazıcılar, Fontlar gibi özel Windows klasörlerini açabilirsiniz.

uses shellapi, ShlObj, ActiveX;

procedure TForm1.Button1Click(Sender: TObject);
var
exInfo: TShellExecuteInfo;
Procedure FreePidl( pidl: PItemIDList );
Var
allocator: IMalloc;
Begin
If Succeeded(SHGetMalloc(allocator)) Then Begin
allocator.Free(pidl);
{$IFDEF VER90}
allocator.Release;
{$ENDIF}
End;
End;

Begin
FillChar( exInfo, Sizeof(exInfo), 0 );
// initialize all fields to 0
With exInfo Do Begin
cbSize:= Sizeof( exInfo ); // required!
fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_IDLIST;
Wnd := Handle;
nShow := SW_SHOWNORMAL;
lpVerb := 'open';
ShGetSpecialFolderLocation( handle, CSIDL_DESKTOP , PItemIDLIst(lpIDList ));
End;
ShellExecuteEx( @exInfo );
FreePIDL( exinfo.lpIDList );
end;

Diğer özel klasörler : CSIDL_DESKTOP, CSIDL_PROGRAMS, CSIDL_CONTROLS, CSIDL_PRINTERS, CSIDL_PERSONAL, CSIDL_STARTUP, CSIDL_RECENT, CSIDL_SENDTO, CSIDL_BITBUCKET, CSIDL_STARTMENU, CSIDL_DESKTOPDIRECTORY, CSIDL_DRIVES (My Computer), CSIDL_NETWORK, CSIDL_NETHOOD, CSIDL_FONTS, CSIDL_TEMPLATES.
bimeks borland component database delphi delphi.net delphi dersleri firebird help interbase makale oracle seminer software sybase veritabanı web