[es] - Kreiranje shortcut-a?!!!

inherited
Novi Sad

Član broj: 95516
Poruke: 219
*.neobee.net.

Profil

^{19.07.2006. u 11:11 - pre 216 meseci}

Evo, nasao sam nesto, ali, ne znam kako bih to mogao koristiti. Odnosno, kako da odradim
ono sto sam pitao pod br. 1?

Code:

function ShellLinkCreate(const Link: TShellLink; const FileName: string): HRESULT;
var
  ShellLink: IShellLink;
  PersistFile: IPersistFile;
  LinkName: TUnicodePath;
begin
  Result := CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
    IID_IShellLink, ShellLink);
  if Succeeded(Result) then
  begin
    ShellLink.SetArguments(PChar(Link.Arguments));
    ShellLink.SetShowCmd(Link.ShowCmd);
    ShellLink.SetWorkingDirectory(PChar(Link.WorkingDirectory));
    ShellLink.SetPath(PChar(Link.Target));
    ShellLink.SetDescription(PChar(Link.Description));
    ShellLink.SetHotkey(Link.HotKey);
    ShellLink.SetIconLocation(PChar(Link.IconLocation), Link.IconIndex);
    PersistFile := ShellLink as IPersistFile;
    MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(FileName), -1,
      LinkName, MAX_PATH);
    Result := PersistFile.Save(LinkName, True);
  end;
end;

Code:

function ShellLinkResolve(const FileName: string; var Link: TShellLink): HRESULT;
const
  MAX_FEATURE_CHARS = 38;   // maximum chars in MSI feature name
var
  ShellLink: IShellLink;
  PersistFile: IPersistFile;
  LinkName: TUnicodePath;
  Buffer: string;
  Win32FindData: TWin32FindData;
  FullPath: string;
  ProductGuid: array [0..38] of Char;
  FeatureID: array [0..MAX_FEATURE_CHARS] of Char;
  ComponentGUID: array [0..38] of Char;
  TargetFile: array [0..MAX_PATH] of Char;
  PathSize: DWORD;
  TargetResolved: Boolean;
begin
  Result := CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
    IID_IShellLink, ShellLink);

  if Succeeded(Result) then
  begin
    TargetResolved := False;

    // Handle MSI style shortcuts without invoking the Windows installer if
    // the feature was set to "Install on first use"
    if RtdlLoadMsiFuncs then
    begin
      FillChar(ProductGuid, SizeOf(ProductGuid), #0);
      FillChar(FeatureID, SizeOf(FeatureID), #0);
      FillChar(ComponentGuid, SizeOf(ComponentGuid), #0);
      FillChar(TargetFile, SizeOf(TargetFile), #0);

      if RtdlMsiGetShortcutTarget(PAnsiChar(FileName), ProductGuid, FeatureID, ComponentGuid) = ERROR_SUCCESS then
      begin
        PathSize := MAX_PATH + 1;
        RtdlMsiGetComponentPath(ProductGuid, ComponentGuid, TargetFile, @PathSize);

        if TargetFile <> '' then
        begin
          Link.Target := TargetFile;
          TargetResolved := True;
        end;
      end;
    end;

    PersistFile := ShellLink as IPersistFile;
    // PersistFile.Load fails if the filename is not fully qualified
    FullPath := ExpandFileName(FileName);
    MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(FullPath), -1, LinkName, MAX_PATH);
    Result := PersistFile.Load(LinkName, STGM_READ);

    if Succeeded(Result) then
    begin
      Result := ShellLink.Resolve(0, SLR_ANY_MATCH);

      if Succeeded(Result) then
      begin
        SetLength(Buffer, MAX_PATH);

        if not TargetResolved then
        begin
          ShellLink.GetPath(PChar(Buffer), MAX_PATH, Win32FindData, SLGP_SHORTPATH);
          Link.Target := PChar(Buffer);
        end;

        ShellLink.GetArguments(PChar(Buffer), MAX_PATH);
        Link.Arguments := PChar(Buffer);
        ShellLink.GetShowCmd(Link.ShowCmd);
        ShellLink.GetWorkingDirectory(PChar(Buffer), MAX_PATH);
        Link.WorkingDirectory := PChar(Buffer);
        ShellLink.GetDescription(PChar(Buffer), MAX_PATH);
        Link.Description := PChar(Buffer);
        ShellLink.GetIconLocation(PChar(Buffer), MAX_PATH, Link.IconIndex);
        Link.IconLocation := PChar(Buffer);
        ShellLink.GetHotkey(Link.HotKey);
        ShellLink.GetIDList(Link.IdList);
      end;
    end;
  end;
end;

Odgovor na temu

savkic
Igor Savkić

Moderator
Član broj: 92186
Poruke: 2739

+92 Profil

Re: Kreiranje shortcut-a?!!!

^{19.07.2006. u 15:20 - pre 216 meseci}

> Evo, nasao sam nesto, ali, ne znam kako bih to mogao koristiti.

Ovako na primer.

Code:

uses
  ActiveX, shlobj, JclShell;

function ShellLinkPerform(const ATarget: string; const AFolder: Integer): Boolean;
var
  DoUninitialize: Boolean;
  Temp: TShellLink;
  LinkPath: string;
begin
  DoUninitialize := Succeeded(CoInitialize(nil));
  // AFolder je CLIDL oznaka foldera u windowsu (Desktop, StartMenu, StartUp...)
  LinkPath := IncludeTrailingBackslash(GetSpecialFolderLocation(AFolder));

  // Dodajmo link u folder, LinkPath vec sadrzi putanju do Foldera, dodajmo mu i filename
  LinkPath := LinkPath + ChangeFileExt(ExtractFileName(ATarget), '.lnk');
  FillChar(Temp, SizeOf(TShellLink), 0);

  Temp.WorkingDirectory := ExtractFilePath(ATarget);
  Temp.Target := ATarget;

  Result := Succeeded(ShellLinkCreate(Temp, LinkPath));
  if not Result then
    RaiseLastWin32Error;

  ShellLinkFree(Temp);

  if DoUninitialize then
    CoUninitialize;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShellLinkPerform('C:\AUTOEXEC.BAT', CSIDL_DESKTOP);
end;

Do not be a help vampire (http://slash7.com/pages/vampires), use the google.

How to ask questions the smart way:
http://www.catb.org/~esr/faqs/smart-questions.html
http://solair.eunet.rs/~fangor...stions/smart-questions.sr.html

Odgovor na temu