home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / WIN / Programa / FILEEXP.ZIP / SHELLUTL.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1996-03-11  |  4.2 KB  |  123 lines
  1. unit ShellUtl;
  2.  
  3. interface
  4.  
  5. uses Windows,Ole2;
  6.  
  7. function CreateLink(lpszPathObj,lpszPathLink,lpszDesc:String):HResult;
  8. function ResolveIt(Wnd:HWND; lpszLinkFile:String):String;
  9.  
  10.  
  11. implementation
  12.  
  13. uses SysUtils,ShellAPI,ShellObj;
  14.  
  15. (*
  16. The CreateLink function in the following example creates a shortcut.
  17. The parameters include a pointer to the name of the file to link to,
  18. a pointer to the name of the shortcut that you are creating, and a
  19. pointer to the description of the link. The description consists of
  20. the string, "Shortcut to filename," where filename is the name of the
  21. file to link to.
  22. Because CreateLink calls the CoCreateInstance function, it is assumed
  23. that the CoInitialize function has already been called. CreateLink uses
  24. the IPersistFile interface to save the shortcut and the IShellLink interface
  25. to store the filename and description.
  26.  
  27.  CreateLink - uses the shell's IShellLink and IPersistFile interfaces
  28.      to create and store a shortcut to the specified object.
  29.  Returns the result of calling the member functions of the interfaces.
  30.  lpszPathObj - address of a buffer containing the path of the object
  31.  lpszPathLink - address of a buffer containing the path where the
  32.                shell link is to be stored
  33.  lpszDesc - address of a buffer containing the description of the
  34.      shell link
  35. *)
  36. function CreateLink(lpszPathObj,lpszPathLink,lpszDesc:string):HResult;
  37. var
  38.   hRes: HRESULT;
  39.   psl: IShellLink;
  40.   ppf: IPersistFile;
  41.   wsz: PWideChar;
  42. begin
  43.     GetMem(wsz,MAX_PATH*2);
  44.     try
  45.     { Get a pointer to the IShellLink interface. }
  46.     hres := CoCreateInstance(CLSID_ShellLink, nil,
  47.                             CLSCTX_INPROC_SERVER, IID_IShellLink, psl);
  48.     if SUCCEEDED(hres) then
  49.        begin
  50.        { Set the path to the shortcut target, and add the
  51.          description.  }
  52.        psl.SetPath(@lpszPathObj[1]);
  53.        psl.SetDescription(@lpszDesc[1]);
  54.        { Query IShellLink for the IPersistFile interface for saving the
  55.          shortcut in persistent storage. }
  56.        if SUCCEEDED(psl.QueryInterface(IID_IPersistFile,ppf)) then
  57.          begin
  58.          { Ensure that the string is ANSI. }
  59.          MultiByteToWideChar(CP_ACP, 0, @lpszPathLink[1],-1,wsz,MAX_PATH);
  60.          { Save the link by calling IPersistFile::Save. }
  61.          hres := ppf.Save(wsz,TRUE);
  62.          ppf.Release;
  63.          end;
  64.        psl.Release;
  65.        end;
  66.     Result := hres;
  67.  finally
  68.     FreeMem(wsz,MAX_PATH*2);
  69.     end;
  70. end;
  71.  
  72.  
  73. function ResolveIt(Wnd:HWND; lpszLinkFile:String):String;
  74. var
  75.   hres:HRESULT;
  76.   psl:IShellLink;
  77.   szGotPath: array[0..MAX_PATH-1] of char;
  78.   szDescription: array[0..MAX_PATH-1] of char;
  79.   wfd: TWin32FindData;
  80.   ppf: IPersistFile;
  81.   wsz: array[0..MAX_PATH-1] of WideChar;
  82.  
  83. begin
  84.  Result := ''; { assume failure  }
  85.  { Get a pointer to the IShellLink interface. }
  86.  hres := CoCreateInstance(CLSID_ShellLink, nil,
  87.          CLSCTX_INPROC_SERVER, IID_IShellLink, psl);
  88.  if (SUCCEEDED(hres)) then
  89.      begin
  90.      { Get a pointer to the IPersistFile interface. }
  91.      hres := psl.QueryInterface(IID_IPersistFile,ppf);
  92.      if (SUCCEEDED(hres)) then
  93.          begin
  94.          { Ensure that the string is Unicode. }
  95.          MultiByteToWideChar(CP_ACP, 0,@lpszLinkFile[1],-1,wsz,MAX_PATH);
  96.          { Load the shortcut. }
  97.          hres := ppf.Load(wsz, STGM_READ);
  98.          if (SUCCEEDED(hres)) then
  99.              begin
  100.              { Resolve the link. }
  101.              hres := psl.Resolve(wnd,SLR_ANY_MATCH);
  102.              if (SUCCEEDED(hres)) then
  103.                  begin
  104.                  { Get the path to the link target. }
  105.                  hres := psl.GetPath(szGotPath,MAX_PATH,wfd,SLGP_SHORTPATH);
  106.                  if not SUCCEEDED(hres) then exit;
  107.                  { Get the description of the target. }
  108.                  hres := psl.GetDescription(szDescription, MAX_PATH);
  109.                  if not SUCCEEDED(hres) then exit;
  110.                  Result := StrPas(szGotPath)+'|'+StrPas(szDescription);
  111.                  end;
  112.              end;
  113.          { Release the pointer to the IPersistFile interface. }
  114.          ppf.Release;
  115.          end;
  116.      { Release the pointer to the IShellLink interface. }
  117.      psl.Release;
  118.      end;
  119. end;
  120.  
  121.  
  122. end.
  123.