Icon + Caption vom "Arbeitsplatz"

[FriFra]

Ich hab jetzt die Lösung gefunden...

Bezeichnung:

Delphi-Quellcode:

  function GetMyComputerName(Default: string = ''): string;
    function ExpandEnvStr(const szInput: string): string;
    begin
      SetLength(Result, ExpandEnvironmentStrings(pChar(szInput), nil, 0));
      ExpandEnvironmentStrings(pChar(szInput), @Result[1], Length(Result));
      Result := StrPas(@Result[1]);
    end;
  var
    Buffer: array[0..MAX_PATH] of char;
    h: hwnd;
    SrcFile: string;
    Index: int64;
    RDF: TRegistry;
  const
    CLSID_MYCOMPUTER = '{20D04FE0-3AEA-1069-A2D8-08002B30309D}';
  begin
    Result := '';

    RDF := TRegistry.Create;
    try
      RDF.RootKey := HKEY_CLASSES_ROOT;
      RDF.OpenKey('CLSID\' + CLSID_MYCOMPUTER, false);

      if (RDF.ValueExists('LocalizedString') = True) and
        (RDF.ReadString('LocalizedString') <> '') then
      begin
        SrcFile := copy(RDF.ReadString('LocalizedString'), 2, MAX_PATH);
        Index := StrToIntDef(Copy(SrcFile, Pos(',', SrcFile) + 1,
          Length(SrcFile)), 0);
        if Index < 0 then
          Index := Index - (2 * Index);
        SrcFile := Copy(SrcFile, 1, Pos(',', SrcFile) - 1);
        SrcFile := ExpandEnvStr(SrcFile);
        if (FileExists(SrcFile) = True) and (Index <> 0) then
        begin
          h := loadlibrary(PAnsiChar(SrcFile));
          try
            if h <> 0 then
            begin
              if Loadstring(h, Index, @Buffer, MAX_PATH) > 0 then
              begin
                Result := StrPas(buffer);
              end
              else
                Result := Default;
            end
            else
              Result := Default;
          finally
            freelibrary(h)
          end;
        end;
      end;
      if (Result = Default) and (RDF.ValueExists('') = True) and
        (RDF.ReadString('') <> '') then
        Result := RDF.ReadString('');
    finally
      RDF.Free;
    end;
  end;

Das Icon bekomme ich, indem ich eine Verknüpfung auf den Arbeitsplatz aus den Resourcen meines Programmes entpacke und diese anschließend an "GetShellIcon" übergebe:

Delphi-Quellcode:

function TDupFind_Main.GetShellIcon(FileName: string; NoFile: boolean): integer;
var
  SHFileInfo: TSHFileInfo;
  Tmp: string;
  Txt: textfile;
begin
  if AUic = False then
  begin
    Result := 0;
    //Falls ein Laufwerksbuchstabe übergeben wurde...
    if Length(FileName) = 1 then
      FileName := FileName + ':';
    //Laufwerke sollten mit \ enden...
    if (Length(FileName) = 2) and (copy(FileName, length(FileName), 1) = ':')
      and
      (copy(FileName, length(FileName), 1) <> '\') then
      FileName := FileName + '\';

    // CoInitialize has to be called before SHGetFileInfo (done by Delphi)
    FillChar(SHFileInfo, SizeOf(TSHFileInfo), 0);

    //Dateiino lesen...
    if NoFile = False then
      ShGetFileInfo(PChar(FileName), 0, SHFileInfo, SizeOf(TSHFileInfo),
        SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_ICON)
    else
      ShGetFileInfo(PChar(FileName), FILE_ATTRIBUTE_ARCHIVE, SHFileInfo,
        SizeOf(TSHFileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON or
        SHGFI_ICON or SHGFI_USEFILEATTRIBUTES);

    try
      Result := SHFileInfo.iIcon;
    finally
      // you are responsible for destroying the icon handle
      DestroyIcon(SHFileInfo.hIcon);
    end;
  end
  else
    Result := UIdx;
end;