Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Create ShortCut Problem

Posted on 2001-06-19
12
Medium Priority
?
386 Views
Last Modified: 2010-04-06
I need to create shortcut, I know to get the StartMenu folder via registry, but when I create the shortcut uses CLSID_ShellLink I've got error on converting interfaces :

incompatible types:'OLE2.IUnknown' and 'System.IUnknown'

below is my code :

procedure CreateShortCut(Filename, Argument, ShellName: string);
var
  MyObject  : IUnknown;
  MySlink   : IShellLink;
  MyFile    : IPersistFile;
  WFileName : WideString;

begin
  MyObject := CreateComObjects(CLSID_ShellLink);
  MySLink  := MyObject as IShellLink;
  MyPFile  := MyObject as IpersistFile;
  with MySLink do begin
    SetArguments(Arguments);
    SetPath(Pchar(FileName));
    SetWorkingDirectory(Pchar(ExtractFilePatch
    (FileName)));
  end;
  WFileName := ShellPath;
  MyPFile.Save(PwChar(WFileName),False);
end;
0
Comment
Question by:comicboy
  • 4
  • 4
  • 2
  • +1
12 Comments
 
LVL 20

Expert Comment

by:Madshi
ID: 6208054
Have you Ole2 in your uses clause? If yes, please delete it.

Regards, Madshi.
0
 
LVL 34

Expert Comment

by:Slick812
ID: 6209053
hello comicboy, here is a function I use to make shortcuts that works for me, you have to have a path2Obj and a Path2Link, if you use an empty string '' for the WorkingDir or Path2Icon then those will not be used


function CreateLink(Path2Obj,Path2Link,WorkingDir, Path2Icon: string; IconNumber: Integer): Boolean;
var sLink: IShellLink;
    PersFile: IPersistFile;
const
IID_IPersistFile: TGUID = (D1:$0000010B;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
begin
  Result := false;
  CoInitialize(nil);
  if SUCCEEDED(CoCreateInstance(CLSID_ShellLink, nil,
   CLSCTX_INPROC_SERVER, IID_IShellLinkA, sLink)) then
  begin
    sLink.SetPath(PChar(Path2Obj));
    if Length(WorkingDir) > 2 then
    if DirectoryExists(WorkingDir) then
    sLink.SetWorkingDirectory(PChar(WorkingDir));
    if Length(Path2Icon) > 2 then
    if FileExists(Path2Icon) then
    sLink.SetIconLocation(PChar(Path2Icon),IconNumber);
    if SUCCEEDED(sLink.QueryInterface(IID_IPersistFile, PersFile)) then
    begin
      PersFile.Save(StringToOLEStr(Path2Link),TRUE);
      Result := true;
    end;
  end;
  CoUninitialize();
end;
0
 

Expert Comment

by:brutebass
ID: 6209881
uses ShellApi // not sure if it uses ComObj also.

var
   WshShell, SpecialFolders, Shortcut : Variant;
   Path:string;


WshShell:=CreateOleObject('WScript.Shell');
          SpecialFolders:=WshShell.SpecialFolders;
          Path:=SpecialFolders.Item('Desktop')+'\';
          Shortcut:=WshShell.CreateShortcut(Path+'shortcutfilename.LNK'); // Location of the shortcut.
          Shortcut.TargetPath:='c:\myexe.exe'; // Path to the executable or document
          Shortcut.Save; // Writes the shortcut to disk
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 

Expert Comment

by:brutebass
ID: 6209887
of course you can replace or omit the specialfolders.item usage, it simplies getting the windows folder. But you can always read the windows folder from the registry (key: systemroot). you can use this code to make shortcuts anywhere in the system.
0
 

Author Comment

by:comicboy
ID: 6211345
For Madshi
Sorry, I can't delete OLE2 from uses clause coz I need it on different function.
0
 
LVL 20

Expert Comment

by:Madshi
ID: 6211708
Then do this:

var
  MyObject  : System.IUnknown;

Regards, Madshi.
0
 

Author Comment

by:comicboy
ID: 6215764
For Madshi
I've tried your suggestion and it's working on removing error about that incompatible type, but it introduce new error on line :

MyPFile  := MyObject as IpersistFile;

with error says :

Operator not applicable to this operand type.

Anyway about why I can't remove OLE2 from uses, because it required by IPersistentFile.

For Slick812
Your code is causing the same error of incompatible type as my code in this line :

 if SUCCEEDED(CoCreateInstance(CLSID_ShellLink, nil,

For BruteBass
At first sight your suggestion not interrest me as with madshi's and slick812's suggestion because you use different method. But I realize your method is working great and it's easier than looking on IShellLink thingy. But the problem is I don't know all applicable automation object. Please tell me how can I input all the shelllink goodies like WorkingDir, Argument, Iconpath, etc. And could you please tell me what is wscript OLE you call ? is it wscript.exe or what ? anyway where can I know bunch of other OLE object I can use with all of their properties ? (I know this question is out of topic but I know the delphi guru always give the best for newbies like me :) thanks ).
0
 
LVL 20

Expert Comment

by:Madshi
ID: 6215829
BruteBass' solution works only if you have the Windows Scripting Host installed. It's not installed on all OSs by default.

IPersistFile? It's declared in ActiveX.pas in D5. Which Delphi version are you using? D3? Are you sure IPersistFile is not declared in another D3 unit than OLE2? The declaration in my D5 looks like this:

type
  IPersistFile = interface(IPersist)
    ['{0000010B-0000-0000-C000-000000000046}']
    function IsDirty: HResult; stdcall;
    function Load(pszFileName: POleStr; dwMode: Longint): HResult;
      stdcall;
    function Save(pszFileName: POleStr; fRemember: BOOL): HResult;
      stdcall;
    function SaveCompleted(pszFileName: POleStr): HResult;
      stdcall;
    function GetCurFile(out pszFileName: POleStr): HResult;
      stdcall;
  end;

Perhaps you can use this declaration, and then remove OLE2?

Regards, Madshi.
0
 

Author Comment

by:comicboy
ID: 6219583
For Madshi

Thanks for warning me about the Windows scripting thingy, anyway about your declaration yes it's exactly also what IPersistant declared on my D5 but it's in ..\source\rtl\win\ole2.pas and I'm sure and checking that IPersistant is not declared in ActiveX.pas. Do I have different kind of D5 ? I have version build 5.62. Anyway do I have anyway to get around this  in other way ? please help...
0
 
LVL 34

Expert Comment

by:Slick812
ID: 6219729
hello comicboy, I have D5 and IPersistFile is in my ActiveX. Since you are without a working IPersistFile then you could try this code, which does NOT use any additional units (except FileCtrl for DirectoryExists).

unit ShortCut1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, FileCtrl;

const
SID_IShellLinkA  = '{000214EE-0000-0000-C000-000000000046}';

type
TCLSID = TGUID;
POleStr = PWideChar;
TIID = TGUID;

PSHItemID = ^TSHItemID;
  _SHITEMID = record
    cb: Word;
    abID: array[0..0] of Byte;
  end;
  TSHItemID = _SHITEMID;
  SHITEMID = _SHITEMID;

PItemIDList = ^TItemIDList;
  _ITEMIDLIST = record
     mkid: TSHItemID;
   end;
  TItemIDList = _ITEMIDLIST;
  ITEMIDLIST = _ITEMIDLIST;

{I changed the names to avoid any mixups by just adding a '2' to the end}
IShellLink2 = interface(IUnknown)
    [SID_IShellLinkA]
    function GetPath(pszFile: PAnsiChar; cchMaxPath: Integer;
      var pfd: TWin32FindData; fFlags: DWORD): HResult; stdcall;
    function GetIDList(var ppidl: PItemIDList): HResult; stdcall;
    function SetIDList(pidl: PItemIDList): HResult; stdcall;
    function GetDescription(pszName: PAnsiChar; cchMaxName: Integer): HResult; stdcall;
    function SetDescription(pszName: PAnsiChar): HResult; stdcall;
    function GetWorkingDirectory(pszDir: PAnsiChar; cchMaxPath: Integer): HResult; stdcall;
    function SetWorkingDirectory(pszDir: PAnsiChar): HResult; stdcall;
    function GetArguments(pszArgs: PAnsiChar; cchMaxPath: Integer): HResult; stdcall;
    function SetArguments(pszArgs: PAnsiChar): HResult; stdcall;
    function GetHotkey(var pwHotkey: Word): HResult; stdcall;
    function SetHotkey(wHotkey: Word): HResult; stdcall;
    function GetShowCmd(out piShowCmd: Integer): HResult; stdcall;
    function SetShowCmd(iShowCmd: Integer): HResult; stdcall;
    function GetIconLocation(pszIconPath: PAnsiChar; cchIconPath: Integer;
      out piIcon: Integer): HResult; stdcall;
    function SetIconLocation(pszIconPath: PAnsiChar; iIcon: Integer): HResult; stdcall;
    function SetRelativePath(pszPathRel: PAnsiChar; dwReserved: DWORD): HResult; stdcall;
    function Resolve(Wnd: HWND; fFlags: DWORD): HResult; stdcall;
    function SetPath(pszFile: PAnsiChar): HResult; stdcall;
  end;

IPersist2 = interface(IUnknown)
    ['{0000010C-0000-0000-C000-000000000046}']
    function GetClassID(out classID: TCLSID): HResult; stdcall;
  end;

IPersistFile2 = interface(IPersist2)
    ['{0000010B-0000-0000-C000-000000000046}']
    function IsDirty: HResult; stdcall;
    function Load(pszFileName: POleStr; dwMode: Longint): HResult;
      stdcall;
    function Save(pszFileName: POleStr; fRemember: BOOL): HResult;
      stdcall;
    function SaveCompleted(pszFileName: POleStr): HResult;
      stdcall;
    function GetCurFile(out pszFileName: POleStr): HResult;
      stdcall;
  end;

{  * * * * above this line was added to eliminate the ActiveX and ShlObj units    }

  TForm1 = class(TForm)
    but_Exit: TButton;
    but_MakeShort: TButton;
    but_doShort: TButton;
    procedure but_ExitClick(Sender: TObject);
    procedure but_MakeShortClick(Sender: TObject);
    function CreateLink(Path2Obj,Path2Link,WorkingDir,{Desc,}Path2Icon: string; IconNumber: Integer): Boolean;
    procedure but_doShortClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function CoInitialize(pvReserved: Pointer): HResult; stdcall; external 'ole32.dll';
function CoCreateInstance(const clsid: TCLSID; unkOuter: IUnknown;
  dwClsContext: Longint; const iid: TIID; out pv): HResult; stdcall; external 'ole32.dll';
procedure CoUninitialize; stdcall; external 'ole32.dll';

function TForm1.CreateLink(Path2Obj, Path2Link, WorkingDir, Path2Icon: string; IconNumber: Integer): Boolean;

var
    sLink: IShellLink2;
    PersFile: IPersistFile2;
const
IID_IPersistFile2: TGUID = (D1:$0000010B;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
IID_IShellLinkA2: TGUID = (D1:$000214EE; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
CLSID_ShellLink2: TGUID = (D1:$00021401; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
CLSCTX_INPROC_SERVER2 = 1;
begin
  Result := false;
  CoInitialize(nil);
  if CoCreateInstance(CLSID_ShellLink2, nil,
               CLSCTX_INPROC_SERVER2, IID_IShellLinkA2, sLink) = S_OK then
  begin
    if sLink.SetPath(PChar(Path2Obj)) <> NOERROR then
      begin
      CoUninitialize();
      Exit;
      end;
    if Length(WorkingDir) > 2 then
    if DirectoryExists(WorkingDir) then
    sLink.SetWorkingDirectory(PChar(WorkingDir));
    if Length(Path2Icon) > 2 then
    if FileExists(Path2Icon) then
    sLink.SetIconLocation(PChar(Path2Icon),IconNumber);
    if sLink.QueryInterface(IID_IPersistFile2,PersFile) = S_OK then
    begin
      if PersFile.Save(StringToOLEStr(Path2Link),False) = S_OK then
      Result := true;
    end;
  end;
  CoUninitialize();
end;

procedure TForm1.but_ExitClick(Sender: TObject);
begin
Close;
end;

procedure TForm1.but_MakeShortClick(Sender: TObject);
begin
if CreateLink('C:\Windows\Notepad.exe','C:\Windows\Desktop\Note Pad.lnk','','', 0) then
ShowMessage('Shortcut has been made !')
else ShowMessage('NO NO NO NO SHORTCUT');
end;

procedure TForm1.but_doShortClick(Sender: TObject);
const
CLSID_ShellLink2: TGUID = (D1:$00021401; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
CLSCTX_INPROC_SERVER2 = 1;
CLSCTX_LOCAL_SERVER2 = 4;

var
UnObject : IUnknown;
ShelLink : IShellLink2;
PersFile : IPersistFile2;
WLinkName: WideString;
Path1:PChar;
begin
CoInitialize(nil);
if CoCreateInstance(CLSID_ShellLink2, nil, CLSCTX_INPROC_SERVER2 or
    CLSCTX_LOCAL_SERVER2, IUnknown, UnObject) <> S_OK then
    begin
    ShowMessage('NO CoCreate');
    CoUninitialize();
    Exit;
    end;
ShelLink := UnObject as IShellLink2;
PersFile := UnObject as IPersistFile2;
Path1:= 'C:\Windows\Notepad.exe';
if ShelLink.SetPath(Path1) <> NOERROR then
    begin
    ShowMessage('NO SetPath');
    CoUninitialize();
    Exit;
    end;
WLinkName := 'C:\Windows\Desktop\Note Pad2.lnk';
if PersFile.Save(PWChar(WLinkName), False) = S_OK then
ShowMessage('ShortCut Created') else
ShowMessage('ShortCut was NOT Created');
CoUninitialize();
end;

end.

- - - - - - - - - - - - - - - -

I included both versions (mine and yours) of making a shortcut to see if both worked, , , , ,
let me know
0
 
LVL 20

Accepted Solution

by:
Madshi earned 400 total points
ID: 6221141
Hi comicboy, simply delete ole2 and add ActiveX. I'm pretty sure it will work then...
0
 

Author Comment

by:comicboy
ID: 6253300
Madshi, you're right thanks...

I wonder why should I put OLE2 anyway...

Since when I Ctrl-Click on a words which links to OLE2 I assume that I must include OLE2, which actually you've said doesn't need it. Thanks alot
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Is your data getting by on basic protection measures? In today’s climate of debilitating malware and ransomware—like WannaCry—that may not be enough. You need to establish more than basics, like a recovery plan that protects both data and endpoints.…
Whether it be Exchange Server Crash Issues, Dirty Shutdown Errors or Failed to mount error, Stellar Phoenix Mailbox Exchange Recovery has always got your back. With the help of its easy to understand user interface and 3 simple steps recovery proced…

783 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question