[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 389
  • Last Modified:

Create ShortCut Problem

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
comicboy
Asked:
comicboy
  • 4
  • 4
  • 2
  • +1
1 Solution
 
MadshiCommented:
Have you Ole2 in your uses clause? If yes, please delete it.

Regards, Madshi.
0
 
Slick812Commented:
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
 
brutebassCommented:
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
Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

 
brutebassCommented:
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
 
comicboyAuthor Commented:
For Madshi
Sorry, I can't delete OLE2 from uses clause coz I need it on different function.
0
 
MadshiCommented:
Then do this:

var
  MyObject  : System.IUnknown;

Regards, Madshi.
0
 
comicboyAuthor Commented:
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
 
MadshiCommented:
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
 
comicboyAuthor Commented:
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
 
Slick812Commented:
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
 
MadshiCommented:
Hi comicboy, simply delete ole2 and add ActiveX. I'm pretty sure it will work then...
0
 
comicboyAuthor Commented:
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

Take Control of Web Hosting For Your Clients

As a web developer or IT admin, successfully managing multiple client accounts can be challenging. In this webinar we will look at the tools provided by Media Temple and Plesk to make managing your clients’ hosting easier.

  • 4
  • 4
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now