Icon Shortcut Verkn\u00fcpfung anlegen<\/p>\n
You can try the code below – maybe you needed CoInitialize?
\nThe code works fine for me on NT and 98, using Delphi4.
\n
\n[code lang=”delphi”]{
\n function CreateAShortcut(aTarget,startDir,aCaption,aGroup: string;
\n aLoc: TShortcut; silent: Boolean): Boolean;<\/p>\n
HISTORY: Original version by
\n ======== – Jon E. Scott
\n web: http:\/\/members.xoom.com\/jescott (“Delphi Code Tips”)
\n email: jescott@xoommail.com <\/p>\n
Some improvements and comments 1999-06-18 by
\n Bjorn Mossberg: mossberg@mindspring.com <\/p>\n
PURPOSE: To create a shortcut on the desktop, start menu,
\n ======== in a program group, in the SendTo folder,
\n or in the SysTray region.<\/p>\n
REQUIRES:
\n =========
\n uses ShlObj, ComObj, Registry, ActiveX; \/\/ and others<\/p>\n
type
\n TShortcut = (sc_Desktop, sc_QuickLaunch, sc_SendTo,
\n sc_Start, sc_Programs);<\/p>\n
PARAMETERS:
\n ===========<\/p>\n
aTarget: The full path to the executable file
\n for which a shortcut is to be created.<\/p>\n
startDir: String specifying the folder that is to be made
\n current before aTarget executes. May be blank.<\/p>\n
aCaption: String specifying the “legend” to be written
\n under the icon. May be left blank, in which
\n case the name of the executable file minus
\n its extension is used.
\n Caution: Use only legal file characters!<\/p>\n
aGroup: Meaningful only when aLoc=sc_Programs,
\n sc_Desktop, or sc_SendTo.
\n Specifies the name of the subfolder to
\n which the shortcut is to be added.
\n Should already exist.<\/p>\n
aLoc: One of the values of type ShortcutType:<\/p>\n
}
\nfunction CreateAShortcut(aTarget,startDir,aCaption,aGroup: string;
\n aLoc: TShortcut; silent: Boolean): Boolean;
\nvar
\n anObject: IUnknown;<\/p>\n
function SaveLinkFile(aCap,aFldr: String): Boolean;
\n var
\n aPFile: IPersistFile;
\n s,fName: String;
\n wName: WideString;
\n i: Integer;
\n begin
\n {Save a copy of the object as a link file.
\n Try up to 3 times, using tails ” (2)” and ” (3)”.}
\n Result := False;
\n aPFile := anObject as IPersistFile;
\n s := EmptyStr;
\n for i:=1 to 3 do begin
\n fName := aCap + s + ‘.lnk’;
\n wName := MergedPath(aFldr,fName);
\n Result := S_OK=aPFile.Save(PWChar(wName), False);
\n if Result then Break;
\n s := Format(‘ (%d)’,[i]);
\n end;
\n end;<\/p>\n
function MergedPath(rootDir,subDir: String): String;
\n var
\n n: Integer;
\n begin
\n n := Length(rootDir);
\n if n=0 then Result := subDir
\n else begin
\n if rootDir[n]=’\\’ then Delete(rootDir,n,1);
\n n := Length(subDir);
\n if n=0 then Result := rootDir
\n else begin
\n if subDir[1]=’\\’ then Delete(subDir,1,1);
\n Result := rootDir + ‘\\’ + subDir;
\n end;
\n end;
\n end;<\/p>\n
const
\n BaseKey = ‘Software\\MicroSoft\\Windows\\CurrentVersion’;
\n Shell_Folders = ‘Shell Folders’;
\n VDesktop = ‘Desktop’;
\n ProgramMenu = ‘”Start | Programs” menu’;
\nvar
\n aDir,aVar: String;
\n aDesc: String;
\n dskTop: String;
\n s,msg: String;
\nbegin
\n Result := False;
\n if NOT (CoInitialize(nil) in [S_OK,S_FALSE]) then begin
\n ShowMessage(‘Could not initialize OLE COM Library’);
\n Exit;
\n end;<\/p>\n
{Create an object that can be used as a shortcut
\n and later saved as a customized ???.lnk file.}
\n anObject := CreateComObject(CLSID_ShellLink);
\n try
\n with anObject as IShellLink do begin
\n {Write in “Target” in the link file:
\n The full path of the executable file}
\n SetPath(PChar(aTarget));<\/p>\n
{If supplied, write in “Start In” in the link file:
\n The folder to be made current before executing “Target”.}
\n if (Length(startDir)>0) AND DirectoryExists(startDir) then
\n SetWorkingDirectory(PChar(startDir));
\n end;<\/p>\n
{If aCaption is supplied we use that as the caption
\n under the icon representing the shortcut.
\n Otherwise we simply strip the extension
\n from the name of the target file.
\n NOTE: The name of the link file is “aCaption.lnk”. }
\n if Length(aCaption)=0 then
\n aCaption := ExtractFileName(aTarget);
\n aCaption := ReplaceAll(aCaption,’\/’,’-‘); {May need other fixing.}
\n aCaption := ChangeFileExt(aCaption, EmptyStr);<\/p>\n
aVar := EmptyStr;
\n aDesc := EmptyStr;
\n case aLoc of
\n sc_Start: aVar := ‘Start Menu’;
\n sc_Programs: begin
\n aVar := ‘Programs’;
\n aDesc := ProgramMenu;
\n end;
\n sc_SendTo: begin
\n aVar := ‘SendTo’;
\n aDesc := aVar + ‘ menu’;
\n end;
\n sc_QuickLaunch:
\n with TRegIniFile.Create(BaseKey+’\\GrpConv’) do try
\n aVar := ‘Quick Launch’; {Need aVar for msg later}
\n aDir := ReadString(‘MapGroups’,aVar,EmptyStr);
\n aDesc := aVar + ‘ (SysTray) area’;
\n finally
\n Free;
\n end;
\n else
\n aVar := VDesktop; {Default}
\n end;
\n if Length(aDesc)=0 then
\n aDesc := aVar;<\/p>\n
with TRegIniFile.Create(BaseKey+’\\Explorer’) do try
\n {Always get the path to the Desktop as a fallback.}
\n dskTop := ReadString(Shell_Folders,VDesktop,EmptyStr);
\n if Length(aDir)=0 then begin
\n {Here for all cases except _QUICKLAUNCH}
\n if Length(aVar)>0 then {Paranoid check}
\n aDir := ReadString(Shell_Folders,aVar,EmptyStr);
\n if Length(aDir)=0 then {Should never happen, but …}
\n aDir := dskTop;
\n end;
\n finally
\n Free;
\n end;<\/p>\n
if Length(aDir)=0 then
\n {Hard to imagine that we’ll ever be here.}
\n ShowMessage(‘Could not determine where to create new shortcut!’)
\n else begin
\n msg := Format(‘Added shortcut “%s” to the %s’,[aCaption,aDesc]);
\n {Subfolders do not make sense for the SysTray or StartMenu.}
\n if (Length(aGroup)>0) AND
\n (aLoc in [sc_Desktop,sc_SendTo,sc_Programs]) then
\n begin
\n {The caller is suggesting a subfolder which
\n we hope exists. Use it only if it does!}
\n s := MergedPath(aDir,aGroup);
\n if DirectoryExists(s) then begin
\n aDir := s;
\n AppendStr(msg,Format(‘ in the subfolder “%s”‘,[aGroup]));
\n end else
\n msg := Format(‘”%s” is not a subfolder of the %s.’
\n +’ Added the shortcut directly instead.’,[aGroup,aDesc]);
\n end;<\/p>\n
{Save a copy of the object as a link file.
\n Try up to 3 times, using tails ” (2)” and ” (3)”.}
\n Result := SaveLinkFile(aCaption,aDir);<\/p>\n
if NOT Result then
\n msg := ‘Could not create shortcut to ‘ + aTarget;
\n if NOT Result OR NOT silent then
\n ShowMessage(msg);<\/p>\n
if (Length(dskTop)>0) AND (aDir<>dskTop) AND
\n {Since the dskTop folder is well defined, and not the
\n one we just added the shortcut to, we offer to add a
\n copy of the shortcut to the Desktop as well.
\n We do this whether we failed above or not.}
\n (mrYes=MessageDlg(‘Would you like to add a copy’+
\n ‘ of the shortcut to the desktop?’,
\n mtConfirmation,[mbYes,mbNo],0)) then
\n begin
\n {Don’t reset Result unless we are successful!}
\n msg := ‘esktop shortcut to ‘+aTarget;
\n if SaveLinkFile(aCaption,dskTop) then begin
\n Result := True;
\n msg := ‘D’+msg+’ successfully created!’;
\n end else
\n msg := ‘Could not create d’+msg;
\n if NOT Result OR NOT silent then
\n ShowMessage(msg);
\n end;
\n end;
\n finally
\n\/\/ TComObject(anObject).Free; {Cannot do this! Memory leak???}
\n CoUninitialize;
\n end;
\nend;
\n[\/code]<\/p>\n
[tags]Delphi, System, Files[\/tags]<\/p>\n","protected":false},"excerpt":{"rendered":"
Icon Shortcut Verkn\u00fcpfung anlegen You can try the code below – maybe you needed CoInitialize? The code works fine for me on NT…<\/p>\n","protected":false},"author":2,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"spay_email":""},"categories":[11],"tags":[75,112,113],"jetpack_featured_media_url":"","jetpack_shortlink":"https:\/\/wp.me\/p71Tml-3O","_links":{"self":[{"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/posts\/236"}],"collection":[{"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/users\/2"}],"replies":[{"embeddable":true,"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/comments?post=236"}],"version-history":[{"count":0,"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/posts\/236\/revisions"}],"wp:attachment":[{"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/media?parent=236"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/categories?post=236"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/tags?post=236"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}