Path bulmak (Outlook,Explorer...)

[DarkEternal]

Herkese Selamlar,

Gördüğüm bir programda Outlook'un maillerini, adreslerini, Explorer'ın sık kullanılanlarını path olarak direk getiriyordu. Delphide de bunları bulan component yada code mevcut mu? Şimdiden teşekkürler...

[spiderman]

Alintidir. Sahibini bilemedigim icin adini yazamiyorum.

Kod: Tümünü seç

unit ShellOpr;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
  ShlObj, ActiveX, ComObj, Registry;
const
  WherePCSettingsKey= 'Software\MicroSoft\Windows\CurrentVersion\Explorer';
  SettingsSection='Shell Folders';
  Key_Desktop='Desktop';
  Key_AppData='AppData';
  Key_Cache  ='Cache';
  Key_Cookies='Cookies';
  Key_Favorites='Favorites';
  Key_Fonts='Fonts';
  Key_History='History';
  Key_Personal='Personal';
  Key_Programs='Programs';
  Key_Recent='Recent';
  Key_SendTo='SendTo';
  Key_Start_Menu='Start Menu';
  Key_Startup='Startup';
  LNK_EXT='.LNK';

type
  TLocationTarget = (Desktop, ProgramMenu, Startup, StartMenu, All);

procedure CreateShortcut(FileName: TFileName; LinkName: string;Target:TLocationTarget);
procedure DeleteShortcut(Target: TLocationTarget; LinkName: string);
procedure CreateShortCutOnDesktop(LinkName:String);
procedure CreateShortCutOnProgramMenu(LinkName:String);
procedure CreateShortCutOnStartup(LinkName:String);
procedure CreateShortCutOnStartMenu(LinkName:String);
function  getDesktopDirectory:String;
function  getAppDataDirectory:String;
function  getCacheDirectory:String;
function  getCookiesDirectory:String;
function  getFavoritesDirectory:String;
function  getFontsDirectory:String;
function  getHistoryDirectory:String;
function  getMyDocumentsDirectory:String;
function  getProgramsDirectory:String;
function  getRecentDirectory:String;
function  getSendToDirectory:String;
function  getStartMenuDirectory:String;
function  getStartupDirectory:String;


implementation

function getDirectory(FolderName:String):String;
var MyReg:TRegIniFile;
begin
  try
    MyReg:= TRegIniFile.Create(WherePCSettingsKey);
    result:= MyReg.ReadString(SettingsSection,FolderName,'');
  finally
    MyReg.Free;
  end;
end;

function getDesktopDirectory:String;
var MyReg:TRegIniFile;
begin
  try
    MyReg:= TRegIniFile.Create(WherePCSettingsKey);
    result:= MyReg.ReadString(SettingsSection,Key_Desktop,'');
  finally
    MyReg.Free;
  end;
end;

function getAppDataDirectory:String;
var MyReg:TRegIniFile;
begin
  try
    MyReg:= TRegIniFile.Create(WherePCSettingsKey);
    result:= MyReg.ReadString(SettingsSection,Key_AppData,'');
  finally
    MyReg.Free;
  end;
end;

function getCacheDirectory:String;
var MyReg:TRegIniFile;
begin
  try
    MyReg:= TRegIniFile.Create(WherePCSettingsKey);
    result:= MyReg.ReadString(SettingsSection,Key_Cache,'');
  finally
    MyReg.Free;
  end;
end;

function getCookiesDirectory:String;
var MyReg:TRegIniFile;
begin
  try
    MyReg:= TRegIniFile.Create(WherePCSettingsKey);
    result:= MyReg.ReadString(SettingsSection,Key_Cookies,'');
  finally
    MyReg.Free;
  end;
end;

function getFavoritesDirectory:String;
var MyReg:TRegIniFile;
begin
  try
    MyReg:= TRegIniFile.Create(WherePCSettingsKey);
    result:= MyReg.ReadString(SettingsSection,Key_Favorites,'');
  finally
    MyReg.Free;
  end;
end;

function getFontsDirectory:String;
var MyReg:TRegIniFile;
begin
  try
    MyReg:= TRegIniFile.Create(WherePCSettingsKey);
    result:= MyReg.ReadString(SettingsSection,Key_Fonts,'');
  finally
    MyReg.Free;
  end;
end;

function getHistoryDirectory:String;
var MyReg:TRegIniFile;
begin
  try
    MyReg:= TRegIniFile.Create(WherePCSettingsKey);
    result:= MyReg.ReadString(SettingsSection,Key_History,'');
  finally
    MyReg.Free;
  end;
end;

function getMyDocumentsDirectory:String;
var MyReg:TRegIniFile;
begin
  try
    MyReg:= TRegIniFile.Create(WherePCSettingsKey);
    result:= MyReg.ReadString(SettingsSection,Key_Personal,'');
  finally
    MyReg.Free;
  end;
end;

function getProgramsDirectory:String;
var MyReg:TRegIniFile;
begin
  try
    MyReg:= TRegIniFile.Create(WherePCSettingsKey);
    result:= MyReg.ReadString(SettingsSection,Key_Programs,'');
  finally
    MyReg.Free;
  end;
end;

function getRecentDirectory:String;
var MyReg:TRegIniFile;
begin
  try
    MyReg:= TRegIniFile.Create(WherePCSettingsKey);
    result:= MyReg.ReadString(SettingsSection,Key_Recent,'');
  finally
    MyReg.Free;
  end;
end;

function getSendToDirectory:String;
var MyReg:TRegIniFile;
begin
  try
    MyReg:= TRegIniFile.Create(WherePCSettingsKey);
    result:= MyReg.ReadString(SettingsSection,Key_SendTo,'');
  finally
    MyReg.Free;
  end;
end;

function getStartMenuDirectory:String;
var MyReg:TRegIniFile;
begin
  try
    MyReg:= TRegIniFile.Create(WherePCSettingsKey);
    result:= MyReg.ReadString(SettingsSection,Key_Start_Menu,'');
  finally
    MyReg.Free;
  end;
end;

function getStartupDirectory:String;
var MyReg:TRegIniFile;
begin
  try
    MyReg:= TRegIniFile.Create(WherePCSettingsKey);
    result:= MyReg.ReadString(SettingsSection,Key_Startup    ,'');
  finally
    MyReg.Free;
  end;
end;

procedure CreateShortcut(FileName: TFileName; LinkName: string;Target:TLocationTarget);
var
  MyObject  : IUnknown;
  MySLink   : IShellLink;
  MyPFile   : IPersistFile;
  Directory : String;
  WFileName : WideString;
  MyReg     : TRegIniFile;
begin
  MyObject:= CreateComObject(CLSID_ShellLink);
  MySLink:=  MyObject as IShellLink;
  MyPFile:=  MyObject as IPersistFile;
  with MySLink do
  begin
    SetPath(PChar(FileName));                           {Define and set the path}
    SetWorkingDirectory(PChar(ExtractFilePath(FileName)));       {Define workdir}

  try
  MyReg:= TRegIniFile.Create(              {TRY to read info from following key}
  WherePCSettingsKey);

  if (Target = Desktop) or (Target = All) then      {Check for the target}
  begin
    Directory := MyReg.ReadString(SettingsSection,key_Desktop,'');
    WFileName := Directory +'\'+ LinkName +LNK_EXT;  {desired key and caption}
    MyPFile.Save(PWChar(WFileName),False);       {Finally save the IpersistFile}
    end;

  if (Target = ProgramMenu) or (Target = All) then
  begin
    Directory := MyReg.ReadString(SettingsSection,Key_Programs,'');
    WFileName := Directory +'\'+ LinkName +LNK_EXT;
    MyPFile.Save(PWChar(WFileName),False);
    end;

  if (Target = StartMenu) or (Target = All) then
  begin
    Directory := MyReg.ReadString(SettingsSection,key_Start_Menu,'');
    WFileName := Directory +'\'+ LinkName +LNK_EXT;
    MyPFile.Save(PWChar(WFileName),False);
    end;

  if (Target = Startup) or (Target = All) then
  begin
    Directory := MyReg.ReadString(SettingsSection,key_Startup,'');
    WFileName := Directory +'\'+ LinkName +LNK_EXT;
    MyPFile.Save(PWChar(WFileName),False);
     end;
    finally
   MyReg.Free;             {No matter what happens the reg will allways be free}
   Application.ProcessMessages;                              {Free memory (VCL)}
  end;
 end;
end;

procedure CreateShortCutOnDesktop(LinkName:String);
begin
  CreateShortcut(Application.ExeName,LinkName,Desktop);
end;

procedure CreateShortCutOnProgramMenu(LinkName:String);
begin
  CreateShortcut(Application.ExeName,LinkName,ProgramMenu);
end;

procedure CreateShortCutOnStartup(LinkName:String);
begin
  CreateShortcut(Application.ExeName,LinkName,Startup);
end;

procedure CreateShortCutOnStartMenu(LinkName:String);
begin
  CreateShortcut(Application.ExeName,LinkName,StartMenu);
end;

procedure DeleteShortcut(Target: TLocationTarget; LinkName: string);
var
  MyReg     : TRegIniFile;
  Directory : String;
  WFileName : WideString;
begin
  try
  MyReg := TRegIniFile.Create(WherePCSettingsKey);   {TRY to read the key}

  if (Target = Desktop) or (Target  = All) then    {If selected then ....}
  begin
    Directory := MyReg.ReadString(SettingsSection,key_Desktop, '');    {Read path}
    WFileName := Directory +'\'+ LinkName +LNK_EXT;   {Set path + LinkName}
    DeleteFile(PWChar(WFileName));                      {Delete file (shortcut)}
  end else

  if (Target = ProgramMenu) or (Target  = All) then
  begin
    Directory := MyReg.ReadString(SettingsSection,key_Programs, '');
    WFileName := Directory +'\'+ LinkName +LNK_EXT;
    DeleteFile(PWChar(WFileName));
  end else

  if (Target = StartMenu) or (Target  = All) then
  begin
    Directory := MyReg.ReadString(SettingsSection,key_Start_Menu, '');
    WFileName := Directory +'\'+ LinkName +LNK_EXT;
    DeleteFile(PWChar(WFileName));
  end else

  if (Target = Startup) or (Target  = All) then
  begin
    Directory := MyReg.ReadString(SettingsSection,key_Startup, '');
    WFileName := Directory +'\'+ LinkName +LNK_EXT;
    DeleteFile(PWChar(WFileName));
    end;
   finally
  MyReg.Free;                                                   {And free MyReg}
 end;
end;

end.

[DarkEternal]

Çok teşekkürler,gerçekten çok yararlı kodlar.

Fakat bana şu an esas gereken Outlook dosyalarının pathleri; adresler ve mailler... gibi.

Bunların path'inide öğrenmek mümkün mü acaba?