XProfan

Def Regopenkeyex(5) !"ADVAPI32","RegOpenKeyExA"
Def Regenumkey(4) !"ADVAPI32","RegEnumKeyA"
Def Regclosekey(1) !"ADVAPI32","RegCloseKey"
Def @Regenumvalue(8) !"ADVAPI32","RegEnumValueA"
 $H Windows.ph
Windowstyle 8+16
Windowtitle "REGISTRIERTE VIDEO - TYPEN"
Window 600,700
CLS ~Getsyscolor(15)
Declare Ergebnis#,Open_Error&,Handle&,Zaehler%, Eintrag$
Declare Arb_Box&, V_Box&, MCI_Box&, MCI_Key$
Arb_Box& = @Create("MultiEdit",%HWnd,"",5,5,580,100)
@Create("Text",%HWnd,"Gefundene Reg.-Einträge für Video (HKEY_CLASSES_ROOT) :",5,110,500,20)
V_Box& = @Create("MultiEdit",%HWnd,"",5,130,580,200)
@Create("Text",%HWnd,"Gefundene MCI-Einträge für Video:",5,340,500,20)
MCI_Box& = @Create("MultiEdit",%HWnd,"",5,360,580,200)
Reg_0_Schluessel
MCI_Schluessel

Proc AddMultiLine

    Parameters Multi&,Text$
    Text$ = Text$+"\n"
    var TextEnde& =  Len(GetText$(Multi&))
    ~sendmessage(Multi&,$B1,TextEnde&,TextEnde&)
    ~sendmessage(Multi&,$C2,1,addr(Text$))

EndProc

Proc Reg_0_Schluessel

    Dim Ergebnis#,255
    'HKEY_CLASSES_ROOT = $80000000
    'HKEY_CURRENT_USER = $80000001
    'HKEY_LOCAL_MACHINE = $80000002
    'HKEY_USERS = $80000003
    '$20019 = Nur auslesen
    AddMultiLine Arb_Box&,"Schlüssel öffnen..."
    Open_Error&=Regopenkeyex($80000000,0,0,$20019,Addr(Handle&))

    IfNot Open_Error&

        AddMultiLine Arb_Box&,"O.K."
        AddMultiLine Arb_Box&,"...lese Unterschlüssel aus, Moment bitte..."

    Else

        AddMultiLine Arb_Box&,"     Fehler !!!!"
        waitinput
        end

    EndIf

    Whilenot Open_Error&

        Open_Error&=Regenumkey(Handle&,Zaehler%,Ergebnis#,100)
        Casenot Open_Error& : Addstring String$(Ergebnis#,0)
        Inc Zaehler%

    Endwhile

    AddMultiLine Arb_Box&,"Schlüssel schliessen..."
    Regclosekey(Handle&)
    Dispose Ergebnis#
    AddMultiLine Arb_Box&,"gefunden: " + @str$(%GetCount) + " Einträge"
    AddMultiLine Arb_Box&,"----------------------------------------"
    AddMultiLine Arb_Box&,"Unterschlüssel sortieren, Moment bitte..."
    AddMultiLine Arb_Box&,"----------------------------------------"
    @Set("ErrorLevel", 0)

    WhileLoop 0,%GetCount

        Eintrag$ = @ReadIni$("HKEY_0",@ListBoxItem$(&loop),"PerceivedType")

        If @Upper$(Eintrag$) = "VIDEO"

            AddMultiLine V_Box&,@ListBoxItem$(&loop)

        endIf

    EndWhile

endProc

Proc MCI_Schluessel

    Clear Open_Error&, Handle&
    Dim Ergebnis#,255'möglich Länge des ausgelesenen Namens
    MCI_Key$ = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\MCI Extensions"
    AddMultiLine Arb_Box&,"MCI-Schlüssel öffnen..."
    Open_Error&=Regopenkeyex($80000002,Addr(MCI_Key$),0,$20019,Addr(Handle&))

    IfNot Open_Error&

        AddMultiLine Arb_Box&,"O.K."
        AddMultiLine Arb_Box&,"...lese MCI-Unterschlüssel aus, Moment bitte..."

    Else

        AddMultiLine Arb_Box&,"     Fehler !!!!"
        waitinput
        end

    EndIf

    Declare Valuesize#,Typ#,Wert#,Buffersize#,MCI_Zaehler%
    Dim Typ#,4
    Dim Wert#,261
    Dim Buffersize#,4
    Dim Valuesize#,4
    Dim Ergebnis#,261
    ClearList

    Whilenot Open_Error&

        Long Buffersize#,0=261
        Long Valuesize#,0=261
        Clear Ergebnis#,Typ#,Wert#
        Open_Error&=@Regenumvalue(Handle&,MCI_Zaehler%,Ergebnis#,Valuesize#,0,Typ#,Wert#,Buffersize#)
        Casenot Open_Error& : Addstring String$(Ergebnis#,0)
        Inc MCI_Zaehler%

    Endwhile

    AddMultiLine Arb_Box&,"MCI-Schlüssel schliessen..."
    Regclosekey(Handle&)
    Dispose Ergebnis#
    Dispose Typ#
    Dispose Buffersize#
    Dispose Valuesize#
    AddMultiLine Arb_Box&,"gefunden: " + @str$(%GetCount) + "MCI - Einträge"
    AddMultiLine Arb_Box&,"----------------------------------------"
    AddMultiLine Arb_Box&,"MCI-Unterschlüssel sortieren, Moment bitte..."
    AddMultiLine Arb_Box&,"----------------------------------------"
    @Set("ErrorLevel", 0)

    WhileLoop 0,%GetCount

        Eintrag$ = @ReadIni$("HKEY_2",MCI_Key$,@ListBoxItem$(&loop))

        If @Instr("VIDEO",@Upper$(Eintrag$))

            AddMultiLine MCI_Box&,@ListBoxItem$(&loop) + " - " + Eintrag$

        endIf

    EndWhile

    AddMultiLine Arb_Box&,"MCI sortieren fertig ..."

endProc

WhileNot (%Key = 2) OR (%Key = 27)

    waitinput

EndWhile

end