Mega Code Archive

 
Categories / Delphi / Games
 

[] Bazı shell işlemleri

//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.