Merhabalar @
haydarxxx ;
Bilişim öğretmeni misiniz? Kod yazabilen bilişim öğretmeni görmek beni şaşırttı doğrusu, tebrikler.
Olayımıza dönüş yapınca aslında benim söylemek istediğim biraz yanlış anlaşılmış.
Path değişkeninin değeri yanlış yerde atılmış. Bu sebeple .lnk dosyasını silmemesi normal. Bende aldım fonksiyonları falan çalışır hale getirdim. Bundan sonra top sizde;
unit untMain1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.IOUtils,
ShlObj,
ComObj,
ActiveX, Vcl.StdCtrls;
type
TfrmMainScreen = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
function CreateDesktopShellLink(const CSID: Cardinal; const TargetName: string): Boolean;
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Path: String;
end;
var
frmMainScreen: TfrmMainScreen;
implementation
{$R *.dfm}
const
CSIDL_DESKTOP = $0000; { <desktop> }
CSIDL_INTERNET = $0001; { Internet Explorer (icon on desktop) }
CSIDL_PROGRAMS = $0002; { Start Menu\Programs }
CSIDL_CONTROLS = $0003; { My Computer\Control Panel }
CSIDL_PRINTERS = $0004; { My Computer\Printers }
CSIDL_PERSONAL = $0005; { My Documents. This is equivalent to CSIDL_MYDOCUMENTS in XP and above }
CSIDL_FAVORITES = $0006; { <user name>\Favorites }
CSIDL_STARTUP = $0007; { Start Menu\Programs\Startup }
CSIDL_RECENT = $0008; { <user name>\Recent }
CSIDL_SENDTO = $0009; { <user name>\SendTo }
CSIDL_BITBUCKET = $000a; { <desktop>\Recycle Bin }
CSIDL_STARTMENU = $000b; { <user name>\Start Menu }
CSIDL_MYDOCUMENTS = $000c; { logical "My Documents" desktop icon }
CSIDL_MYMUSIC = $000d; { "My Music" folder }
CSIDL_MYVIDEO = $000e; { "My Video" folder }
CSIDL_DESKTOPDIRECTORY = $0010; { <user name>\Desktop }
CSIDL_DRIVES = $0011; { My Computer }
CSIDL_NETWORK = $0012; { Network Neighborhood (My Network Places) }
CSIDL_NETHOOD = $0013; { <user name>\nethood }
CSIDL_FONTS = $0014; { windows\fonts }
CSIDL_TEMPLATES = $0015; { <user name>\appdata\roaming\template folder }
CSIDL_COMMON_STARTMENU = $0016; { All Users\Start Menu }
CSIDL_COMMON_PROGRAMS = $0017; { All Users\Start Menu\Programs }
CSIDL_COMMON_STARTUP = $0018; { All Users\Startup }
CSIDL_COMMON_DESKTOPDIRECTORY = $0019; { All Users\Desktop }
CSIDL_APPDATA = $001a; { <user name>\Application Data }
CSIDL_PRINTHOOD = $001b; { <user name>\PrintHood }
CSIDL_LOCAL_APPDATA = $001c; { <user name>\Local Settings\Application Data (non roaming) }
CSIDL_ALTSTARTUP = $001d; { non localized startup }
CSIDL_COMMON_ALTSTARTUP = $001e; { non localized common startup }
CSIDL_COMMON_FAVORITES = $001f; { User favourites }
CSIDL_INTERNET_CACHE = $0020; { temporary inter files }
CSIDL_COOKIES = $0021; { <user name>\Local Settings\Application Data\..\cookies }
CSIDL_HISTORY = $0022; { <user name>\Local Settings\Application Data\..\history}
CSIDL_COMMON_APPDATA = $0023; { All Users\Application Data }
CSIDL_WINDOWS = $0024; { GetWindowsDirectory() }
CSIDL_SYSTEM = $0025; { GetSystemDirectory() }
CSIDL_PROGRAM_FILES = $0026; { C:\Program Files }
CSIDL_MYPICTURES = $0027; { C:\Program Files\My Pictures }
CSIDL_PROFILE = $0028; { USERPROFILE }
CSIDL_SYSTEMX86 = $0029; { x86 system directory on RISC }
CSIDL_PROGRAM_FILESX86 = $002a; { x86 C:\Program Files on RISC }
CSIDL_PROGRAM_FILES_COMMON = $002b; { C:\Program Files\Common }
CSIDL_PROGRAM_FILES_COMMONX86 = $002c; { x86 C:\Program Files\Common on RISC }
CSIDL_COMMON_TEMPLATES = $002d; { All Users\Templates }
CSIDL_COMMON_DOCUMENTS = $002e; { All Users\Documents }
CSIDL_COMMON_ADMINTOOLS = $002f; { All Users\Start Menu\Programs\Administrative Tools }
CSIDL_ADMINTOOLS = $0030; { <user name>\Start Menu\Programs\Administrative Tools }
CSIDL_CONNECTIONS = $0031; { Network and Dial-up Connections }
CSIDL_COMMON_MUSIC = $0035; { All Users\My Music }
CSIDL_COMMON_PICTURES = $0036; { All Users\My Pictures }
CSIDL_COMMON_VIDEO = $0037; { All Users\My Video }
CSIDL_RESOURCES = $0038; { Resource Directory }
CSIDL_RESOURCES_LOCALIZED = $0039; { Localized Resource Directory }
CSIDL_CDBURN_AREA = $003b; { USERPROFILE\Local Settings\Application Data\Microsoft\CD Burning }
function GetSpecialFolderPath(CSIDLFolder: Integer): string;
var
FilePath: array [0..MAX_PATH] of char;
begin
SHGetFolderPath(0, CSIDLFolder, 0, 0, FilePath);
Result := FilePath;
end;
procedure TfrmMainScreen.Button2Click(Sender: TObject);
begin
DeleteFile(Path);
end;
function TfrmMainScreen.CreateDesktopShellLink(const CSID: Cardinal; const TargetName: string): Boolean;
var
IObject: IUnknown;
ISLink: IShellLink;
IPFile: IPersistFile;
PIDL: PItemIDList;
LinkName: string;
InFolder: array [0..MAX_PATH-1] of Char;
begin
Result := False;
IObject := CreateComObject(CLSID_ShellLink);
ISLink := IObject as IShellLink;
IPFile := IObject as IPersistFile;
with ISLink do
begin
SetDescription('Açıklama ...');
SetPath(PChar(TargetName));
SetWorkingDirectory(PChar(ExtractFilePath(TargetName)));
end;
SHGetSpecialFolderLocation(0, CSID, PIDL);
SHGetPathFromIDList(PIDL, InFolder) ;
LinkName := IncludeTrailingPathDelimiter(GetSpecialFolderPath(CSID));
LinkName := LinkName + TPath.GetFileNameWithoutExtension(TargetName) + '.lnk';
Path := LinkName;
if not FileExists(LinkName) then
if IPFile.Save(PWideChar(LinkName), False) = S_OK then
Result := True;
end;
procedure TfrmMainScreen.Button1Click(Sender: TObject);
begin
if CreateDesktopShellLink(CSIDL_DESKTOP, Application.ExeName) then
ShowMessage('OK!');
end;
end.
Projeye ulaşmak için tıklayınız -->
Buraya!
Kolay gelsin.
Project -> Options -> Application
