Jak przenieść skróty (jak na pulpicie) do aplikacji?

0

Witajcie,

Na wstępie nim przystąpię do opisywania problemu napiszę iż próbowałem coś na ten temat wygooglać ale chyba używałem niewłaściwych fraz. Jeśli ktoś lepiej googluje to wystarczy mi link do googla resztę zrobię sam.

Potrzebuję zrobić coś w tym stylu:
W aplikacji jest komponent np TListView. Chciałbym metodą drag&drop z pulpitu przenieść dowolny skrót do mojego TListView. Chodzi o to aby użytkownik wewnątrz aplikacji miał możliwość uruchamiania dowolnego skrótu z pulpitu. Finalnie potrzebuję 3 rzeczy. Samą metodę drag&drop umiem obsłużyć jednak z podanego obiektu muszę wyciągnąć ikonkę (aby pokazać ja w TListView), nazwę (aby pod obrazkiem był opis jak na pulpicie), adres (aby było możliwe uruchomienie np kalkulatora z poziomu linku, może to też być zapisany w postaci skrótu URL do strony z ikonką IE).

Będę wdzięczny za wszelką pomoc.

PS.
Nie pytajcie o sensowność takiego rozwiązania gdyż nie mam na to wpływu.

1

Słowo kluczowe to IShellLink. Poniżej masz przydatne linki. Więcej sobie wygoogluj.
http://www.informit.com/articles/article.aspx?p=26940&seqNum=4
http://msdn.microsoft.com/en-us/library/windows/desktop/bb774950(v=vs.85).aspx
Ja nie bawiłem się wiele w odczytywanie skrótów. Raczej w ich tworzenie kodem. Przykład poniżej. Co do pobierania ikony z pliku to banał. Bo przecież jest SHGetFileInfo z modułu ShellApi. Z *.lnk czy *.pif też powinna ona pobrać odpowiednią ikonkę. Ale potestuj. "Bazę do samodzielnego kombinowania" już masz :)

program kit_setup;

{$APPTYPE GUI}

uses
  ShlObj,
  ActiveX,
  Windows;
const
  App_Exec = 'code.exe';
  ShortCut_Name = 'Książę i Tchórz';

function IntToStr(I : Longint) : string;
var
  S : string[11];
begin
  Str(I, S);
  IntToStr := S;
end;

procedure OleError(ErrorCode : HResult);
begin
  MessageBox(GetActiveWindow, PChar('EOleSysError - error code: ' +
    IntToStr(ErrorCode)), PChar('OLE Error'), MB_ICONERROR + MB_OK);
end;

procedure OleCheck(Result : HResult);
begin
  if not Succeeded(Result) then
  begin
    OleError(Result);
  end;
end;

function IsSlashChar(Path : string) : string;
begin
  if Path[Length(Path)] <> '\' then
  begin
    Result := Path + '\'
  end
  else
  begin
    Result := Path;
  end;
end;

function ExtractFilePath(const FileName : string) : string;
var
  I : Integer;
begin
  ExtractFilePath := '';
  for I := Length(FileName) downto 1 do
  begin
    if FileName[I] = '\' then
    begin
      ExtractFilePath := Copy(FileName, 1, I);
      Break;
    end;
  end;
end;

var
  Desktop : PChar;
  Lnk : WideString;
  Handle : THandle;
  PF : IPersistFile;
  ShLnk : IShellLink;
  OsVer : OSVERSIONINFO;
  AppPath, ExePath, WorkDir, IconName : string;
begin
  Handle := FindWindow('Shell_TrayWnd', nil);
  GetMem(Desktop, MAX_PATH + 1);
  OSVer.dwOSVersionInfoSize := SizeOf(OSVERSIONINFO);
  GetVersionEx(OSVer);
  case OSVer.dwPlatformId of
    VER_PLATFORM_WIN32_WINDOWS :
      begin
        SHGetSpecialFolderPath(Handle, Desktop, CSIDL_DESKTOPDIRECTORY, True);
      end;
    VER_PLATFORM_WIN32_NT :
      begin
        SHGetSpecialFolderPath(Handle, Desktop, CSIDL_COMMON_DESKTOPDIRECTORY, True);
      end;
  end;
  CoInitialize(nil);
  OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, ShLnk));
  PF := ShLnk as IPersistFile;
  AppPath := IsSlashChar(ExtractFilePath(ParamStr(0)));
  ExePath := AppPath + App_Exec;
  OleCheck(ShLnk.SetPath(PChar(ExePath)));
  WorkDir := AppPath;
  OleCheck(ShLnk.SetWorkingDirectory(PChar(WorkDir)));
  IconName := AppPath + App_Exec;
  OleCheck(ShLnk.SetIconLocation(PChar(IconName), 0));
  Lnk := IsSlashChar(Desktop) + ShortCut_Name + '.lnk';
  PF.Save(PWideChar(Lnk), True);
  CoUninitialize;
  FreeMem(Desktop);
end.
0

Olesio piwko dla Ciebie :). Uzyskałem taki efekt jaki potrzebowałem czyli drag na formę i nowy item z opisem i ikoną w listview. Jednak mam jeszcze jedno pytanko. Mam już itema w ListView wraz z ikonką. Teraz chciałbym uzyskać efekt po zaznaczeniu itema "uruchomienia" skrótu. Jakiś pomysł co do tego? Shellexecute? Jeśli tak to gdzie zapisać ścieżkę do pliku?

1

Dziękuję. Przydało by się niewirtualne. Wczoraj zaszalałem i będąć zbyt trzeźwym przed szczecińskim disco festivalem, zakupiłem najdroższe w swoim życiu puszkowe Tyskie w namiocie na placu przed halą. Za osiem (sic!) PLN. Ale dobrze, że było chociaż z lodówki. To tak btw.

Co do pytania. To przecież TListItem ma również własność Data. Można przechować najprościej jakiś obiekt z własnymi polami żądanych typów. W tym i string. I teraz wszystko powinno być jasne :)

1

Na śmierć zapomniałem o tej metodzie data ... (ale co się dziwić jak używam listview raz na kilka lat) ... olesio piwko masz murowane (jak tylko pojawię się w twoich stronach albo ty w moich - Katowice).

0

Być może zainteresuje Cię ten kod

interface  

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

type   
  TDropForm = class(TForm)     
    Memo1: TMemo;     
  procedure 
    FormCreate(Sender: TObject) ;   
  private     
    procedure WMDROPFILES(var msg : TWMDropFiles) ; message WM_DROPFILES;   
  public     
    { Public declarations }   
  end;  

var   
  DropForm: TDropForm;  

implementation 

{$R *.dfm}  

uses 
  ShellApi;  

//form's OnCreate event handler

procedure TDropForm.FormCreate(Sender: TObject); 
begin  
  //form is ready to accept files  
  DragAcceptFiles( Handle, True ) ; 
end; 

 (* handle files being dropped on a form *) 

procedure TDropForm.WMDROPFILES(var msg: TWMDropFiles) ; 
const   MAXFILENAME = 255; 
var   
  cnt, fileCount : integer;   
  fileName : array [0..MAXFILENAME] of char;
begin   
  // how many files dropped?   
  fileCount := DragQueryFile(msg.Drop, $FFFFFFFF, fileName, MAXFILENAME) ;    

  // query for file names   
  for cnt := 0 to -1 + fileCount do   
    begin     
      DragQueryFile(msg.Drop, cnt, fileName, MAXFILENAME) ;     
      //do something with the file(s)     
      memo1.Lines.Insert(0, fileName) ;   
    end;    
  //release memory   
  DragFinish(msg.Drop) ; 
end;
  
end.
0

Hej pewnie przyda się innym gdyż tak jak napisałem w pierwszym poście Drag&Drop wiem jak zrobić i mam to zrobione :)

0

Tymbardziej, że kod Toma może nie zadziałać. Choćby pod nowszymi systemami z włączonym UAC. Na forum kiedyś publikowałem kod, który to uwzględnia. A który wygooglowałem kiedyś sam.

1 użytkowników online, w tym zalogowanych: 0, gości: 1