Получить или установить позицию пиктограмм рабочего стола

Delphi , Рабочий стол , Рабочий стол

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

// For Win9x: 
//------------------------------------------- 

uses
   CommCtrl,
   IPCThrd; (from your Delphi\Demos\Ipcdemos directory)

 function GetDesktopListViewHandle: THandle;
 var
   S: String;
 begin
   Result := FindWindow('ProgMan', nil);
   Result := GetWindow(Result, GW_CHILD);
   Result := GetWindow(Result, GW_CHILD);
   SetLength(S, 40);
   GetClassName(Result, PChar(S), 39);
   if PChar(S) <> 'SysListView32' then Result := 0;
 end;

 procedure TForm1.Button1Click(Sender: TObject);
  type
    PInfo = ^TInfo;
    TInfo = packed record
      infoPoint: TPoint;
      infoText: array[0..255] of Char;
      infoItem: TLVItem;
      infoFindInfo: TLVFindInfo;
    end;
 var
    r : TRect;
    hWnd : THandle;
    i, iCount : Integer;

    Info: PInfo;
    SharedMem: TSharedMem;
 begin
   hWnd := GetDesktopWindow();
   GetWindowRect(hWnd,r);
   Memo.Lines.Add('Bottom: ' +  IntToStr(r.Bottom));
   Memo.Lines.Add('Right: ' + IntToStr(r.Right));

   hWnd := GetDesktopListViewHandle;
   iCount := ListView_GetItemCount(hWnd);
   Memo.Lines.Add('# Icons: ' + IntToStr(iCount));

   SharedMem := TSharedMem.Create('', SizeOf(TInfo));
   Info := SharedMem.Buffer;

    with Info^ do
    try
      infoItem.pszText := infoText;
      infoItem.cchTextMax := 255;
      infoItem.mask := LVIF_TEXT;
      try
        begin
          for i := 0 to iCount - 1 do
          begin
            infoItem.iItem := i;
            try
              ListView_GetItem(hWnd, infoItem);
              ListView_GetItemPosition(hWnd, I, infoPoint);
              Memo.Lines.Add('Icon: ' + infoText);
              Memo.Lines.Add('   X: ' + IntToStr(infoPoint.X));
              Memo.Lines.Add('   Y: ' + IntToStr(infoPoint.Y));
            except
            end;
          end;
        end;
      finally
      end;
    finally
      SharedMem.Free;
    end;
 end;

 // For NT, Win2k, XP: 
//------------------------------------------- 
// Unit to save/restore the positions of desktop icons to/from the registry) 

unit dipsdef;

 interface

 uses
   Windows, CommCtrl;

 const
   RegSubKeyName = 'Software\LVT\Desktop Item Position Saver';

 procedure RestoreDesktopItemPositions;
 procedure SaveDesktopItemPositions;

 implementation

 uses
   uvirtalloc, registry;

 procedure SaveListItemPosition(LVH : THandle; RemoteAddr : Pointer);
 var
   lvi : TLVITEM;
   lenlvi : integer;
   nb : integer;
   buffer : array [0..MAX_PATH] of char;
   Base : Pointer;
   Base2 : PByte;
   i, ItemsCount : integer;
   Apoint : TPoint;
   key : HKEY;
   Dummy : integer;
 begin
   ItemsCount := SendMessage(LVH, LVM_GETITEMCOUNT, 0, 0);
   Base := RemoteAddr;
   lenlvi := SizeOf(lvi);
   FillChar(lvi, lenlvi, 0);
   lvi.cchTextMax := 255;
   lvi.pszText := Base;
   inc(lvi.pszText, lenlvi);

   WriteToRemoteBuffer(@lvi, Base, 255);

   Base2 := Base;
   inc(Base2, Lenlvi);

   RegDeleteKey(HKEY_CURRENT_USER, RegSubKeyName);

   RegCreateKeyEx(HKEY_CURRENT_USER,
     PChar(RegSUbKeyName),
     0,
     nil,
     REG_OPTION_NON_VOLATILE,
     KEY_SET_VALUE,
     nil,
     key,
     nil);

   for i := 0 to ItemsCount - 1 do
   begin
     nb := SendMessage(LVH, LVM_GETITEMTEXT, i, LParam(Base));

     ReadRemoteBuffer(Base2, @buffer, nb + 1);
     FillChar(Apoint, SizeOf(Apoint), 0);

     WriteToRemoteBuffer(@APoint, Base2, SizeOf(Apoint));
     SendMessage(LVH, LVM_GETITEMPOSITION, i, LParam(Base) + lenlvi);

     ReadRemoteBuffer(Base2, @Apoint, SizeOf(Apoint));
     RegSetValueEx(key, @buffer, 0, REG_BINARY, @Apoint, SizeOf(APoint));
   end;
   RegCloseKey(key);
 end;


 procedure RestoreListItemPosition(LVH : THandle; RemoteAddr : Pointer);
 type
   TInfo = packed record
     lvfi : TLVFindInfo;
     Name : array [0..MAX_PATH] of char;
   end;
 var
   SaveStyle : Dword;
   Base : Pointer;
   Apoint : TPoint;
   key : HKey;
   idx : DWord;
   info : TInfo;
   atype : Dword;
   cbname, cbData : Dword;
   itemidx : DWord;
 begin
   SaveStyle := GetWindowLong(LVH, GWL_STYLE);
   if (SaveStyle and LVS_AUTOARRANGE) = LVS_AUTOARRANGE then
     SetWindowLong(LVH, GWL_STYLE, SaveStyle xor LVS_AUTOARRANGE);

   RegOpenKeyEx(HKEY_CURRENT_USER, RegSubKeyName, 0, KEY_QUERY_VALUE, key);

   FillChar(info, SizeOf(info), 0);
   Base := RemoteAddr;

   idx := 0;
   cbname := MAX_PATH;
   cbdata := SizeOf(APoint);

   while (RegEnumValue(key, idx, info.Name, cbname, nil, @atype, @Apoint, @cbData) <>
     ERROR_NO_MORE_ITEMS) do
   begin
     if (atype = REG_BINARY) and (cbData = SizeOf(Apoint)) then
     begin
       info.lvfi.flags := LVFI_STRING;
       info.lvfi.psz := Base;
       inc(info.lvfi.psz, SizeOf(info.lvfi));
       WriteToRemoteBuffer(@info, Base, SizeOf(info.lvfi) + cbname + 1);
       itemidx := SendMessage(LVH, LVM_FINDITEM, - 1, LParam(Base));
       if itemidx > -1 then
         SendMessage(LVH, LVM_SETITEMPOSITION, itemidx, MakeLong(Apoint.x, Apoint.y));
     end;
     inc(idx);
     cbname := MAX_PATH;
     cbdata := SizeOf(APoint);
   end;
   RegCloseKey(key);

   SetWindowLong(LVH, GWL_STYLE, SaveStyle);
 end;

 function GetSysListView32: THandle;
 begin
   Result := FindWindow('Progman', nil);
   Result := FindWindowEx(Result, 0, nil, nil);
   Result := FindWindowEx(Result, 0, nil, nil);
 end;

 procedure SaveDesktopItemPositions;
 var
   pid : integer;
   rembuffer : PByte;
   hTarget : THandle;
 begin
   hTarget := GetSysListView32;
   GetWindowThreadProcessId(hTarget, @pid);
   if (hTarget = 0) or (pid = 0) then
     Exit;
   rembuffer := CreateRemoteBuffer(pid, $FFF);
   if Assigned(rembuffer) then
   begin
     SaveListItemPosition(hTarget, rembuffer);
     DestroyRemoteBuffer;
   end;
 end;

 procedure RestoreDesktopItemPositions;
 var
   hTarget : THandle;
   pid : DWord;
   rembuffer : PByte;
 begin
   hTarget := GetSysListView32;
   GetWindowThreadProcessId(hTarget, @pid);
   if (hTarget = 0) or (pid = 0) then
     Exit;
   rembuffer := CreateRemoteBuffer(pid, $FFF);
   if Assigned(rembuffer) then
   begin
     RestoreListItemPosition(hTarget, rembuffer);
     DestroyRemoteBuffer;
   end;
 end;

 end.

 {----------------------------------------------------------}

 unit uvirtalloc;

 interface

 uses
   Windows, SysUtils;

 function CreateRemoteBuffer(Pid : DWord; Size: Dword): PByte;
 procedure WriteToRemoteBuffer(Source : PByte;
                                Dest : PByte;
                                Count : Dword);

 function ReadRemoteBuffer (Source : PByte;
                             Dest : PByte;
                             Count : Dword): Dword;

 procedure DestroyRemoteBuffer;

 implementation

 var
   hProcess : THandle;
   RemoteBufferAddr: PByte;
   BuffSize : DWord;

 function CreateRemoteBuffer;
 begin
   RemoteBufferAddr := nil;
   hProcess := OpenProcess(PROCESS_ALL_ACCESS, FALSE, Pid);
   if (hProcess = 0) then
     RaiseLastWin32Error;

   Result := VirtualAllocEx(hProcess,
                             nil,
                             Size,
                             MEM_COMMIT,
                             PAGE_EXECUTE_READWRITE);

   Win32Check(Result <> nil);
   RemoteBufferAddr := Result;
   BuffSize := Size;
 end;

 procedure WriteToRemoteBuffer;
 var
   BytesWritten: Dword;
 begin
  if hProcess = 0 then
    Exit;
  Win32Check(WriteProcessMemory(hProcess,
                                 Dest,
                                 Source,
                                 Count,
                                 BytesWritten));
 end;

 function ReadRemoteBuffer;
 begin
   Result := 0;
   if hProcess = 0 then
      Exit;

   Win32Check(ReadProcessMemory(hProcess,
                                 Source,
                                 Dest ,
                                 Count,
                                 Result));
 end;

 procedure DestroyRemoteBuffer;
 begin
    if (hProcess > 0)  then
      begin
        if Assigned(RemoteBufferAddr) then
          Win32Check(Boolean(VirtualFreeEx(hProcess,
                                           RemoteBufferAddr,
                                           0,
                                           MEM_RELEASE)));
        CloseHandle(hProcess);
      end;
 end;

 end.

 {----------------------------------------------------------}

 Other Source for NT, Win2k, XP only:
 http://www.luckie-online.de/programme/luckiedipssfx.exe 
(Complete demo to save/restore the positions of desktop icons, nonVCL)

Приведенный код - это программный проект на языке Delphi, который взаимодействует с оболочкой Windows для получения или установки позиции иконок на рабочем столе. Он состоит из двух модулей: dipsdef.pas и uvirtalloc.pas.

dipsdef.pas В этом модуле содержатся процедуры для сохранения и восстановления позиций иконок на рабочем столе: 1. SaveDesktopItemPositions: Сохраняет позиции всех иконок в списке иконок на рабочем столе (SysListView32) в реестре. 2. RestoreDesktopItemPositions: Восстанавливает сохраненные позиции иконок из реестра.

Эти процедуры используют функции Windows API, такие как RegOpenKeyEx, RegEnumValue и RegSetValueEx, для взаимодействия с реестром. Они также используют FindWindow и SendMessage для общения с списком иконок на рабочем столе.

uvirtalloc.pas В этом модуле содержатся функции для создания, записи в, чтения из и уничтожения удаленного буфера: 1. CreateRemoteBuffer: Создает удаленный буфер в процессе с указанным ID. 2. WriteToRemoteBuffer: Записывает данные в удаленный буфер. 3. ReadRemoteBuffer: Читает данные из удаленного буфера. 4. DestroyRemoteBuffer: Уничтожает удаленный буфер.

Эти функции используются модулем dipsdef.pas для взаимодействия с списком иконок на рабочем столе в отдельном процессе, что позволяет программе сохранять и восстанавливать позиции иконок.

Анализ кода Код хорошо организован и соблюдает хорошие практики программирования. Однако, есть некоторые потенциальные проблемы: 1. Использование FindWindow и SendMessage может быть чувствительным к изменениям и не работать, если список иконок на рабочем столе не виден или его окно изменено. 2. Программа не обрабатывает ошибки должным образом; она использует Win32Check для проверки ошибочных условий, но не предоставляет значимых сообщений об ошибках или не обрабатывает неожиданных ошибок. 3. Аллокация и уничтожение удаленного буфера не являются потокобезопасными.

Альтернативные решения Если вы хотите улучшить код, рассмотрите использование более надежного подхода к взаимодействию с списком иконок на рабочем столе, например: 1. Использование COM-интерфейсов (например, IViewObject) для общения с оболочкой. 2. Реализация пользовательского расширения оболочки для управления позициями иконок. 3. Использование библиотеки, которая предоставляет более простой и надежный способ взаимодействия с оболочкой Windows.

Альтернативно, вы можете использовать другой язык программирования или фреймворк, который обеспечивает лучшую поддержку взаимодействия с оболочкой Windows и управления иконками на рабочем столе.

Получить или установить позицию пиктограмм рабочего стола.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Рабочий стол ::