fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
Desktop Chaos (funktioniert jetzt)

Uploader:	_Gorgon
Datum/Zeit:	04.03.2008 19:41:46
'Desktop Chaos by Gorgon



'Achtung: Wirft deinen gesamten Desktop durcheinander..

'Es dürfen keine Häckchen bei Symbole Anordnen nach->Automatisch anordnen

'bei und Symbole Anordnen nach->Am Raster ausrichten gesetzt sein, weil

'sonst die Items nicht verschoben werden können..



'Ich übernehme keine Haftung für unordentliche Desktops!



#Include Once "windows.bi"

#Include Once "win/commctrl.bi"

#Include Once "win/tlhelp32.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



? "Press any key to quit"



Do



    Index = 0

    SleepEx(4, FALSE)



    '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 > 900 Then ItemPos.x = 100

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



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



        Index += 1

    Wend



    'LockWindowUpdate(NULL)

    'UpdateWindow(hDesk)



Loop Until Len(InKey) > 0



MemDeAllocInProc(hOpen, SizeOf(Point))

CloseHandle(hOpen)



End



Function GetDesktopListViewHandle( ) As HANDLE



    Dim TempHandle As HANDLE

    Dim ClassName As ZString * 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



    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 HANDLE = CreateToolhelp32Snapshot(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 = Process32First(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 = Process32Next(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