unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Types, CommCtrl, IniFiles;
type
TForm1 = class(TForm)
btn1: TButton;
btn2: TButton;
procedure btn1Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// 获取桌面句柄
function GetDesktopHandle: THandle;
begin
Result := FindWindow('progman', nil);
Result := GetWindow(Result, GW_CHILD);
Result := GetWindow(Result, GW_CHILD);
end;
// 获取桌面图标的名称(从桌面进程中读取)
function GetDesktopIconText(nIndex: Integer): string;
var
hDesktop: THandle;
dwPID: DWORD;
hProcess: THandle;
dwNumberOfBytesWritten: DWORD;
dwNumberOfBytesRead: DWORD;
pBuffer: Pointer;
item: TLVItem;
pszText: array[0..MAX_PATH] of Char;
begin
hDesktop := GetDesktopHandle;
GetWindowThreadProcessId(hDesktop, @dwPID);
hProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, False, dwPID);
if hProcess = 0 then Exit;
try
pBuffer := VirtualAllocEx(hProcess, nil, SizeOf(TLVItem) + MAX_PATH, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE);
if pBuffer = nil then Exit;
try
item.iItem := nIndex;
item.iSubItem := 0;
item.cchTextMax := MAX_PATH;
item.pszText := PChar(Cardinal(pBuffer) + SizeOf(TLVItem));
WriteProcessMemory(hProcess, pBuffer, @item, SizeOf(TLVItem) + MAX_PATH, dwNumberOfBytesWritten);
SendMessage(hDesktop, LVM_GETITEMTEXT, nIndex, LPARAM(pBuffer));
ReadProcessMemory(hProcess, Pointer(Cardinal(pBuffer) + SizeOf(TLVItem)), @pszText[0], MAX_PATH, dwNumberOfBytesRead);
Result := string(pszText);
finally
VirtualFreeEx(hProcess, pBuffer, 0, MEM_RELEASE);
end;
finally
CloseHandle(hProcess);
end;
end;
// 获取桌面图标的坐标(从桌面进程中读取)
function GetDesktopIconPostion(nIndex: Integer): TPoint;
var
hDesktop: THandle;
dwPID: DWORD;
hProcess: THandle;
dwNumberOfBytesRead: DWORD;
ppt: Pointer;
begin
hDesktop := GetDesktopHandle;
GetWindowThreadProcessId(hDesktop, @dwPID);
hProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, False, dwPID);
if hProcess = 0 then Exit;
try
ppt := VirtualAllocEx(hProcess, nil, SizeOf(TPoint), MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE);
if ppt = nil then Exit;
try
ListView_GetItemPosition(hDesktop, nIndex, PPoint(ppt)^);
ReadProcessMemory(hProcess, ppt, @Result, SizeOf(TPoint), dwNumberOfBytesRead);
finally
VirtualFreeEx(hProcess, ppt, 0, MEM_RELEASE);
end;
finally
CloseHandle(hProcess);
end;
end;
// 记录桌面图标位置
procedure SaveDesktopIcons;
var
hDesktop: THandle;
i, nCount: Integer;
ptPos: TPoint;
strName: string;
ini: TIniFile;
begin
hDesktop := GetDesktopHandle;
nCount := ListView_GetItemCount(hDesktop);
if nCount <= 0 then Exit;
ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'SavePos.ini');
ini.EraseSection('DESKTOP_ICON_POS');
ini.WriteString('DESKTOP_ICON_POS', 'COUNT', IntToStr(nCount));
try
for i := 0 to nCount - 1 do begin
ptPos := GetDesktopIconPostion(i);
strName := GetDesktopIconText(i);
ini.WriteInteger('DESKTOP_ICON_POS', Format('%s_Index', [strName]), i);
ini.WriteInteger('DESKTOP_ICON_POS', Format('%s_PosX', [strName]), ptPos.X);
ini.WriteInteger('DESKTOP_ICON_POS', Format('%s_PosY', [strName]), ptPos.Y);
end;
finally
ini.Free;
end;
end;
// 恢复桌面图标位置
procedure RestoreDesktopIcons;
var
hDesktop: THandle;
i, nCount: Integer;
strName: string;
nIndex: Integer;
nPosX, nPosY: Integer;
ini: TIniFile;
begin
hDesktop := GetDesktopHandle;
nCount := ListView_GetItemCount(hDesktop);
if nCount <= 0 then Exit;
ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'SavePos.ini');
try
for nIndex := 0 to nCount - 1 do begin
for i := 0 to nCount - 1 do begin
strName := GetDesktopIconText(i);
if nIndex = ini.ReadInteger('DESKTOP_ICON_POS', Format('%s_Index', [strName]), 0) then begin
nPosX := ini.ReadInteger('DESKTOP_ICON_POS', Format('%s_PosX', [strName]), 0);
nPosY := ini.ReadInteger('DESKTOP_ICON_POS', Format('%s_PosY', [strName]), 0);
ListView_SetItemPosition(hDesktop, i, nPosX - 1, nPosY - 1);
Break;
end;
end;
end;
finally
ini.Free;
end;
end;
// 记录
procedure TForm1.btn1Click(Sender: TObject);
begin
SaveDesktopIcons;
end;
// 恢复
procedure TForm1.btn2Click(Sender: TObject);
begin
RestoreDesktopIcons;
end;
end.
