XProfan

Quelltext für Profan², Version 7.5 von Andreas Hötker:
Declare NewState#,Luid1#,Luid2#,Privileg1#,Privileg2#,System$,Token&,Fehler&,token#
Declare BUFFER#,OLDVALUE#
Declare Luid4#,Luid3#,Privileg4#,Privileg3#,OUT#,größe#,Zahl1&,zahl2&
Declare Username$,ENDE&
Declare Handle&
Declare REG$
Declare Zähler&
Declare WINVER!
Declare Zähler%
declare Name#
declare Ergebnis#,Useranzahl&
Declare USERDAT$
Declare name3#,size3#,Usereingabe$,Oberschlüssel$,ProfileList$
declare Error&,Datei$,OpenError&
declare Handle#,Savefile$
declare Key#
declare Size#
declare Wert#,Wert2#
Declare Oberschlüssel&,Username2$,Möglichkeit%
Declare reg2$,ProfilePfad$,Find$
dim Ergebnis#,100
dim Name#,256
dim Handle#,4
dim Key#,256
dim Size#,1
dim Wert#,4
Dim Wert2#,256
API Declarationen
DEF @GetLastError(0)!"kernel32","GetLastError" Liefert letzten API Fehler.
def @RegOpenKeyEx(5) !"ADVAPI32","RegOpenKeyExA" Liefert Handle eines Registryschlüssels und öffnet ihn.
def @RegCloseKey(1) !"ADVAPI32","RegCloseKey" Schließt eine geöffneten Registryschlüssel.
def @RegSetValueEx(6) !"ADVAPI32","RegSetValueExA" Schreibt einen Wert in einen Registrykey.
def @RegEnumKey(4) !"ADVAPI32","RegEnumKeyA" Listet Registryschlüssel auf.
DEF @RegLoadKey(3)!"ADVAPI32","RegLoadKeyA" Lädt eine USER.DAT / NTUSER.DAT (Hive) eines Users.
DEF @RegSaveKey(3)!"ADVAPI32","RegSaveKeyA" Speichert eine Schlüsselfolge in einen Hive.
DEf @RegUnLoadKey(2)!"ADVAPI32","RegUnLoadKeyA" Entfernt einen mit RegLoadKey geladenen Hive aus der Registry.
DEF @regCREATEKEY(3)!"ADVAPI32","RegCreateKeyA" Schlüssel erstellen
DEF @CloseHandle(1) !"kernel32","CloseHandle" Schließt ein Handle (Programm).
LET WINVER!=@val($WINVER)

Proc Benutzerwählen

    ClearLIst Listboxliste löschen.
    string Key#,0="" Kein Unterschlüssel.
    @RegOpenKeyEx($80000003,Key#,0,$F003F,Handle#) Schlüssel HKEY_USERS wird geöffnet
    Let Handle&=@Long(Handle#,0)
    LET ZÄHLER%=0
    LET ERROR&=0
    Ziel der Schleife: Schreibweise des Profils .DEFAULT ermitteln:

    while @equ(Error&,0) Bis kein neuer Wert gefunden wird...

        let Error&=@RegEnumKey(Handle&,Zähler%,Ergebnis#,100) Schreibe gelisteten Schlüssel in Bereich Ergebnis#.
        let USEREINGABE$=@string$(Ergebnis#,0) Schreibe Schlüssel in String
        case @and(ERROR&=0,@Instr("DEFAULT",@upper$(USEREINGABE$))>0) : addstring Usereingabe$ Schreibe Schlüssel .DEFAULT in Listboxliste
        inc Zähler%

    endwhile

    @RegCloseKey(Handle&) HKEY_USERS wird geschlossen.

    IF WINVER!<5.0 Wenn Betriebssystem Windows9x/ME...

        Print "Windows9x/ME System gefunden"
        Let ProfileList$="SoftwareMicrosoftWindowsCurrentVersionProfileList" Dort befindet sich eine Liste mit in Windows vorhandenen Usern unter Windows9x/ME
        LET USERDAT$="USER.DAT" So heißt der Hive unter Windows9x/ME.
        LET REG$="SoftwareMicrosoftWindowsCurrentVersion" Dort befinden sich RUN und POLICIES Eintrage unter Windows9x/ME.
        string Key#,0=ProfileList$
        LET Fehler&=@RegOpenKeyEx($80000002,Key#,0,$F003F,Handle#) Es wird versucht, die Profileliste (Root HKEY_LOCAL_MACHINE) unter Windows9x/ME zu öffnen.
        LET ZÄHLER%=0
        LET ERROR&=0
        Die Unterschlüssel sind hier die Profilnamen, sie werden nun gelistet und in eine Listbox geschrieben...

        while @equ(Error&,0)

            let Error&=@RegEnumKey(@Long(Handle#,0),Zähler%,Ergebnis#,100)
            casenot Error& : addstring @string$(Ergebnis#,0)
            inc Zähler%

        endwhile

        LET USERANZAHL&=Zähler%-1
        @RegCloseKey(@Long(Handle#,0))
        LET USERNAME$=""
        LET USERNAME$=@listbox$("Bitte ein verfügbares Benutzerprofil zum Bearbeiten auswählen:",3)

        IF USERNAME$<>""

            LET USERNAME2$=Username$+""
            LET Oberschlüssel&=$80000003 Root Schlüssel HKEY_USERS
            let OBERSCHLÜSSEL$="HKEY_3" Root Schlüssel HKEY_USERS
            Let Datei$=""

            If @trim$(@upper$(Username$))<>".DEFAULT" Wenn nicht das .DEFAULT Profil gewählt wurde..

                Let Datei$=@readini$("HKEY_2",Profilelist$+""+Username$,"ProfileImagePath")+""+USERDAT$ ...lese den Hive für diesen User aus...
                LET DATEI$=@translate$(@upper$(DATEI$),"%SYSTEMDRIVE%",@left$($WINPATH,2))
                ...und prüfe ob er vorhanden ist (kann ja gelöscht worden sein)!
                clearlist
                AddFILES Datei$
                AddSTRING ""

                IF @ListBoxItem$(0)="" Wenn Hive nicht da, beende Programm.

                    @messagebox("Dieser Benutzer hat kein komplettes Profil!","Userprofil nicht anwählbar",64)
                    dispose Handle#
                    dispose Key#
                    dispose Wert#
                    dispose Name#
                    dispose Size#
                    Dispose wert2#
                    end

                endif

            endif

            Let OpenError&=@RegLoadKey($80000003,@addr(Username$),@addr(Datei$)) Versuche, Hive in die Registry zu laden
            Print "Errorcode beim Laden des Hives: ";OPENERROR& Wenn Fehler, ist Openerror&>0!
            Print "REGEDIT wird gestartet!"
            @winexec("REGEDIT.EXE",1)
            Print "Zum Weitermachen bitte in Hauptfenster klicken!"
            WAITINPUT

        else

            dispose Handle#
            dispose Key#
            dispose Wert#
            dispose Name#
            dispose Size#
            Dispose wert2#
            end

        endif

        else Wenn Betriebssystem Windows2000/XP...(WindowsNT geht eventuell nicht!!!)
        Print "NT System gefunden"
        Für die folgenden Registryvorgänge müssen sich unter NT-basierten Systemen erst die Rechte geholt werden.
        Auch für einen Administrator sind diese Rechte nicht unter jedem System aktiviert.
        Hier die APIS zum setzen der Privilegien:
        DEF @LookupPrivilegeName(4)!"advapi32","LookupPrivilegeNameA" Ermittelt aus dem Luid eines Privilegs dessen Namen.
        DEF @LookupPrivilegeValue(3) !"advapi32","LookupPrivilegeValueA" Ermittelt aus dem Namen eines Privilegs dessen Luid.
        DEF @OpenProcessToken(3) !"advapi32","OpenProcessToken" Öffnet Einstellprozess.
        DEF @AdjustTokenPrivileges(6) !"advapi32","AdjustTokenPrivileges" Stellt Privilegien ein.
        DEF @GetCurrentProcess(0) !"kernel32","GetCurrentProcess" Ermittel das Handle des aktiven Prozesses.
        Dimensionierung der Bereichsvariablen
        dim token#,4
        DIM NewState#,16
        DIM Luid1#,8
        DIM Luid2#,8
        DIM Privileg1#,256
        DIM Privileg2#,256
        DIM Luid3#,8
        DIM Luid4#,8
        DIM Privileg3#,256
        DIM Privileg4#,256
        DIM BUFFER#,4
        DIM OLDVALUE#,256
        DIM OUT#,256
        Dim Größe#,4
        String Privileg1#,0="SeBackupPrivilege" Privileg für RegSaveKey
        String Privileg2#,0="SeRestorePrivilege" Privileg für Regloadkey
        String Privileg3#,0="SeTakeOwnershipPrivilege" Vielleicht auch noch nötig?
        String Privileg4#,0="SeSystemProfilePrivilege" Vielleicht auch noch nötig?
        Long NewState#,0=1 Nur ein Privileg soll geändert werden
        Long NewState#,12=$00000002 Das Privileg soll eingeschaltet werden
        Let SYSTEM$="" Wenn Leerstring, dann lokaler Computer.
        LET FEHLer&=@OpenProcessToken(@GetCurrentProcess(),$0020 | $0008,Token#) Es wird ein Process mit dem Handle Token gestartet, der Privilegien für mein Programm einstellen soll.
        PRINT "Letzter Fehler:",@GetLastError() Welcher Fehler trat zuletzt auf?
        let token&=@long(token#,0) Das Handle des Einstellprozesses wird ausgelesen.
        PRINT "Fehlercode OpenProcessToken",Fehler& Wenns geklappt hat, dann 1.
        LET FEHLer&=@LookupPrivilegeValue(@addr(SYSTEM$),Privileg1#,LUID1#) Wenn ich es richtig vestanden habe, wird hier aus dem Privilegnamen eine Art lokales Handle für dieses Privileg ermittelt.
        PRINT "Fehlercode LookupPrivilegeValue",Fehler& Wenns geklappt hat, dann 1.
        LET FEHLer&=@LookupPrivilegeValue(@addr(SYSTEM$),Privileg2#,LUID2#)  Wenn ich es richtig vestanden habe, wird hier aus dem Privilegnamen eine Art lokales Handle für dieses Privileg ermittelt.
        PRINT "Fehlercode LookupPrivilegeValue",Fehler& Wenns geklappt hat, dann 1.
        LET FEHLer&=@LookupPrivilegeValue(@addr(SYSTEM$),Privileg3#,LUID3#) Wenn ich es richtig vestanden habe, wird hier aus dem Privilegnamen eine Art lokales Handle für dieses Privileg ermittelt.
        PRINT "Fehlercode LookupPrivilegeValue",Fehler& Wenns geklappt hat, dann 1.
        LET FEHLer&=@LookupPrivilegeValue(@addr(SYSTEM$),Privileg4#,LUID4#) Wenn ich es richtig vestanden habe, wird hier aus dem Privilegnamen eine Art lokales Handle für dieses Privileg ermittelt.
        PRINT "Fehlercode LookupPrivilegeValue",Fehler& Wenns geklappt hat, dann 1.
        Der Luid für das erste Privileg wird übertragen
        Byte NewState#,4=@Byte(Luid1#,0)
        Byte NewState#,5=@Byte(Luid1#,1)
        Byte NewState#,6=@Byte(Luid1#,2)
        Byte NewState#,7=@Byte(Luid1#,3)
        Byte NewState#,8=@Byte(Luid1#,4)
        Byte NewState#,9=@Byte(Luid1#,5)
        Byte NewState#,10=@Byte(Luid1#,6)
        Byte NewState#,11=@Byte(Luid1#,7)
        clear buffer#
        LET ZAHL1&=256
        LET ZAHL2&=0
        LET FEHLER&=@AdjustTokenPrivileges(Token&,ZAHL2&,NewState#,ZAHL1&,Oldvalue#,Buffer#) Das Privileg wird aktiviert.
        PRINT "Fehlercode AdjustTokenPrivileges",Fehler& Wenns geklappt hat, dann 1.
        PRINT "SIZE:",@long(Buffer#,0)
        @LookupPrivilegeName(@addr(SYSTEM$),LUID1#,OUT#,Größe#) Aus dem ersten Luid wird wieder der Privilegname ermittelt.
        PRINT "PRIVILEG:",@string$(Out#,0) Nur Rückmeldung, ob es geklappt hat.
        Der Luid für das zweite Privileg wird übertragen
        Byte NewState#,4=@Byte(Luid2#,0)
        Byte NewState#,5=@Byte(Luid2#,1)
        Byte NewState#,6=@Byte(Luid2#,2)
        Byte NewState#,7=@Byte(Luid2#,3)
        Byte NewState#,8=@Byte(Luid2#,4)
        Byte NewState#,9=@Byte(Luid2#,5)
        Byte NewState#,10=@Byte(Luid2#,6)
        Byte NewState#,11=@Byte(Luid2#,7)
        LET FEHLER&=@AdjustTokenPrivileges(Token&,0,NewState#,0,0,0) Das Privileg wird aktiviert. Alle nicht benötigten Werte können auch 0 sein!
        PRINT "Fehlercode AdjustTokenPrivileges",Fehler& Wenn geklappt hat 1.
        Der Luid für das dritte Privileg wird übertragen
        Byte NewState#,4=@Byte(Luid3#,0)
        Byte NewState#,5=@Byte(Luid3#,1)
        Byte NewState#,6=@Byte(Luid3#,2)
        Byte NewState#,7=@Byte(Luid3#,3)
        Byte NewState#,8=@Byte(Luid3#,4)
        Byte NewState#,9=@Byte(Luid3#,5)
        Byte NewState#,10=@Byte(Luid3#,6)
        Byte NewState#,11=@Byte(Luid3#,7)
        LET FEHLER&=@AdjustTokenPrivileges(Token&,0,NewState#,0,0,0) Das Privileg wird aktiviert. Alle nicht benötigten Werte können auch 0 sein!
        PRINT "Fehlercode AdjustTokenPrivileges",Fehler& Wenn geklappt hat 1.
        Der Luid für das vierte Privileg wird übertragen
        Byte NewState#,4=@Byte(Luid4#,0)
        Byte NewState#,5=@Byte(Luid4#,1)
        Byte NewState#,6=@Byte(Luid4#,2)
        Byte NewState#,7=@Byte(Luid4#,3)
        Byte NewState#,8=@Byte(Luid4#,4)
        Byte NewState#,9=@Byte(Luid4#,5)
        Byte NewState#,10=@Byte(Luid4#,6)
        Byte NewState#,11=@Byte(Luid4#,7)
        LET FEHLER&=@AdjustTokenPrivileges(Token&,0,NewState#,0,0,0) Das Privileg wird aktiviert. Alle nicht benötigten Werte können auch 0 sein!
        PRINT "Fehlercode AdjustTokenPrivileges",Fehler& Wenn geklappt hat 1.
        PRINT "Letzter Fehler:",@GetLastError() Letzter Fehler wird ausgegeben
        Alle nicht mehr benötigten Bereiche werden gelöscht.
        Dispose Luid1#
        Dispose Luid2#
        Dispose Privileg1#
        Dispose Privileg2#
        Dispose Luid3#
        Dispose Luid4#
        Dispose Privileg3#
        Dispose Privileg4#
        Dispose NewState#
        Dispose OldValue#
        Dispose Buffer#
        dispose OUT#
        Dispose Größe#
        OK, wenn die Privilegien überhaupt vorhanden waren, bestehen jetzt die Rechte für Hive-Operationen.
        LET REG$="SoftwareMicrosoftWindowsCurrentVersion" Dort befinden sich RUN und POLICIES Eintrage unter Windows2000/NT/XP.
        LET USERDAT$="NTUSER.DAT" So heißt der Hive unter Windows2000/NT/XP.
        Let ProfileList$="SoftwareMicrosoftWindows NTCurrentVersionProfileList" Dort befindet sich eine Liste mit in Windows vorhandenen Usern unter Windows2000/NT/XP.
        LET PROFILEPFAD$=@upper$(@readini$("HKEY_2",Profilelist$,"ProfilesDirectory")) Pfad der Profile wird aus der Registry geholt
        LET PROFILEPFAD$=@TRANSLATE$(PROFILEPFAD$,"%SYSTEMDRIVE%",@left$($WINPATH,2)) Variable %SYSTEMDRIVE% wird in "C:" umgesetz
        Case PROFILEPFAD$="" : LET PROFILEPFAD$=@left$($WINPATH,2)+"Dokumente und Einstellungen" Wenn in Registry kein Pfad gefunden wurde, nehme "C:Dokumente und Einstellungen" als Profilepfad
        Die User werden gelistet
        Let FIND$=@FINDFIRST$(PROFILEPFAD$+""+"*") Suche Dateien und Ordner im Profilpfad

        IF @and(FIND$<>"",Left$(FIND$,1)<>"[") Wenn eine Datei gefunden wurde...

            LET Find$="." ...lösche den Namen

        elseif @and(FIND$<>"",Left$(FIND$,1)="[") Wenn aber ein Ordner gefunden wurde..

            LET Find$=@TRANSLATE$(FIND$,"[","") ...lösche die eckigen Klammern im Ordnernamen
            LET Find$=@TRANSLATE$(FIND$,"]","") ...lösche die eckigen Klammern im Ordnernamen

        endif

        While FIND$<>"" Solange ein Ordner gefunden wurde...

            IF @and(FIND$<>".",FIND$<>"..") ...und es wirklich ein Ordner ist...

                ADDSTRING FIND$ ...schreibe den Ordner in die Listboxliste.

            endif

            Let FIND$=FINDNEXT$() ...suche nächste Datei / nächsten Ordner

            IF @and(FIND$<>"",Left$(FIND$,1)<>"[") ...Wenn eine Datei gefunden wurde...

                LET Find$="." ...lösche den Namen

            elseif @and(FIND$<>"",Left$(FIND$,1)="[") ...Wenn aber ein Ordner gefunden wurde..

                LET Find$=@TRANSLATE$(FIND$,"[","") ...lösche die eckigen Klammern im Ordnernamen
                LET Find$=@TRANSLATE$(FIND$,"]","") ...lösche die eckigen Klammern im Ordnernamen

            endif

        wend

        LET USERNAME$=""
        LET USERNAME$=@listbox$("Bitte ein verfügbares Benutzerprofil zum Bearbeiten auswählen:",3) Profilnamen werden zur Auswahl angezeigt

        IF USERNAME$<>"" Wenn ein Name ausgewählt wurde

            LET USERNAME2$=Username$+""
            LET Oberschlüssel&=$80000003 Root Schlüssel HKEY_USERS
            let OBERSCHLÜSSEL$="HKEY_3" Root Schlüssel HKEY_USERS
            Let Datei$=""

            If @trim$(@upper$(Username$))<>".DEFAULT" Wenn nicht das .DEFAULT Profil gewählt wurde..

                Let Datei$=ProfilePfad$+""+USERNAME2$+"NTUSER.DAT" Dort befindet sich die Datei NTUSER.DAT für den gewählten User
                ...und prüfe ob er vorhanden ist (kann ja gelöscht worden sein)!
                clearlist
                AddFILES Datei$
                AddSTRING ""

                IF @ListBoxItem$(0)="" Wenn Hive nicht da, beende Programm.

                    @messagebox("Dieser Benutzer hat kein komplettes Profil!","Userprofil nicht anwählbar",64)
                    dispose Handle#
                    dispose Key#
                    dispose Wert#
                    dispose Name#
                    dispose Size#
                    Dispose wert2#
                    LET FEHLER&=@CloseHandle(Token&) Der Einstellprozess wird geschlossen.
                    PRINT "Fehlercode CloseHandle",Fehler& Wenn erfolgreich, dann 1.
                    end

                endif

            endif

            Let OpenError&=@RegLoadKey($80000003,@addr(Username$),@addr(Datei$)) Versuche, Hive in die Registry zu laden!
            Print "Errorcode beim Laden des Hives: ";OPENERROR& Wenn Fehler, ist Openerror&>0!
            Print "REGEDIT wird gestartet!"
            @winexec("REGEDIT.EXE",1) Nur Kontrolle, was in der Registry passiert!
            Print "Zum Weitermachen bitte in Hauptfenster klicken!"
            WAITINPUT

        else

            dispose Handle#
            dispose Key#
            dispose Wert#
            dispose Name#
            dispose Size#
            Dispose wert2#
            LET FEHLER&=@CloseHandle(Token&) Der Einstellprozess wird geschlossen.
            PRINT "Fehlercode CloseHandle",Fehler& Wenn erfolgreich, dann 1.
            end

        endif

    endif

endproc

Windowstyle 31
Windowtitle "Testprogramm 1"
Window 0,0-640,390
POPUP "&Funktionen"
Appendmenu 111,"&Explorer beim nächsten Start aufführen für..."
Print "Das Programm soll die Registry eines beliebigen"
Print "Users öffnen und einen Eintrag unter RUNONCE erstellen."

While ENDE&=0

    IF @menuitem(111)

        Benutzerwählen
        print Username$
        LET REG2$=Username2$+REG$+"RunOnce"
        PRINT "Errorcode Schlüssel erstellen und laden:";@RegCreateKey($80000003,@addr(Reg2$),Handle#) Wenn Schlüssel RunOnce nicht vorhanden ist, wird er erzeugt (ist ja nicht immer da).
        Print ""
        long Size#,0=256
        string Name#,0="Test"
        string Wert2#,0="Explorer.EXE"
        print "Errorcode Schlüssel verändern:",@RegSetValueEx(@Long(Handle#,0),Name#,0,1,Wert2#,256) Der Eintrag, der den Explorer startet, wird erstellt.
        Print ""
        print "Errorcode Schlüssel schließen:",@RegCloseKey(@Long(Handle#,0)) RunOnce wird geschlossen.
        rem WRITEINI "HKEY_3",Username2$+REG$+"RunOnce","Test"="Explorer.EXE" Damit gibt es "eventuell" bei solchen Operationen Probleme!! Habe eine Rückmeldung unter WindowsXP darüber.
        PRINT "RunOnce Eintrag wurde erzeugt!"
        LET ENDE&=1

        IF @and(OPENERROR&=0,Datei$<>"") Nur wenn wirklich ein Hive geladen wurde (der Hive des Current Users ist ja immer geladen)..

            LET SAVEFILE$="C:RegHive" ..(für Zwischenspeicherung)...
            print "Errorcode Handle des Hive holen:",@RegOpenKeyEx($80000003,@addr(Username$),0,$F003F,Handle#) ...hole das Handle des Hive...
            Let Handle&=@long(Handle#,0) ..Handle für Startpunkt des Hives wird ausgelesen....
            print "Errorcode Hive abspeichern:",@RegSaveKey(Handle&,@addr(SaveFile$),0) ...speichere den Hive unter C:REGHIVE...
            Print "Errorcode Schlüssel schließen: ",@RegCloseKey(Handle&) ...mach "die Kiste" zu..
            Print "Errorcode Hive entladen:",@RegUnLoadKey($80000003,@addr(Username$)) ...entferne geladenen Hive aus der Registry...
            Print ""
            Assign #13,Datei$
            Print ""
            Print "Datei$=";DATEI$
            SETFATTR #13,$20 ...entferne Schreibschutz vom alten Hive...
            Assign #14,"C:RegHive"
            Setfattr #14,$20 ...entferne Schreibschutz vom neuen Hive...
            Copy "C:RegHive" > Datei$ ...kopiere C:RegHive über alten Hive...
            Erase #14 ...lösche C:RegHive...
            SETFATTR #13,$20+$01+$02+$04 ...stelle Attribute für Hive wieder her.

        endif

        Print "Errorcode Hive entladen:",@RegUnLoadKey($80000003,@addr(Username$)) ...entferne geladenen Hive aus der Registry.

    endif

wend

Speicher freimachen!
dispose Handle#
dispose Key#
dispose Wert#
dispose Name#
dispose Size#
Dispose wert2#
Usecursor 2
LET FEHLER&=@CloseHandle(Token&) Der Einstellprozess wird geschlossen.
PRINT "Fehlercode CloseHandle",Fehler& Wenn erfolgreich, dann 1.
Sleep 5000 Damit man sich die Ausgaben auf Bildschirm betrachten peux.
Usecursor 0
FIN