XProfan

************** Sonstige_Gruppen_listen.INC **************
************** Start der Prozedur zum Listen sonstiger Gruppen ********************

PROC liste_Sonstige_Gruppen

    Declare Token&,Fehler&,Geterror_buffer$,Erforderlich&
    Declare Erforderlich2&,Zähler&,SID_NAME_USE&
    Declare SIZE_DOMAIN&,SIZE_Account&,System$
    Clearlist
    LET Fehler&=@External("advapi32.dll","OpenProcessToken",@External("kernel32.dll","GetCurrentProcess"),$8,@ADDR(Token&))

    If Fehler&<>1

        Dim Geterror_buffer#,32000
        @External("KERNEL32","FormatMessageA",$1000,0,@EXTERNAL("kernel32.DLL","GetLastError"),0,Geterror_buffer#,32000,0)
        Let Geterror_buffer$=@String$(Geterror_buffer#,0)
        Dispose Geterror_buffer#
        @Messagebox(Geterror_buffer$,"Ein Fehler ist aufgetreten!",16)

    Endif

    DIM TOKEN_GROUPS#,1
    CLEAR TOKEN_GROUPS#,Erforderlich&
    Let Fehler&=@External("advapi32.dll","GetTokenInformation",Token&,2,TOKEN_GROUPS#,1,@ADDR(Erforderlich&))
    Dispose TOKEN_GROUPS#

    If Erforderlich&=0

        Dim Geterror_buffer#,32000
        @External("KERNEL32","FormatMessageA",$1000,0,@EXTERNAL("kernel32.DLL","GetLastError"),0,Geterror_buffer#,32000,0)
        Let Geterror_buffer$=@String$(Geterror_buffer#,0)
        Dispose Geterror_buffer#
        @Messagebox(Geterror_buffer$,"Ein Fehler ist aufgetreten!",16)

    else

        DIM TOKEN_GROUPS#,Erforderlich&
        LET Erforderlich2&=Erforderlich&
        CLEAR TOKEN_GROUPS#,Erforderlich&
        Let Fehler&=@External("advapi32.dll","GetTokenInformation",Token&,2,TOKEN_GROUPS#,Erforderlich2&,@ADDR(Erforderlich&))

        If Fehler&<>1

            Dim Geterror_buffer#,32000
            @External("KERNEL32","FormatMessageA",$1000,0,@EXTERNAL("kernel32.DLL","GetLastError"),0,Geterror_buffer#,32000,0)
            Let Geterror_buffer$=@String$(Geterror_buffer#,0)
            Dispose Geterror_buffer#
            @Messagebox(Geterror_buffer$,"Ein Fehler ist aufgetreten!",16)

        Else

            LET Zähler&=0

            While @LONG(TOKEN_GROUPS#,0)>Zähler&

                Clear SID_NAME_USE&
                DIM ACCOUNT_NAME#,256
                DIM Domain#,256
                Clear ACCOUNT_NAME#
                Clear Domain#
                LET SIZE_ACCOUNT&=255
                LET SIZE_DOMAIN&=255
                LET System$=""
                DIM SID#,@EXTERNAL("advapi32.dll","GetLengthSid",@LONG(TOKEN_GROUPS#,Zähler&*8+4))
                @External("kernel32.dll","RtlMoveMemory",SID#,@LONG(TOKEN_GROUPS#,Zähler&*8+4),@External("advapi32.dll","GetLengthSid",@LONG(TOKEN_GROUPS#,Zähler&*8+4)))
                LET FEHLER&=@External("ADVAPI32.DLL","LookupAccountSidA",@ADDR(System$),SID#,ACCOUNT_NAME#,@ADDR(SIZE_ACCOUNT&),Domain#,@ADDR(SIZE_DOMAIN&),@ADDR(SID_NAME_USE&))
                CASE @STRING$(ACCOUNT_NAME#,0)<>"" : ADDSTRING @STRING$(ACCOUNT_NAME#,0)
                Dispose SID#
                Dispose ACCOUNT_NAME#
                Dispose Domain#
                Let Zähler&=Zähler&+1

            Wend

        Endif

        Dispose TOKEN_GROUPS#

    Endif

Endproc

************** Ende der Prozedur zum Listen sonstiger Gruppen ********************