fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
Desktop Chaos

Uploader:	_Gorgon
Datum/Zeit:	01.03.2008 19:21:53
'Achtung macht dir deinen gesamten Desktop durcheinander!

'by _Gorgon



#Include Once "windows.bi"

#Include Once "win/commctrl.bi"

#Include Once "process.bi"



Declare Function    GetDesktopListViewHandle    ( ) As HANDLE

Declare Function    GetDataFromProc             (As HANDLE, As Any Ptr, As Integer) As Point

Declare Sub         WriteDataToProc             (As HANDLE, As Any Ptr, As Any Ptr, As Integer)

Declare Function    GetProcHandle               (As String) As Long

Declare Function    MemAllocInProc              (As HANDLE, As Integer) As Any Ptr

Declare Function    MemDeAllocInProc            (As HANDLE, As Integer) As Boolean



Dim Index As Integer

Dim ItemPos As Point

Dim ItemPosPtr As Point Ptr



Dim hDesk As HWND   = GetDesktopWindow( )

Dim hList As HWND   = GetDesktopListViewHandle( )

'Dim hImgL As HANDLE = ListView_GetImageList(hList, LVSIL_NORMAL)

Dim hExpl As Long   = GetProcHandle("Explorer")

Dim hOpen As HANDLE = OpenProcess(PROCESS_ALL_ACCESS, FALSE, hExpl)



ItemPosPtr = MemAllocInProc(hOpen, SizeOf(Point))



'? "Handle der DesktopListView: "; hList

''? "Handle der ImageList: "; hImgL

'? "Prozesshandle des Explorers: "; hExpl

'? "Handle zu geöffnetem Prozess: "; hOpen

'? "Adresse von ItemPos: "; ItemPosPtr



Do



    'LockWindowUpdate(hDesk)

    While ListView_GetItemPosition(hList, Index, ItemPosPtr) = TRUE



        ItemPos = GetDataFromProc(hOpen, ItemPosPtr, SizeOf(Point))

        '? Index; ": "; ItemPos.x; " | "; ItemPos.y



        ItemPos.x += Rnd(1) * 15

        ItemPos.y += Rnd(1) * 15



        If ItemPos.x > 1000 Then ItemPos.x = 100

        If ItemPos.y > 900 Then ItemPos.y = 100



        ListView_SetItemPosition(hList, Index, ItemPos.x, ItemPos.y)



        Index += 1

    Wend



    'LockWindowUpdate(NULL)

    'UpdateWindow(hDesk)

    Index = 0



    SleepEx(4, FALSE)

Loop

'? "Indizes: "; Index





MemDeAllocInProc(hOpen, SizeOf(Point))

CloseHandle(hOpen)



Sleep

End





Function GetDesktopListViewHandle( ) As HANDLE



    Dim TempHandle As HANDLE

    Dim ClassName As ZString Ptr = CAllocate(40)



    TempHandle = FindWindow("ProgMan", NULL)

    TempHandle = GetWindow(TempHandle, GW_CHILD) 'Child.. Handle zu SHELLDLL_DefView

    TempHandle = GetWindow(TempHandle, GW_CHILD) 'Child.. Handle zu SysListView32



    'Auf fehler überprüfen

    If GetClassName(TempHandle, ClassName, 39) = 0 Then TempHandle = NULL

    If *ClassName <> "SysListView32" Then TempHandle = NULL



    DeAllocate(ClassName)

    Return TempHandle



End Function



Function GetDataFromProc(hProc As HANDLE, Adrr As Any Ptr, Size As Integer) As Point



    Dim PointData As POINT

    Dim WrB As Integer



    ReadProcessMemory(hProc, Adrr, @PointData, Size, @WrB)



    Return PointData



End Function



Sub WriteDataToProc(hProc As HANDLE, Adrr As Any Ptr, SourceAdrr As Any Ptr, Size As Integer)



    Dim WrB As Integer

    WriteProcessMemory(hProc, Adrr, SourceAdrr, Size, @WrB)



End Sub



Function GetProcHandle(ProcName As String) As Long



    Dim CurrHandle  As Long

    Dim hSnapShot   As Long = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, NULL)

    Dim ProcData    As PROCESSENTRY32

    Dim NoErr       As Boolean

    Dim TempStr     As String



    ProcName = UCase(ProcName)

    ProcData.dwSize = SizeOf(PROCESSENTRY32)



    'erster Prozess

    NoErr = ProcessFirst(hSnapShot, @ProcData)



    While NoErr

        'Exe Namen vergleichen

        TempStr = UCase(ProcData.szExeFile)

        If InStr(TempStr, ProcName) > 0 Then

            Return ProcData.th32ProcessID

        End If

        'nächster Prozess

        NoErr = ProcessNext(hSnapShot, @ProcData)

    Wend



    'Falls der Prozess nicht gefunden wurde

    Return NULL



End Function



Function MemAllocInProc(hProc As HANDLE, Size As Integer) As Any Ptr



    Dim Adrr As Any Ptr = NULL

    Dim OldProtect As Dword



    Adrr = VirtualAllocEx(hProc, Adrr, Size, MEM_COMMIT, PAGE_READWRITE)



    Return Adrr

End Function



Function MemDeAllocInProc(hProc As HANDLE, Size As Integer) As Boolean



    Dim Adrr As Any Ptr = NULL

    Return VirtualFreeEx(hProc, Adrr, Size, MEM_DECOMMIT)



End Function