XProfan

!$H windows.ph
Cls
TODO: SeDebugPrivilege aktivieren, um vielleicht noch besseren Zugriff zu haben
declare id&
print "ID (current =", ~GetCurrentProcessId();"):",
input id&
declare hProcess&
let hProcess& = ~OpenProcess(~PROCESS_ALL_ACCESS,0,id&)

ifnot hProcess&

    print "Prozess konnte nicht geöffnet werden :-("
    print "Taste zum Beenden!"
    WaitKey
    end

endif

print "Handle:",hProcess&
print "-------------------"
declare pMem#,size&
dim pMem#,24
External("NTDLL.DLL","ZwQueryInformationProcess",hProcess&,0,pMem#,24,Addr(size&))
declare peb&
peb& = long(pMem#,4)
print "peb&:",peb&
declare upp&
~ReadProcessMemory(hProcess&,peb&+16,Addr(upp&),4,0)
print "upp&:",upp&
print "-------------------"
declare pDir#
dim pDir#,8 UNICODE_STRING
~ReadProcessMemory(hProcess&,upp&+36,pDir#,SizeOf(pDir#),0)
declare dir&,len&
len& = word(pDir#,0)
dir& = long(pDir#,4)
print "Länge:",len&
print "Adresse:",dir&
dispose pDir#
print "-------------------"
Jetzt String wirklich lesen:
dim pDir#,len&
~ReadProcessMemory(hProcess&,dir&,pDir#,SizeOf(pDir#),0)
color 12,15
TODO: Unicode/Wide-String vernünftig nach ANSI konvertieren:

whileloop 0,len&-1,2

    print chr$(byte(pDir#,&loop));

wend

dispose pDir#
dispose pMem#
~CloseHandle(hProcess&)
color 0,15
print
print
print "Taste zum Beenden!"
WaitKey
ref='./../../funktionsreferenzen/XProfan/end/'>end

!declare hToken&
~OpenProcessToken(~GetCurrentProcess(),~TOKEN_ADJUST_PRIVILEGES,Addr(hToken&))

if hToken& <> 0

    declare priv#
    dim priv#,16

    if External("ADVAPI32.DLL","LookupPrivilegeValueA","","SeDebugPrivilege",priv#+4) <> 0

        long priv#,0 = 1
        long priv#,12 = ~SE_PRIVILEGE_ENABLED
        External("ADVAPI32.DLL","AdjustTokenPrivileges",hToken&,0,priv#,SizeOf(priv#),0,0)

    endif

    dispose priv#
    ~CloseHandle(hToken&)

endif

Def @ZwQueryInformationProcess(5) !"NTDLL","ZwQueryInformationProcess"
DEF @GetCurrentProcess(0) !"kernel32","GetCurrentProcess"
DEF @LsaNtStatusToWinError(1) !"advapi32","LsaNtStatusToWinError"
DEF @FormatMessage(7) !"KERNEL32","FormatMessageA"
Def @Toolhelp32ReadProcessMemory(5) !"KERNEL32","Toolhelp32ReadProcessMemory"
DEF @GetCurrentProcessId(0) !"kernel32","GetCurrentProcessId"
DEF @MultiByteToWideChar(6) !"kernel32","MultiByteToWideChar"
DEF @GetACP(0) !"kernel32","GetACP"
DEF @GetLastError(0) !"kernel32","GetLastError"
DEF @WideCharToMultiByte(8) !"kernel32","WideCharToMultiByte"
DEF @OpenProcess(3) !"KERNEL32","OpenProcess"
DEF @CloseHandle(1) !"kernel32","CloseHandle"
DEF @GetDlgCtrlID(1) !"USER32","GetDlgCtrlID"
DEF @ButtonClicked(1) @GetDlgCtrlID(@&(1))=-%MENUITEM
Def @CreateToolhelp32Snapshot(2) !"kernel32","CreateToolhelp32Snapshot"
Def @Process32First(2) !"kernel32","Process32First"
Def @Process32Next(2) !"kernel32","Process32Next"
DEF @SetLastError(1) !"kernel32","SetLastError"

IF @VAL($WINVER)<5

    @Messagebox("In dieser Windowsversion gibt es noch keine Meldepflicht!","Info",64)
    END

endif

Declare P_INFO#,Read&,Fehler&,PEB&,P_Handle&,Button&,PID$,PR_ID&
Declare AHGETERROR_Buffer#,AHRückgabe&,AHGETERROR_Buffer$,ENV&,READ&,UNICODE#,U_String#,M_String#
Declare Prozesstreeview&,TV_INSERT#,TV_TEXT#,TV_ITEM#,PROCESSENTRY#
Declare hSnapshot&,Result_HL&,Prozess_name$,SEL_ITEM&
Struct LSA_UNICODE_STRING=Length%,MaximumLength%,Buffer&
Struct PROCESSENTRY32=dwSize&,cntUsage&,th32ProcessID&,th32DefaultHeapID&,th32ModuleID&,cntThreads&,th32ParentProcessID&,pcPriClassBase&,dwPrFlags&,szExeFile$(262)
DIM TV_INSERT#,48
DIM TV_TEXT#,513
DIM TV_ITEM#,40
Windowstyle 31+512
Windowtitle "Der gläserne Prozess - Big Brother is watching you!"
Window 0,0-640,440
Usermessages $10
Print "Dieses Programm liest die Current Directory eines fremden Prozesses aus."
Color 12,15
Print "Bitte jetzt auf einen Prozess im Treeview klicken!"
LET Prozesstreeview&=@control("SystreeView32","Prozessliste",$40000000+$10000000+$800000+$200000+$0002+$0010+$0020+$10000+$800,20+10,20+240,360,100,%HWND,2697,%Hinstance)
Usecursor 2
Enablewindow Prozesstreeview&,0
Dim PROCESSENTRY#,PROCESSENTRY32
Clear PROCESSENTRY#
Let PROCESSENTRY#.dwSize&=298
LET hSnapshot&=@CreateToolhelp32Snapshot($2,0)

IfNot hSnapshot&=-1

    LET Result_HL&=@Process32First(hSnapshot&,PROCESSENTRY#)

    While Result_HL&=1

        LET Prozess_name$=PROCESSENTRY#.szExeFile$
        LET Prozess_ID$=@STR$(PROCESSENTRY#.th32ProcessID&)
        TVINSERT 0,0,0,Prozess_name$,$0,PROCESSENTRY#.th32ProcessID&
        @sendmessage(Prozesstreeview&,$1100,0,TV_INSERT#)
        LET Result_HL&=@Process32Next(hSnapshot&,PROCESSENTRY#)

    EndWhile

    @CloseHandle(hSnapshot&)

endif

Dispose PROCESSENTRY#
Usecursor 0
Enablewindow Prozesstreeview&,1

While %UMESSAGE<>$10

    Waitinput

    IF SEL_ITEM&<>@Sendmessage(Prozesstreeview&,$110A,$9,0)

        LET SEL_ITEM&=@Sendmessage(Prozesstreeview&,$110A,$9,0)

        IF Sel_Item&<>0

            CLEAR TV_ITEM#
            CLEAR TV_TEXT#
            LONG TV_ITEM#,0=$11 | $2 | $4
            LONG TV_ITEM#,20=500
            LONG TV_ITEM#,16=TV_TEXT#
            LONG TV_ITEM#,4=SEL_ITEM&
            @sendmessage(Prozesstreeview&,$110C,0,TV_ITEM#)
            LET PR_ID&=@LONG(TV_ITEM#,36)
            LET PID$=@STRING$(TV_TEXT#,0)
            Read_C_D PR_ID&

        Endif

    endif

wend

Dispose TV_INSERT#
Dispose TV_TEXT#
Dispose TV_ITEM#
END

PROC TVINSERT

    Clear TV_INSERT#
    String TV_TEXT#,0=@$(4)      Der Text im Label
    long TV_INSERT#,0=@&(1)          TVins-Parent
    long TV_INSERT#,4=$FFFF0002          TVi_Last
    long TV_INSERT#,8=$0001+$0002+$0020+$0004+$0008+$0010
    long TV_INSERT#,16=@&(5)          State
    long TV_INSERT#,20=$0001+$0002+$0004+$0008+$0010+$0020+$0040+$0080+$0F00+$F000 StateMAsk
    long TV_INSERT#,24=TV_TEXT#   Adress of Label
    long TV_INSERT#,28=$FFFF
    long TV_INSERT#,32=@&(2)         Image          z.B Ordner
    long TV_INSERT#,36=@&(3)         Selected Image z.B geöffneter Ordner
    long TV_INSERT#,44=@&(6)          Lparam

ENDPROC

Proc Read_C_D

    Parameters PID&
    DIM P_INFO#,24
    @SetLastError(0)
    LET P_Handle&=@OpenProcess($400 | $10,0,PID&)
    LET AHRückgabe&=@GetLastError()

    IF P_Handle&<>0

        @SetLastError(0)
        Fehler&=@ZwQueryInformationProcess(@GetCurrentProcess(),0,P_Info#,24,@ADDR(Read&))

        IF Fehler&<>0

            LET AHRückgabe&=@LsaNtStatusToWinError(Fehler&)
            Fehlercode_bestimmen
            Addstring "fehlercode beim Auslesen: "+AHGETERROR_Buffer$

        endif

        IF Fehler&=0

            LET PEB&=@Long(P_Info#,4)
            LET AHRückgabe&=@LsaNtStatusToWinError(Fehler&)
            FEHLER&=@Toolhelp32ReadProcessMemory(PID&,PEB&+$10,@ADDR(ENV&),4,@ADDR(READ&))
            DIM UNICODE#,LSA_UNICODE_STRING
            FEHLER&=@Toolhelp32ReadProcessMemory(PID&,ENV&+36,UNICODE#,8,@ADDR(READ&))
            DIM U_STRING#,UNICODE#.MaximumLength%+3
            Clear U_STRING#
            FEHLER&=@Toolhelp32ReadProcessMemory(PID&,UNICODE#.Buffer&,U_STRING#,UNICODE#.MaximumLength%,@ADDR(READ&))
            DIM M_STRING#,UNICODE#.MaximumLength%+3
            Clear M_STRING#
            Let Fehler&=@WideCharToMultiByte(@GetACP(),0,U_STRING#,-1,M_STRING#,UNICODE#.MaximumLength%,0,0)

            IF @String$(M_String#,0)<>""

                Addstring "Prozess "+PID$+" hält sich gerade hier auf: "+@String$(M_String#,0)

            else

                ADDSTRING "Der Prozess "+PID$+" ist verstorben oder es handelt sich um einen Systemprozess!"

            endif

            Dispose M_String#
            Dispose U_STRING#
            Dispose Unicode#

        endif

        @CloseHandle(P_Handle&)
        @Editbox("PEB ermiiteln",1)
        ADDSTRING ""

    Else

        Fehlercode_bestimmen
        Addstring "Fehlercode beim Öffnen nin "+PID$+": "+AHGETERROR_Buffer$
        ADDSTRING ""

    endif

    Dispose P_INFO#

endproc

Proc Fehlercode_bestimmen

    DIM AHGETERROR_Buffer#,32000
    @FormatMessage($1000,0,AHRückgabe&,0,AHGETERROR_Buffer#,32000,0) Wandelt Fehlercode in Landesspezifische Message um.
    Let AHGETERROR_Buffer$=@trim$(@STRING$(AHGETERROR_Buffer#,0)s=s2>)
    Disponer AHGETERROR_Buffer#

ENDPROC