//Gokhan G,
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.