XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Registry: Werte in Registry schreiben
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 screen viewing can.
Usecursor 0
END