Solved

Create ShortCut Problem

Posted on 2001-06-19
12
366 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
Comment Utility
Have you Ole2 in your uses clause? If yes, please delete it.

Regards, Madshi.
0
 
LVL 33

Expert Comment

by:Slick812
Comment Utility
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
Comment Utility
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
 

Expert Comment

by:brutebass
Comment Utility
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
Comment Utility
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
Comment Utility
Then do this:

var
  MyObject  : System.IUnknown;

Regards, Madshi.
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:comicboy
Comment Utility
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
Comment Utility
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
Comment Utility
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 33

Expert Comment

by:Slick812
Comment Utility
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 100 total points
Comment Utility
Hi comicboy, simply delete ole2 and add ActiveX. I'm pretty sure it will work then...
0
 

Author Comment

by:comicboy
Comment Utility
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

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
It is a freely distributed piece of software for such tasks as photo retouching, image composition and image authoring. It works on many operating systems, in many languages.
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…

743 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

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now