Option Explicit
' 06-dump-password.vbs  --  double-click, read-only, NO admin needed.
'
' Dumps every registry value the classroom assistant keeps under
'     HKCU\Software          (usually: n, dtmm, czmm)
'     HKCU\Software\jfglzs   (if present)
' plus a few related scheduling keys, into
'     C:\Users\Public\tool\pass.txt
' and opens it in notepad.
'
' NOTHING is decrypted or cracked here - it is a pure dump for later analysis.
' Running it does not touch files, services or processes of the assistant.

Const OUTD = "C:\Users\Public\tool"
Const HKCU = &H80000001
Dim LOGF
LOGF = OUTD & "\pass.txt"

Dim fso, sh, reg, o, total
Set fso = CreateObject("Scripting.FileSystemObject")
Set sh  = CreateObject("WScript.Shell")
Set reg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

If Not fso.FolderExists(OUTD) Then fso.CreateFolder OUTD
Set o = fso.CreateTextFile(LOGF, True, False)

Sub W(ByVal s)
    o.WriteLine s
End Sub

' Dump all values of one HKCU subkey. Returns number of values found.
Function DumpKey(ByVal subkey, ByVal title)
    Dim names, types, i, n, cnt
    cnt = 0
    W "[" & title & "]  HKCU\" & subkey
    On Error Resume Next
    reg.EnumValues HKCU, subkey, names, types
    If Err.Number <> 0 Or Not IsArray(names) Then
        Err.Clear
        W "  (key not present or empty)"
        On Error GoTo 0
        DumpKey = 0
        Exit Function
    End If
    On Error GoTo 0
    For i = 0 To UBound(names)
        W "  " & names(i) & " = " & ValOf(subkey, names(i), types(i))
        cnt = cnt + 1
    Next
    If cnt = 0 Then W "  (empty)"
    W ""
    DumpKey = cnt
End Function

' Read one value and render it: strings as-is, dwords as hex+dec, binary as hex.
Function ValOf(ByVal subkey, ByVal name, ByVal typ)
    Dim s, d, b, i, r, x
    On Error Resume Next
    If typ = 1 Then
        reg.GetStringValue HKCU, subkey, name, s
        If Err.Number = 0 Then ValOf = """" & s & """" Else ValOf = "<read error>"
    ElseIf typ = 4 Then
        reg.GetDWORDValue HKCU, subkey, name, d
        If Err.Number = 0 Then
            ValOf = "0x" & Hex(d) & " (" & d & ")"
        Else
            ValOf = "<read error>"
        End If
    ElseIf typ = 3 Then
        reg.GetBinaryValue HKCU, subkey, name, b
        If Err.Number = 0 And IsArray(b) Then
            r = ""
            For i = 0 To UBound(b)
                x = Hex(b(i))
                If Len(x) = 1 Then x = "0" & x
                r = r & LCase(x)
            Next
            ValOf = "0x" & r
        Else
            ValOf = "<read error>"
        End If
    Else
        reg.GetStringValue HKCU, subkey, name, s
        If Err.Number = 0 Then
            ValOf = "(" & typ & ") """ & s & """"
        Else
            Err.Clear
            reg.GetDWORDValue HKCU, subkey, name, d
            If Err.Number = 0 Then ValOf = "(" & typ & ") 0x" & Hex(d) Else ValOf = "(" & typ & ") <unreadable>"
        End If
    End If
    Err.Clear
    On Error GoTo 0
End Function

' Read one value with a clear marker when it does not exist.
Function RegRead(ByVal subkey, ByVal name)
    Dim v
    On Error Resume Next
    v = sh.RegRead("HKCU\" & subkey & "\" & name)
    If Err.Number <> 0 Then
        Err.Clear
        RegRead = "<not present>"
    Else
        RegRead = CStr(v)
    End If
    On Error GoTo 0
End Function

' ---------------- main ----------------
W "=== REGISTRY DUMP  " & Now
W "computer = " & sh.ExpandEnvironmentStrings("%COMPUTERNAME%") & _
  "   user = " & sh.ExpandEnvironmentStrings("%USERNAME%")
W ""

Dim vn, vd, vc, found
vn = RegRead("Software", "n")
vd = RegRead("Software", "dtmm")
vc = RegRead("Software", "czmm")
found = 0
If vn <> "<not present>" Then found = found + 1
If vd <> "<not present>" Then found = found + 1
If vc <> "<not present>" Then found = found + 1

W "[A] known names (read one by one)"
W "  HKCU\Software\n      = " & vn
W "  HKCU\Software\dtmm   = " & vd
W "  HKCU\Software\czmm   = " & vc
W ""
W "  found_known = " & found
W ""

W "[B] everything under HKCU\Software"
total = DumpKey("Software", "all values")
W ""

W "[C] everything under HKCU\Software\jfglzs"
total = total + DumpKey("Software\jfglzs", "all values")
W ""

W "[note] HKCU\Software holds many unrelated values too."
W "       The assistant's own ones are usually: n, dtmm, czmm"
W "       n = the exit-password hash written by set.exe"
W ""
W "value_count = " & (total + found)
W ""
W "=== DONE"
o.Close

sh.Run "notepad.exe """ & LOGF & """", 1, False
WScript.Sleep 400
MsgBox "Dumped " & total & " registry values." & vbCrLf & vbCrLf & _
       "File: " & LOGF, vbInformation, "06-dump-password"