Delphi-PRAXiS - LuckieDIPS

Wenn wir schon dabei sind, 64-Bit Support...

GetDesktopIconInfo()

Delphi-Quellcode:

			const

  ItemBufferBlockSize = $1000;

type

  PLvItemBuffer = ^TLvItemBuffer;

  TLvItemBuffer = packed record

    case Integer of

      0: (

        LvItem32: packed record

          mask      : LongWord;

          iItem     : LongInt;

          iSubItem  : LongInt;

          state     : LongWord;

          stateMask : LongWord;

          pszText   : LongWord;

          cchTextMax: LongInt;

          iImage    : LongInt;

          lParam    : LongWord;

          iIndent   : LongInt;

          iGroupId  : LongInt;

          cColumns  : LongWord;

          puColumns : LongWord

        end);

      1: (

        LvItem64: packed record

          mask      : LongWord;

          iItem     : LongInt;

          iSubItem  : LongInt;

          state     : LongWord;

          stateMask : LongWord;

          _align1   : LongWord;

          pszText   : Int64;

          cchTextMax: LongInt;

          iImage    : LongInt;

          lParam    : Int64;

          iIndent   : LongInt;

          iGroupId  : LongInt;

          cColumns  : LongWord;

          _align2   : LongWord;

          puColumns : Int64;

        end);

      2: (LvItemBuff: array [0..ItemBufferBlockSize - 1] of Byte;

    case Integer of

      0: (AnsiText: array [0..ItemBufferBlockSize - 1] of AnsiChar);

      1: (WideText: array [0..ItemBufferBlockSize div 2 - 1] of WideChar);

      2: (ItemText: array [0..ItemBufferBlockSize div SizeOf(Char)-1] of Char));

  end;

type

  TFNIsWow64Process = function(hProcess: THandle; out Wow64Process: BOOL): BOOL;

    stdcall;

var

  FNIsWow64Process: TFNIsWow64Process;

function IsWow64Process(hProcess: THandle): Boolean;

var

  Wow64Process: BOOL;

begin

  if not Assigned(FNIsWow64Process) then

    FNIsWow64Process := TFNIsWow64Process(

      GetProcAddress(GetModuleHandle(kernel32), 'IsWow64Process'));

  if not Assigned(FNIsWow64Process) then

    Result := False

  else

    Result := FNIsWow64Process(hProcess, Wow64Process) and Wow64Process;

end;

function GetDesktopIconInfo: TDesktopIconInfoArray;

var

  ListView : HWND;

  ProcessId: DWORD;

  Process  : THandle;

  Size     : Cardinal; // SIZE_T

  MemLocal : PLvItemBuffer;

  MemRemote: PLvItemBuffer;

  NumBytes : Cardinal; // SIZE_T

  IconCount: DWORD;

  IconIndex: Integer;

  IconLabel: string;

  IconPos  : TPoint;

  DesktopIconInfoArray: TDesktopIconInfoArray;

begin

  // Fensterhandle des Desktop-ListView ermitteln und Prozess oeffnen

  ListView := GetDesktopListView;

  ProcessId := 0;

  GetWindowThreadProcessId(ListView, @ProcessId);

  Process := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_OPERATION or

    PROCESS_VM_READ or PROCESS_VM_WRITE, False, ProcessId);

  if Process <> 0 then

  try

    // Lokalen und entfernten (im Zielprozess) Puffer anlegen

    Size := SizeOf(TLvItemBuffer);

    MemLocal := VirtualAlloc(nil, Size, MEM_COMMIT, PAGE_READWRITE);

    MemRemote := VirtualAllocEx(Process, nil, Size, MEM_COMMIT, PAGE_READWRITE);

    if Assigned(MemLocal) and Assigned(MemRemote) then

    try

      // Anzahl der Symbole ermitteln und in einer Schleife durchlaufen

      IconCount := SendMessage(ListView, LVM_GETITEMCOUNT, 0, 0);

      Setlength(DesktopIconInfoArray, IconCount);

      for IconIndex := 0 to IconCount - 1 do

      begin

        // Symboltext auslesen

        // (es gibt zwei identische Strukturen, jeweils eine in diesem und eine

        //  im Zielprozess. Wobei die Daten zwischen den Puffern hin und her

        //  kopiert werden muessen. Dieser Aufwand ist noetig, da LVM_GETITEM

        //  eine Struktur liest und schreibt, die sich im Adressraum des

        //  Prozesses befindet, dem das entsprechende Fenster gehoert...)

        ZeroMemory(MemLocal, SizeOf(TLvItemBuffer));

        with MemLocal^ do

          if IsWow64Process(GetCurrentProcess) and

            not IsWow64Process(Process) then

          begin

            LvItem64.mask := LVIF_TEXT;

            LvItem64.iItem := IconIndex;

            LvItem64.pszText := Cardinal(MemRemote) + ItemBufferBlockSize;

            LvItem64.cchTextMax := High(MemLocal.ItemText) + 1;

          end

          else

          begin

            LvItem32.mask := LVIF_TEXT;

            LvItem32.iItem := IconIndex;

            LvItem32.pszText := Cardinal(MemRemote) + ItemBufferBlockSize;

            LvItem32.cchTextMax := High(MemLocal.ItemText) + 1;

          end;

        NumBytes := 0;

        if WriteProcessMemory(Process, MemRemote, MemLocal, Size, NumBytes) and

          Boolean(SendMessage(ListView, LVM_GETITEM, 0, LPARAM(MemRemote))) and

          ReadProcessMemory(Process, MemRemote, MemLocal, Size, NumBytes) then

        begin

          IconLabel := string(MemLocal.ItemText);

          // Position auslesen

          // (-1, -1 ist nur ein Indiz fuer einen Fehlschlag, da diese Position

          //  natuerlich moeglich ist...)

          IconPos.X := -1;

          IconPos.Y := -1;

          if Boolean(SendMessage(ListView, LVM_GETITEMPOSITION, IconIndex,

            LPARAM(MemRemote))) and ReadProcessMemory(Process, MemRemote,

            MemLocal, Size, NumBytes) then

          begin

            IconPos := PPoint(MemLocal)^;

          end;

          // Speichern ;)

          DesktopIconInfoArray[IconIndex].Caption := IconLabel;

          DesktopIconInfoArray[IconIndex].Position.X := IconPos.X;

          DesktopIconInfoArray[IconIndex].Position.Y := IconPos.Y;

        end;

        result := DesktopIconInfoArray;

      end;

    except

      // Exceptions ignorieren

    end;

    // Aufraeumen

    if Assigned(MemRemote) then

      VirtualFreeEx(Process, MemRemote, 0, MEM_RELEASE);

    if Assigned(MemLocal) then

      VirtualFree(MemLocal, 0, MEM_RELEASE);

  finally

    CloseHandle(Process);

  end;

end;

SetDesktopIconPos()

Delphi-Quellcode:

			function SetDesktopIconPos(DesktopIconInfoArray: TDesktopIconInfoArray):

  Boolean;

var

  Listview : HWND;

  ProcessId: DWORD;

  Process  : THandle;

  Size     : Cardinal;

  MemLocal : PLvItemBuffer;

  MemRemote: PLvItemBuffer;

  IconCount: Integer;

  IconIndex: Integer;

  IconLabel: string;

  IconPos  : TPoint;

  NumBytes : Cardinal;

  Loop     : Integer;

begin

  Result := False;

  // Kommentare siehe GetDesktopIconInfo ;o)

  ListView := GetDesktopListView();

  ProcessId := 0;

  GetWindowThreadProcessId(ListView, @ProcessId);

  Process := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_OPERATION or

    PROCESS_VM_READ or PROCESS_VM_WRITE, False, ProcessId);

  if Process <> 0 then

  try

    Size := SizeOf(TLVItemBuffer);

    MemLocal := VirtualAlloc(nil, Size, MEM_COMMIT, PAGE_READWRITE);

    MemRemote := VirtualAllocEx(Process, nil, Size, MEM_COMMIT, PAGE_READWRITE);

    if Assigned(MemLocal) and Assigned(MemRemote) then

    try

      IconCount := SendMessage(ListView, LVM_GETITEMCOUNT, 0, 0);

      for IconIndex := 0 to IconCount - 1 do

      begin

        ZeroMemory(MemLocal, SizeOf(TLvItemBuffer));

        with MemLocal^ do

          if IsWow64Process(GetCurrentProcess) and

            not IsWow64Process(Process) then

          begin

            LvItem64.mask := LVIF_TEXT;

            LvItem64.iItem := IconIndex;

            LvItem64.pszText := Cardinal(MemRemote) + ItemBufferBlockSize;

            LvItem64.cchTextMax := High(MemLocal.ItemText) + 1;

          end

          else

          begin

            LvItem32.mask := LVIF_TEXT;

            LvItem32.iItem := IconIndex;

            LvItem32.pszText := Cardinal(MemRemote) + ItemBufferBlockSize;

            LvItem32.cchTextMax := High(MemLocal.ItemText) + 1;

          end;

        NumBytes := 0;

        if WriteProcessMemory(Process, MemRemote, MemLocal, Size, NumBytes) and

          Boolean(SendMessage(ListView, LVM_GETITEM, 0, LPARAM(MemRemote))) and

          ReadProcessMemory(Process, MemRemote, MemLocal, Size, NumBytes) then

        begin

          IconLabel := string(MemLocal.ItemText);

          for Loop := 0 to Length(DesktopIconInfoArray) - 1 do

          begin

            if DesktopIconInfoArray[Loop].Caption = IconLabel then

            begin

              IconPos.X := DesktopIconInfoArray[IconIndex].Position.X;

              IconPos.Y := DesktopIconInfoArray[IconIndex].Position.Y;

              Result := BOOL(SendMessage(Listview, LVM_SETITEMPOSITION, Loop,

                MAKELPARAM(IconPos.X, IconPos.Y)));

            end;

          end;

        end;

      end;

    except

      // Exceptions ignorieren

    end;

    if Assigned(MemLocal) then

      VirtualFree(MemLocal, 0, MEM_RELEASE);

    if Assigned(MemRemote) then

      VirtualFreeEx(Process, MemRemote, 0, MEM_RELEASE);

  finally

    CloseHandle(Process);

  end;

end;

BTW, in der Schleife von GetDesktopIconInfoFromIni() sollte überprüft werden ob Length(IniSections[Loop]) > 0 ist (sonst kommt es bei einer (angeblich) leeren Section zu einer Zugriffsverletzung).

Gruss Nico

ps: für Unicode müsste man das Programm komplett umschreiben (habe Dateien mit japanischen Symbolen auf dem Desktop...) :)