ok wenn ich mit dem Registry Wert nicht weiterkommen dann die Idee mit Listview
Code: Alles auswählen
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const OPEN_ALWAYS = 4
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const SECTION_MAP_WRITE = &H2
Public Const FILE_MAP_WRITE = SECTION_MAP_WRITE
'NOT documented in Win32api.txt
Public Const PAGE_READWRITE As Long = &H4
Const LVM_GETTITEMCOUNT& = (&H1000 + 4)
Const LVM_SETITEMPOSITION& = (&H1000 + 15)
Const LVM_FIRST = &H1000
Const LVM_GETITEMPOSITION = (LVM_FIRST + 16)
Const LVM_GETITEMTEXT = LVM_FIRST + 45
'damn hell of a lot of declares
'copymemory *3 avoid byval in code - bug? works this way
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Sub CopyMemoryOne Lib "kernel32" Alias "RtlMoveMemory" _
(ByVal hpvDest&, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Sub CopyMemoryTwo Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, ByVal hpvSource&, ByVal cbCopy As Long)
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam _
As Any) As Long
Declare Function SendMessageByLong& Lib "user32" Alias "SendMessageA" _
(ByVal hwnd&, ByVal wMsg&, ByVal wParam&, ByVal lParam&)
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String)
Private Declare Function FindWindowEx& Lib "user32" Alias _
"FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter _
As Long, ByVal lpClassName As String, ByVal lpWindowName As String)
'declares for printing to the desktop or other window for debug purposes
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal _
hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As _
String, ByVal nCount As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long
Public Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, _
lpRect As Any, ByVal bErase As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'declares for memory-mapped files
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, lpSecurityAttributes As Any, _
ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As _
Long, ByVal hTemplateFile As Long) As Long
' changed lpFileMappigAttributes to Any, makes life much easier
Public Declare Function CreateFileMappingTwo 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
Public 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
Public Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress _
As Any) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject _
As Long) As Long
Public Declare Function FlushViewOfFile Lib "kernel32" (ByVal lpBaseAddress _
As Long, ByVal dwNumberOfBytesToFlush As Long) As Long
das waren nun alles Declare Function
nur zum besseren Lesen aufgeteilt
Code: Alles auswählen
'type declarations
Public Type LV_ITEM ' might need this if we ever figure out
mask As Long ' how to retrieve the text
iItem As Long
iSubItem As Long
State As Long
stateMask As Long
pszText As Long
cchTextMax As Long
iImage As Long
lParam As Long ' I think we might need a second
iIndent As Long ' memory mapped file
End Type
Public Type POINTAPI
x As Long
y As Long
End Type
Dim c As POINTAPI
Public IconPosition() As POINTAPI
Public IconPosition2() As POINTAPI
Public TempIconPosition2 As POINTAPI
'dimension some variables
Dim pNull As Long
Dim MyValue%, MyValue2%
Dim sFileName As String
Dim CurrentDirectory As String
Dim hdesk&, i%
Global icount&
so das ist die eigentliche Function
Code: Alles auswählen
Public Sub FindIcons()
'no error trapping done quick and dirty code
'this is Proof of Concept Code
'a problem for the reader <g>
pNull = 0
hdesk = FindWindow("progman", vbNullString)
hdesk = FindWindowEx(hdesk, 0, "shelldll_defview", vbNullString)
hdesk = FindWindowEx(hdesk, 0, "syslistview32", vbNullString)
'hdesk is the handle of the Desktop's listview
icount = SendMessageByLong(hdesk, LVM_GETTITEMCOUNT, 0, 0&)
'bail if we get a zero count
If icount = 0 Then MsgBox "Error occurred: No icons found", _
vbOKOnly, "PauliesPet": Unload Form1: End
'tell me how many icons we found
Form1.Text1.Text = Str(icount) + " icons detected "
'redimension arrays
ReDim IconPosition(icount) As POINTAPI
ReDim IconPosition2(icount) As POINTAPI
bis zu IconPosition "verstehe" ich es ja noch aber dann ...
Code: Alles auswählen
'///// create a memory-mapped file /////
CurrentDirectory = App.Path
If Right$(CurrentDirectory, 1) <> "\" Then _
CurrentDirectory = CurrentDirectory + "\"
sFileName = CurrentDirectory + "TEMPPPPP.PPP"
' Open file
hFile = CreateFile(sFileName, GENERIC_READ Or GENERIC_WRITE, 0, _
ByVal pNull, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, _
pNull)
' get handle
hFileMap = CreateFileMappingTwo(hFile, ByVal pNull, PAGE_READWRITE, _
0, 16, "MyMapping")
' Get pointer to memory representing file
pFileMap = MapViewOfFile(hFileMap, FILE_MAP_WRITE, 0, 0, 0)
For i = 0 To icount - 1
'lparam is mem-map file Pointer
Call SendMessageByLong(hdesk, LVM_GETITEMPOSITION, i, pFileMap)
'copy returned to our POINTAPI (c.x,c.y)
CopyMemoryTwo c, pFileMap, 8
'show me where the icons are
Form1.List1.AddItem Str(i + 1) + " x-" + Str(c.x) + " y-" _
+ Str(c.y)
'put value in our arrays
IconPosition(i) = c
'back up array for swapping later
IconPosition2(i) = c
Next i
'Release resources back to windows
FlushViewOfFile pFileMap, 8
UnmapViewOfFile pFileMap
CloseHandle hFileMap
CloseHandle hFile
End Sub
Sub RefreshDesktop()
' refresh the whole desktop , we'll just invalidate everything
xcc% = InvalidateRect(0, ByVal 0, 0)
End Sub
Sub RefreshIconPositions()
For i = 0 To icount - 1
'reset our icon switching array
IconPosition2(i) = IconPosition(i)
'Set icon postions back to what we found originally
Call SendMessageByLong(hdesk, LVM_SETITEMPOSITION, i, _
CLng(IconPosition(i).x + IconPosition(i).y * &H10000))
Next i
End Sub
wenn ich "nur" die IconPosition haben will, brauche ich dann noch den "Rest" ?
