XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Programm mit Rechten eines Users starten (nur Win 2000 und XP)
Def @Lookupaccountname(7) !advapi32,LookupAccountNameA
Def @Setlasterror(1) !kernel32,SetLastError
Def @Getlasterror(0) !kernel32,GetLastErrorLiefert letzten API Fehler.
Def @Zeromemory(2) ! Kernel32,RtlZeroMemory
Def @Createprocesswithlogonw(11) !advapi32,CreateProcessWithLogonW
Def @Multibytetowidechar(6) !kernel32,MultiByteToWideChar
Def @Getacp(0) !kernel32,GetACP
Declare Fehler&,Domain$,Sid_size#,Lpstartupinfo#,Lpprocessinformation#
Declare Lpcommandline#,Domainname_size_addr#
Declare Sid#,Domain#,Sid_type_indicator#,Domain#,Attribut#,Allprivs#,Count#,Sid#
Declare Eun$,Epw$,Epr$,Epp$
Dim Domain#,256
Dim Sid#,800
Dim Sid_size#,4
Dim Domainname_size_addr#,4
Dim Sid_type_indicator#,256

Proc Startwithuserrights

    Addstring Start der Prozedur zum Impersonifizieren anderer User
    Parameters Pusername$,Ppasswort$,Pprogramm$,Pparameter$
    Declare Pusername#,Ppasswort#,Pprogramm#,Domainw#
    Addstring Username: +Pusername$
    Addstring Passwort: +Ppasswort$
    Addstring Zu startendes Programm : +Pprogramm$
    Addstring Programmparameter: +Pparameter$
    Clear Sid#,Domain#,Sid_type_indicator#,Domain#,Sid#,Domainname_size_addr#
    Long Sid_size#,0=800
    Long Domainname_size_addr#,0=255
    Let Fehler&=@Lookupaccountname(0,@Addr(Pusername$),Sid#,Sid_size#,Domain#,Domainname_size_addr#,Sid_type_indicator#)
    Addstring Fehler LookupAccountName: +@Str$(Fehler&)
    Let Domain$=@String$(Domain#,0)
    Addstring Domain: +Domain$
    Let Pprogramm$=@Shortname$(Pprogramm$)
    Case Pparameter$<> : Let Pprogramm$=Pprogramm$+@Space$(1)+Chr$(34)+Pparameter$+Chr$(34)
    Dim Pprogramm#,(@Len(Pprogramm$)*2)+1
    Dim Pusername#,(@Len(Pusername$)*2)+1
    Dim Ppasswort#,(@Len(Ppasswort$)*2)+1
    Dim Domainw#,(@Len(Domain$)*2)+1
    Let Fehler&=@Multibytetowidechar(@Getacp(),0,@Addr(Pprogramm$),-1,Pprogramm#,(@Len(Pprogramm$)*2)+1)
    Addstring Rückgabe von MultiByteToWideChar: +@Str$(Fehler&)
    Let Fehler&=@Multibytetowidechar(@Getacp(),0,@Addr(Domain$),-1,Domainw#,(@Len(Domain$)*2)+1)
    Addstring Rückgabe von MultiByteToWideChar: +@Str$(Fehler&)
    Let Fehler&=@Multibytetowidechar(@Getacp(),0,@Addr(Pusername$),-1,Pusername#,(@Len(Pusername$)*2)+1)
    Addstring Rückgabe von MultiByteToWideChar: +@Str$(Fehler&)
    Let Fehler&=@Multibytetowidechar(@Getacp(),0,@Addr(Ppasswort$),-1,Ppasswort#,(@Len(Ppasswort$)*2)+1)
    Addstring Rückgabe von MultiByteToWideChar: +@Str$(Fehler&)
    @Setlasterror(0)
    Addstring Letzter API Fehler: +@Str$(@Getlasterror())
    Dim Lpstartupinfo#,68
    Zeromemory(Lpstartupinfo#,68)
    Long Lpstartupinfo#,0=68
    Dim Lpprocessinformation#,16
    Dim Lpcommandline#,@Len(Pprogramm$)+1
    Zeromemory(Lpprocessinformation#,16)
    String Lpcommandline#,0=Pprogramm$
    @Createprocesswithlogonw(Pusername#,Domainw#,Ppasswort#,0,0,Pprogramm#,0,0,0,Lpstartupinfo#,Lpprocessinformation#)
    Addstring Letzter API Fehler: +@Str$(@Getlasterror())
    Dispose Domainw#
    Dispose Pprogramm#
    Dispose Pusername#
    Dispose Ppasswort#
    Dispose Lpstartupinfo#
    Dispose Lpprocessinformation#
    Dispose Lpcommandline#
    Addstring Ende der Prozedur zum Impersonifizieren anderer User

Endproc

If %Parcount=3

    Startwithuserrights @Par$(1),@Par$(2),@Par$(3)

Elseif %Parcount=4

    Startwithuserrights @Par$(1),@Par$(2),@Par$(3)

Else

    Let Eun$=@Input$(Bitte einen Usernamen eingeben: ,Login Name?,)
    Let Epw$=@Input$(Bitte das Passwort dazu eingeben: ,Passwort?,)
    Let Epr$=@Loadfile$(EXE auswählen,*.EXE)
    Let Epp$=@Input$(Programmparameter eingeben:,Parameter,)
    Startwithuserrights Eun$,Epw$,Epr$,Epp$

Endif

Dispose Domain#
Dispose Sid_size#
Dispose Domainname_size_addr#
Dispose Sid_type_indicator#
Dispose Sid#
@Editbox(Rückgaben,1)