說明

在如何任意排列桌面圖示由提到如何設定作面圖示的位置，但如果想知道這些圖示的位置該如何做呢，簡單說,其實桌面就是一個ListView Control,我們就可以直接用ListView Control Message來對他下命令 這些參數都是LVM_開頭的參數 首先必須取得ListView的Handle 方法如下

hdesk = FindWindowEx(hdesk, 0,"progman", vbNullString)
hdesk = FindWindowEx(hdesk, 0, "shelldll_defview", vbNullString)
hdesk = FindWindowEx(hdesk, 0, "syslistview32", vbNullString)

找到後 就可以用SendMessage傳送LVM_GETITEMPOSITION給ListView 用來取得座標值

Dim o As POINTAPI
Call SendMessage(hdesk, LVM_GETITEMPOSITION, i, o)

但這會發生一個問題 GetItemPosition這並不能跨模組使用 在別的程序呼叫會發生錯誤 因為SendMessage會傳入o的位址 而這個位只是指向呼叫的程序而不是ListView的程序 但ListView並不知道 他還是會乖乖的把變數寫到自己的程序裡面(在Win32中 不同的Process間,同為&H405699位址 是指向不同的地方) 如果這個位只是不能讀寫的 程式就當掉了
有沒有方法能定出一個在每個程序中都是相同的位址呢 在95/98/ME中 就是透過記憶體映射檔 而NT中就得透過Debug API 請參考一下程式 關於更詳細的記憶體配置請參考 如何再外部程式配置記憶體

程式

'這個程式需要一個Command,一個ListBox
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Const LVM_GETTITEMCOUNT& = (&H1000 + 4)
Private Const LVM_GETITEMPOSITION& = (&H1000 + 16)
Private Type POINTAPI
      x As Long
      y As Long
End Type
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Long, ByVal Length As Long)
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long

Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const PROCESS_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Dim hdesk&, i&, iCount&, x&, y&
Private Sub Command1_Click()
Dim o As POINTAPI
Dim AddressOfFileMap As Long
Dim RmMmCls As New myRemoteMCls

hdesk = FindWindow("progman", vbNullString)
hdesk = FindWindowEx(hdesk, 0, "shelldll_defview", vbNullString)
hdesk = FindWindowEx(hdesk, 0, "syslistview32", vbNullString)

'取得圖示各數
iCount = SendMessage(hdesk, LVM_GETTITEMCOUNT, 0, 0)

'取得ListView的Process ID
Dim ProcessID As Long
Call GetWindowThreadProcessId(hdesk, ProcessID)

'配置外部記憶體
AddressOfFileMap = RmMmCls.RemortMemoryAlloc(ProcessID, 16&)
Me.Caption = Hex(AddressOfFileMap)

'用SendMessage取的座標到記憶體中 並讀取(在NT中要透過ReadProcessMemory 9x系統只要用CopyMemory即可讀取)
If RmMmCls.IsNt Then 'NT系統
    Dim hProcess As Long
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, ProcessID)
    For i = 0 To iCount - 1
        Call SendMessage(hdesk, LVM_GETITEMPOSITION, i, ByVal AddressOfFileMap)
        ReadProcessMemory hProcess, ByVal AddressOfFileMap, o, 8&, 0
        List1.AddItem "Index " & i & ": " & "(" & o.x & "," & o.y & ")"
    Next
    CloseHandle hProcess
Else '9x系統
    For i = 0 To iCount - 1
        Call SendMessage(hdesk, LVM_GETITEMPOSITION, i, ByVal AddressOfFileMap)
        CopyMemory o, ByVal AddressOfFileMap, 8
        List1.AddItem "Index " & i & ": " & "(" & o.x & "," & o.y & ")"
    Next
End If

'釋放記憶體
RmMmCls.RemortMemoryRemove ProcessID, AddressOfFileMap
End Sub


---


以下程式在myRemoteMCls.cls中
Option Explicit

Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long

'Process 操作
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128      '  Maintenance string for PSS usage
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
        (lpVersionInformation As OSVERSIONINFO) As Long
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32s = 0

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Long, ByVal Length As Long)
Private Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" (ByVal hFile As Long, lpFileMappigAttributes As Any, ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
Private Declare Function MapViewOfFile Lib "kernel32" (ByVal hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As Long
Private Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress As Any) As Long


Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_ALWAYS = 4
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const SECTION_MAP_WRITE = &H2
Private Const FILE_MAP_WRITE = SECTION_MAP_WRITE
Private Const PAGE_READWRITE As Long = &H4
Private Const MEM_HANDLE As Long = &HFFFFFFFF

Private Declare Function CoCreateGuid Lib "ole32.dll" (lpGUID As Any) As Long
Private Declare Function StringFromGUID2 Lib "ole32" (lpGUID As Any, ByVal lpStr As String, ByVal lSize As Long) As Long

Private Type FileMap
    iCount As Integer
    AddressOfFileMap() As Long
    hFileMap() As Long
    tProcessID() As Long
    iIndex As Integer
End Type

Dim UseMap As FileMap
'Process 參數
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const PROCESS_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Private Const PROCESS_VM_OPERATION = &H8&
Private Const PROCESS_VM_READ = &H10&
Private Const PROCESS_VM_WRITE = &H20&
Private Const PROCESS_QUERY_INFORMATION = 1024

'記憶體型態
Private Const MEM_COMMIT = &H1000
Private Const MEM_RESERVE = &H2000
Private Const MEM_DECOMMIT = &H4000
Private Const MEM_RELEASE = &H8000
Private Const MEM_FREE = &H10000
Private Const MEM_PRIVATE = &H20000
Private Const MEM_MAPPED = &H40000
Private Const MEM_RESET = &H80000
Private Const MEM_TOP_DOWN = &H100000
Private Const MEM_4MB_PAGES = &H80000000
Private Const SEC_IMAGE = &H1000000
Private Const MEM_IMAGE = SEC_IMAGE

'記憶體保護狀態
Private Const PAGE_NOACCESS = &H1
Private Const PAGE_READONLY = &H2
'Private Const PAGE_READWRITE = &H4
Private Const PAGE_WRITECOPY = &H8
Private Const PAGE_EXECUTE = &H10
Private Const PAGE_EXECUTE_READ = &H20
Private Const PAGE_EXECUTE_READWRITE = &H40
Private Const PAGE_EXECUTE_WRITECOPY = &H80
Private Const PAGE_GUARD = &H100
Private Const PAGE_NOCACHE = &H200
Public IsNt As Boolean

Private Function GetGuidID() As String
Dim pGuid(16) As Byte
Dim s As String
s = String(255, " ")
CoCreateGuid pGuid(0)
StringFromGUID2 pGuid(0), s, 255
s = Trim(s)
GetGuidID = StrConv(s, vbFromUnicode)
End Function

Public Function RemortMemoryAlloc(ByVal ProcessID As Long, Size As Long) As Long
   
UseMap.iIndex = UseMap.iIndex + 1
If UseMap.iIndex > UseMap.iCount Then
    UseMap.iCount = UseMap.iIndex
    ReDim Preserve UseMap.hFileMap(1 To UseMap.iIndex)
    ReDim Preserve UseMap.AddressOfFileMap(1 To UseMap.iIndex)
    ReDim Preserve UseMap.tProcessID(1 To UseMap.iIndex)
End If

UseMap.tProcessID(UseMap.iIndex) = ProcessID

If IsNt Then
    Dim hProcess As Long
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, ProcessID)
    UseMap.hFileMap(UseMap.iIndex) = 0
    UseMap.AddressOfFileMap(UseMap.iIndex) = VirtualAllocEx(hProcess, ByVal 0, Size, MEM_COMMIT Or MEM_RESERVE, PAGE_EXECUTE_READWRITE)
    CloseHandle hProcess
Else
    UseMap.hFileMap(UseMap.iIndex) = CreateFileMapping(MEM_HANDLE, ByVal 0&, PAGE_READWRITE, 0&, Size, GetGuidID)
    UseMap.AddressOfFileMap(UseMap.iIndex) = MapViewOfFile(UseMap.hFileMap(UseMap.iCount), FILE_MAP_WRITE, 0, 0, 0)
End If

RemortMemoryAlloc = UseMap.AddressOfFileMap(UseMap.iIndex)
End Function

Public Function RemortMemoryRemove(ByVal ProcessID As Long, ByVal hAddress As Long) As Long
Dim hFileMap As Long

Dim i As Long

For i = 1 To UseMap.iIndex
    If UseMap.AddressOfFileMap(i) = hAddress Then
        Exit For
    End If
Next

If i > UseMap.iIndex Then
    MsgBox "位址錯誤"
    Exit Function
Else
    UseMap.AddressOfFileMap(i) = UseMap.AddressOfFileMap(UseMap.iIndex)
    hFileMap = UseMap.hFileMap(i)
    UseMap.hFileMap(i) = UseMap.hFileMap(UseMap.iIndex)
    UseMap.tProcessID(i) = UseMap.tProcessID(UseMap.iIndex)
    UseMap.iIndex = UseMap.iIndex - 1
End If

If IsNt Then
    Dim hProcess As Long
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, ProcessID)
    RemortMemoryRemove = VirtualFreeEx(hProcess, hAddress, 0, MEM_RELEASE)
    CloseHandle hProcess
Else
    UnmapViewOfFile hAddress
    RemortMemoryRemove = CloseHandle(hFileMap)

End If
End Function

Private Sub Class_Initialize()
Dim OSVER As OSVERSIONINFO

OSVER.dwOSVersionInfoSize = Len(OSVER)
Call GetVersionEx(OSVER)
If OSVER.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
    IsNt = False
ElseIf OSVER.dwPlatformId = VER_PLATFORM_WIN32_NT Then
    IsNt = True
End If
End Sub

Private Sub Class_Terminate()
Dim hFileMap As Long, i As Long

If IsNt Then
    Dim hProcess As Long
    For i = 1 To UseMap.iIndex
        hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, UseMap.tProcessID(i))
        Call VirtualFreeEx(hProcess, UseMap.AddressOfFileMap(i), 0, MEM_RELEASE)
        CloseHandle hProcess
    Next
Else
    For i = 1 To UseMap.iIndex
        UnmapViewOfFile UseMap.AddressOfFileMap(i)
        Call CloseHandle(UseMap.hFileMap(i))
    Next
End If
Erase UseMap.AddressOfFileMap
Erase UseMap.hFileMap
Erase UseMap.tProcessID
End Sub

文件出處

Honey

範例下載

  GetDesktopIconPos.zip 4.37Kb

整理時間

2003'5,20.

如果對本站有任何建議,歡迎來信給Honey,我們會盡快給您答覆