[DJDrugsounD]

Доброе время суток. Стоит задача сделать скриншот рабочего стола без обоев, чтоб были только иконки на прозрачном фоне. Возможно ли это?

[NumLock]

можно с рабочего стола получить все элементы и уже потом отрисовать их на Bitmap.

[DJDrugsounD]

Сообщение от NumLock

можно с рабочего стола получить все элементы и уже потом отрисовать их на Bitmap.

А не подскажите как это сделать?

Нагуглил как добраться до элементов рабочего стола

Код:

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;

но потом можно получить только координаты элементов путём отправки сообщения LVM_GETITEMPOSITION.

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

[NumLock]

через LVM_GETITEM получить имя ярлыка, далее через IShellLink и IPersistFile получить исходный объект, иконку...
для LVM_GETITEM выделять память/писать/читать через VirtualAllocEx / WriteProcessMemory / ReadProcessMemory

[DJDrugsounD]

Нашёл вот такой код

Код:

procedure TForm1.GetListViewGrid(ALVHandle: HWND; AColumnCount, AItemCount: Integer; ADataGrid: TStringGrid);
const
cchTextMax=255;
var
  hProcess: THandle;
  dwProcessID: DWORD;
   dwWriten: SIZE_T;
  LVItemCount: Integer;
  i, j, nTextLength: Integer;
  pLVItem: ^LV_ITEM;
  LVItem: LV_ITEM;
  pszText: PChar;
  svText: ShortString;
begin
  if ALVHandle = 0 then Exit;
  // Получаем количество строк
  LVItemCount := ListView_GetItemCount(ALVHandle);
 if AItemCount > LVItemCount then exit;
 if AItemCount > 0 then LVItemCount:=AItemCount;
 //Получаем ID процесса, которому принадлежит найденное окно
 dwProcessID := 0;
  GetWindowThreadProcessId(ALVHandle, @dwProcessID);
 if dwProcessID = 0 then
  ExitProcess(GetLastError);
  // Открываем процесс
  hProcess := 0;
  hProcess := OpenProcess(PROCESS_ALL_ACCESS, True, dwProcessID);
  if hProcess = 0 then
  ExitProcess(GetLastError);
  // Выделяем в нем память под текстовый буффер
  pszText := VirtualAllocEx(hProcess, nil, cchTextMax,
                            MEM_COMMIT or MEM_TOP_DOWN, PAGE_READWRITE);
   // Выделяем в нем память под структуру LVITEM
  pLVItem := VirtualAllocEx(hProcess, nil, SizeOf(LV_ITEM),
                                     MEM_COMMIT or MEM_TOP_DOWN, PAGE_READWRITE);
  //Устанавливаем колич строк и столбцов в TStringGrid
  ADataGrid.RowCount := LVItemCount ;
  ADataGrid.ColCount := AColumnCount ;

  // Заполняем структуру
  ZeroMemory(@LVItem, SizeOf(LV_ITEM));
  LVItem.mask := LVIF_TEXT;
  LVItem.pszText := pszText;
  LVItem.cchTextMax := cchTextMax;

  //Считываем строки
  for i := 0 to LVItemCount - 1 do
  begin
    LVItem.iSubItem := 0;
    // Пишем ее в память удаленного процесса
    if not WriteProcessMemory(hProcess, pLVItem, @LVItem,
                 SizeOf(LV_ITEM), dwWriten) then Exit;
    nTextLength := SendMessage(ALVHandle, LVM_GETITEMTEXT,
                                i, Integer(pLVItem));
    // Читаем результат
    ZeroMemory(@svText, cchTextMax);
    ReadProcessMemory(hProcess, LVItem.pszText, @svText[1],
     nTextLength, dwWriten);
     //заполняем строки TStringGrid
    ADataGrid.Cells[0, i + 1] := StrPas(PChar(@svText[1]));
    Memo1.Lines.Add(StrPas(PChar(@svText[1])));
   //Считываем столбцы
   for j := 0 to AColumnCount - 1 do
    begin
      LVItem.iSubItem := j;
      // Пишем ее в память удаленного процесса
      if not WriteProcessMemory(hProcess, pLVItem, @LVItem,
                                SizeOf(LV_ITEM), dwWriten) then Exit;
      nTextLength := SendMessage(ALVHandle, LVM_GETITEMTEXT,
                                 i, Integer(pLVItem));
      // Читаем результат
      ZeroMemory(@svText, cchTextMax);
      ReadProcessMemory(hProcess, LVItem.pszText,
                        @svText[1], nTextLength, dwWriten);
      //заполняем столбцы TStringGrid
      ADataGrid.Cells[j + 1, i + 1] := StrPas(PChar(@svText[1]));
    end;
  end;

 // Освобождаем ранее выделенную память
  VirtualFreeEx(hProcess, pszText, 0, MEM_RELEASE);
  VirtualFreeEx(hProcess, pLVItem, 0, MEM_RELEASE);
  // Закрываем описатель процесса
  CloseHandle(hProcess);
end;

по идеи должен считать названия всех элементов рабочего стола. Не работает, вместо текста каждого элемента пустое значение.

[NumLock]

ну не я же буду в чужом коде разбираться, правильно?

Код:

procedure TFormMain.FillListView(hListView: THandle);
var
  ProcessId: DWORD;
  hProcess: DWORD;
  ItemCount: Integer;
  i: Integer;
  BufItem: PChar;
  data: array [0..MAX_PATH-1] of Char;
  BufText: PChar;
  LVItem: TLVItem;
  dummy: Cardinal;
  APoint: TPoint;
  itm: TListItem;
begin
  GetWindowThreadProcessId(hListView, ProcessId);
  hProcess:=OpenProcess(PROCESS_ALL_ACCESS, False, ProcessId);
  try
    ItemCount:=ListView_GetItemCount(hListView);
    for i:=0 to ItemCount-1 do
    begin
      BufItem:=VirtualAllocEx(hProcess, nil, SizeOf(TLVItem)+Length(data), MEM_COMMIT, PAGE_EXECUTE_READWRITE);
      try
        BufText:=BufItem;
        Inc(BufText, SizeOf(TLVItem));
        ZeroMemory(@LVItem, SizeOf(TLVItem));
        LVItem.mask:=LVIF_TEXT or LVIF_IMAGE;
        LVItem.iItem:=i;
        LVItem.pszText:=BufText;
        LVItem.cchTextMax:=Length(data);
        WriteProcessMemory(hProcess, BufItem, @LVItem, SizeOf(TLVItem), dummy);
        SendMessage(hListView, LVM_GETITEM, i, LPARAM(BufItem));
        ReadProcessMemory(hProcess, BufItem, @LVItem, SizeOf(TLVItem), dummy);
        ReadProcessMemory(hProcess, BufText, @data[0], Length(data), dummy);
        SendMessage(hListView, LVM_GETITEMPOSITION, i, LPARAM(BufText));
        ReadProcessMemory(hProcess, BufText, @APoint, SizeOf(TPoint), dummy);
        itm:=ListView.Items.Add;
        itm.Caption:=StrPas(@data[0]);
        itm.SetPosition(APoint);
      finally
        VirtualFreeEx(hProcess, BufItem, 0, MEM_RELEASE);
      end;
    end;
  finally
    CloseHandle(hProcess);
  end;
end;

[DJDrugsounD]

Сообщение от NumLock

ну не я же буду в чужом коде разбираться, правильно?

спасибо, но всё ровно не работало, были пустые значения.
Но погуглив я узнал что всё из за того что моя система 64 битная. Поэтому чтобы всё работало нужно либо скомпилировать программу под 64 бита, либо использовать другую структуру данных LVItem.

Код:

  TLVItem64 = packed record
    mask      : LongWord;   
    iItem     : LongInt;
    iSubItem  : LongInt;
    state     : LongWord;
    stateMask : LongWord;
    alignment1: LongWord;
    pszText   : Int64;
    cchTextMax: LongInt;
    iImage    : LongInt;
    lParam    : Int64;
    iIndent   : LongInt;
    iGroupId  : LongInt;
    cColumns  : LongWord;
    alignment2: LongWord;
    puColumns : Int64;
    piColFmt  : Int64;
    iGroup    : LongInt;
    alignment3: LongWord;
  end;

с этой структурой всё работает