Windows Shortcuts

Notify me of responses

Hi. I am trying to figure out how to use Windows shortcuts.

What I basically want to do is to have several files in one directory somewhere and to be able to paste the shortcuts to those files into another directory then have my program access those files by reading the shortcuts. This way I won't need 10 or more copies of the same support files for each program that I write in seperate directories.

Any ideas?

-- Robert Loy, January 21, 2007 06:34 AM (email)

Answers:


hello,

And what if you get the names of your files from a multiselect filedialog and put them in a text file where you want ?
Or you want the shortcuts to be realy active ?

Jean-Pierre

-- Jean-Pierre Dezaire, January 21, 2007 10:41 AM (email)


I want the shortcuts to be really active. I want my program to be able to read each shorcut file and then be able to find the file where the shortcut points to on my computer's file system.
I want make my windows programs run as seemlessly and effortlessly as any other windows program.
-- Robert Loy, January 21, 2007 11:03 AM (email)


Bellow is a function that will create a Shortcut.

Based on this you should be able to figure out how to read an existing shortcut, I guess.

Sorry for all comments and variables being on portuguese, you will need some effort to understand this. Ignore functions which aren´t declared and things like that ... just focus on the essential.

The main part is initilizing and creating a COM Object. This code was written for Delphi, so may need some modifications.

paPastaEspecial: TPastaEspecial means that you can place the link on a special folder (desktop, start menu, etc) or a custom folder you like.

uses Windows, Registry, SysUtils, ShlObj, ComObj, ActiveX, IO, Classes;

type
  TPastaEspecial = (peAreaTrabalho, peGrupoIniciar,
    peMenuIniciar, peGrupoDeProgramas, peNenhuma);


{----------------------------------------------
  Função de automação que cria atalhos
  Versão 2.0
  Felipe Monteiro de Carvalho    17/8/2002
----------------------------------------------}
function CriarAtalho(const paObjeto, paArquivo, paDescricao: ShortString;
  paPastaEspecial: TPastaEspecial): Boolean;

  {----------------------------------------------
    Copia uma '\' mais uma string terminada em zero
  para uma WideString
  ----------------------------------------------}
  procedure CopiarStr(const De: TCaminho;
  var Para: WideString);
  var
    Buffer: string;
  begin
    Buffer := string(De) + Barra;
    Para := Buffer;
  end;

var
  SArquivo, SObjeto, SDescricao: string;
  Objeto: IUnknown;
  Atalho: IShellLink;
  Arquivo: IPersistFile;
  ID_Dir: PItemIDList;
  Pasta: TCaminho;
  NomeAtalho, PastaAtalho: WideString;
  DirTrab: PChar;
  Ajuda: TAjuda;
begin
  Result := False;
  ZeroMemory(@Ajuda, SizeOf(TAjuda));
  Ajuda.TamanhoDaEstrutura := SizeOf(TAjuda);
  Ajuda.TipoAjuda := ajContexto;
  Ajuda.Numero := AJUDA_ERROS_IO;

  try
    SObjeto := paObjeto;
    SArquivo := paArquivo;
    SDescricao := paDescricao;
    NomeAtalho := paObjeto;// Marca aqui para usar na Central de Erros

    // Inicializa os objetos COM
    CoInitialize(nil);//* Importante, inicializa a biblioteca COM
    Objeto := CreateComObject(CLSID_ShellLink);
    Atalho := Objeto as IShellLink;
    Arquivo := Objeto as IPersistFile;

    // Define as propriedades do atalho
    Atalho.SetPath(PChar(SObjeto));
    Atalho.SetDescription(PChar(SDescricao));

    // *O diretório de trabalho deve terminar sem a /
    //por isso deve-se retirar a ultima letra
    DirTrab := PChar(ExtractFilePath(SObjeto));
    StrLCopy(DirTrab, DirTrab, StrLen(DirTrab) - 1);
    Atalho.SetWorkingDirectory(DirTrab);

    // Procura se ele escolheu uma das pastas comuns
    case paPastaEspecial of
    peAreaTrabalho:
    begin
      SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, ID_Dir);
      SHGetPathFromIDList(ID_Dir, Pasta);
      CopiarStr(Pasta, PastaAtalho);
    end;
    peGrupoIniciar:
    begin
      SHGetSpecialFolderLocation(0, CSIDL_STARTUP, ID_Dir);
      SHGetPathFromIDList(ID_Dir, Pasta);
      CopiarStr(Pasta, PastaAtalho);
    end;
    peMenuIniciar:
    begin
      SHGetSpecialFolderLocation(0, CSIDL_STARTMENU, ID_Dir);
      SHGetPathFromIDList(ID_Dir, Pasta);
      CopiarStr(Pasta, PastaAtalho);
    end;
    peGrupoDeProgramas:
    begin
      SHGetSpecialFolderLocation(0, CSIDL_PROGRAMS, ID_Dir);
      SHGetPathFromIDList(ID_Dir, Pasta);
      CopiarStr(Pasta, PastaAtalho);
    end;
    else// Não escolheu nenhuma pasta
      PastaAtalho := '';
    end;

    // Salva o arquivo no disco
    NomeAtalho := PastaAtalho + SArquivo;
    if Arquivo.Save(PWChar(NomeAtalho), false) = S_OK then
    Result := True;
  except
    DlgCentralSolucoes(PRODUTO, MsgEAoCriarAtalho, NomeAtalho,
    PChar(MsgSEAoCriarAtalho), @Ajuda);
  end;
end;

-- Felipe Monteiro de Carvalho, January 27, 2007 02:34 AM (email)


Ummm.... That won't work with FPC.
I've already tried somthing simillar based on the ShlObj unit.
FPC does have a ShlObj but it is non-functional. I looked at the source code for the unit itself and found out that there are no functions or procedures or anything at all defined in it.
It's pretty much just a waste of harddrive space until someone actually puts somthing in it that is useful to anyone.
It looks like I am going to have to try and scan the files manually myself byte by byte and see what are in these shortcut files. Maybe I can figure out thier fomat. There does seem to be some sort of header in them.
Next thing after that is I would like to be able to do some sort of file support system. I also want to be able to install some sort of universal support system such as icons, wav files, fonts, graphics, mouse pointers and such then be able to somehow register thier locations with Windows. Then any other programs that I install later or write then can query Windows as to where they are and be able to find and access them instantly.
This would be done with some sort of instalation program which could be used by anyone that wants to use them.
Maybe the files should all be placed in a directory/folder that is off of the system or system32 sub directory off of Windows and make that a global instal location for every setup?
-- Robert Loy, January 28, 2007 02:41 AM (email)


Here's my shortcut-unit that I'm using with fpc in fpc-mode:
http://www.abnuto.de/jan/code/shortcut.pas

I'm not interested in reading shortcuts, so I didn't fill out the ISHellLink completely (specially I left out the get*-funtions).

-- Jan Bruns, January 28, 2007 06:05 AM (email)


I downloaded your unit and I started working on it.
Unfortunately I can't seem to figure out how to get the getdirpath to work. I hunted all over the web looking for any information on what was written in the unit. It took me hours before I found anything. So I went and added what I was told to and yet it still does not work.
First I had 216 errors poping up, then I had 218 errors poping up.
I look up the 218 error code in the FPC docs and I could not find one defined. lol
Maybe you can figure out what I did wrong. lol



UNIT shortcut;


INTERFACE

  uses windows,strings;

  FUNCTION createShortcut(lnkpos : widestring; dstfn,dstargs,dstwdir,descr,iconfn : AnsiString; iconnum : longint) : boolean;
  Function GetShortcut(lnkpos : widestring):widestring;

  // create a windows shortcut file (*.lnk)@lnkpos.
  // example: createSohrtcut('c:\test.lnk','c:\pascal\myprog.exe','-L 1000','c:\pascal','A nice Program.','c:\pascal\myprog.exe',0);


IMPLEMENTATION




TYPE
REFCLSID = PGUID;
REFIID  = PGUID;

TShellLinkInfo = record
  PathName: string;
  Arguments: string;
  Description: string;
  WorkingDirectory: string;
  IconLocation: string;
  IconIndex: integer;
  ShowCmd: integer;
  HotKey: word;
end;





CONST
CLSID_ShellLink  : TGUID = '{00021401-0000-0000-C000-000000000046}';
IID_IShellLink  : TGUID = '{000214EE-0000-0000-C000-000000000046}';
IID_IPersistFile : TGUID = '{0000010b-0000-0000-C000-000000000046}';
CLSCTX_INPROC_SERVER     = 1;

FUNCTION CoInitialize(p : pointer) : HRESULT; stdcall;  external 'ole32.dll';
FUNCTION CoUninitialize(p : pointer) : HRESULT; stdcall;  external 'ole32.dll';
FUNCTION CoCreateInstance(a:REFCLSID; b:pointer; c:DWORD; d:REFIID; e:pointer)  : HRESULT; stdcall;  external 'ole32.dll';


TYPE
PPISHellLink = ^PISHellLink;
PISHellLink = ^ISHellLink;
ISHellLink = packed record
  QueryInterface : FUNCTION(basis,id,p : pointer) : Hresult; stdcall;
  AddRef : FUNCTION(basis : pointer) : Hresult; stdcall;
  Release : FUNCTION(basis : pointer) : Hresult; stdcall;
  GetPath : FUNCTION(basis : pointer; MAX_PATH:longint; struct:pointer; flags:longword) : Hresult; stdcall;
  GetIDList : pointer;
  SetIDList : pointer;
  GetDescription : pointer;
  SetDescription : FUNCTION(basis : pointer; descr : Pchar) : Hresult; stdcall;
  GetWorkingDirectory : pointer;
  SetWorkingDirectory : FUNCTION(basis : pointer; descr : Pchar) : Hresult; stdcall;
  GetArguments : pointer;
  SetArguments : FUNCTION(basis : pointer; args : Pchar) : Hresult; stdcall;
  GetHotkey : pointer;
  SetHotkey : pointer;
  GetShowCmd : pointer;
  SetShowCmd : pointer;
  GetIconLocation : pointer;
  SetIconLocation : FUNCTION(basis : pointer; iconfile : Pchar; icon : longint) : Hresult; stdcall;
  SetRelativePath : pointer;
  Resolve : pointer;
  SetPath : FUNCTION(basis : pointer; path : Pchar) : Hresult; stdcall;
end;

PPIPersistFile = ^PIPersistFile;
PIPersistFile  = ^IPersistFile;
IPersistFile  = packed record
  QueryInterface : FUNCTION(basis,id,p : pointer) : Hresult; stdcall;
  AddRef : FUNCTION(basis : pointer) : Hresult; stdcall;
  Release : FUNCTION(basis : pointer) : Hresult; stdcall;
  GetClassID : FUNCTION(basis,p : pointer) : Hresult; stdcall;
  IsDirty : FUNCTION(basis : pointer) : Hresult; stdcall;
  Load : FUNCTION(basis : pointer; fn : Pchar; dw : dword) : Hresult; stdcall;
  Save : FUNCTION(basis : pointer; fn : Pchar; dw : dword) : Hresult; stdcall;
  SaveCompleted : FUNCTION(basis : pointer; fn : Pchar) : Hresult; stdcall;
  GetCurFile : FUNCTION(basis : pointer; fn : PPchar) : Hresult; stdcall;
end;


FUNCTION createShortcut(lnkpos : widestring; dstfn,dstargs,dstwdir,descr,iconfn : AnsiString; iconnum : longint) : boolean;
VAR psl : PPISHellLink; psp : PPIPersistFile;
BEGIN
  createShortcut := FALSE;
  if CoCreateInstance(@CLSID_ShellLink,nil,CLSCTX_INPROC_SERVER,@IID_IShellLink,@psl)=0 then begin
//    writeln('got IShellLink');
    if  (psl^^.setPath(psl,@dstfn[1])=0)
    and (psl^^.SetArguments(psl,@dstargs[1])=0)
    and (psl^^.SetWorkingDirectory(psl,@dstwdir[1])=0)
    and (psl^^.SetDescription(psl,@descr[1])=0)
    and (psl^^.SetIconLocation(psl,@iconfn[1],iconnum)=0)
    and (psl^^.queryInterface(psl,@IID_IPersistFile,@psp)=0) then begin
      if psp^^.save(psp,@lnkpos[1],0)=0 then createShortcut := true;
      psp^^.release(psp);
    end;
    psl^^.Release(psl);
  end;
END;


Function GetShortcut(lnkpos : widestring):widestring;


VAR psl : PPISHellLink; psp : PPIPersistFile;

dstfn : AnsiString;

errorcode:integer;
begin
  if CoCreateInstance(@CLSID_ShellLink,nil,CLSCTX_INPROC_SERVER,@IID_IShellLink,@psl)=0 then begin
    if  (psl^^.queryInterface(psl,@IID_IPersistFile,@psp)=0) then begin
    errorcode:=psp^^.load(psp,@lnkpos[1],0);
  if  errorcode= 0 then
  begin
    dstfn:=stralloc($ffd);
    psl^^.GetPath(@dstfn,$ffd,nil, 0);
  end
    else
  begin
    writeln(errorcode);
  end;
  End;
end;
end;

BEGIN
  CoInitialize(nil);
END.

-- Robert Loy, January 29, 2007 05:12 PM (email)