'''
''' No Warrenty Provided for this code. Use at your own risk.
'''
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
'' Looking at the local machines registry
Set reg = GetObject("winmgmts://./root/default:StdRegProv")
'' Check the current user hive for values
FindAndDeleteKey HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Connections"
'' get a list of user hives
reg.EnumKey HKEY_USERS, "", subkeys
If Not IsNull(subkeys) Then
'' Iterate through each hive and call the sub to find and delete the values
For Each sk In subkeys
FindAndDeleteKey HKEY_USERS, sk & "\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Connections"
Next
End If
''' sub '''
''Find and display the value of the related keys.
Sub FindAndDeleteKey(root, key)
reg.EnumValues root, key, names, types
If Not IsNull(names) Then
For Each name In names
'' For each value in this key searh for the two valeus we are looking for.
If (name = "DefaultConnectionSettings") Or (name = "SavedLegacySettings") Then
Dim strValue
reg.GetBinaryValue root, key, name, strValue
PrintData key, name, regReadBinary(strValue)
'''''''''
'' We have all the data we need, we could put a delete command here
'' to remove the entry if the user has the permissions to do this.
'''''''''
End If
Next
End If
End Sub
Sub PrintData(heading,body,data)
wScript.Echo VbCrLf + "#################"
wScript.Echo "### Key ###"
wScript.Echo heading
wScript.Echo "### Value ###"
wScript.Echo body
wScript.Echo "### Data ###"
wScript.Echo data
wScript.Echo "#################" + VbCrLf
End Sub
''Convert REG_BINARY to ASCII String.
Function regReadBinary(aBin)
Dim aInt(), i, iBinSize, sString, iChar, sChar
If Err.Number = 0 Then
iBinSize = UBound(aBin)
ReDim aInt(iBinSize)
For i = LBound(aBin) To UBound(aBin)
aInt(i) = CInt(aBin(i))
If aInt(i) <> 0 Then
iChar = aInt(i)
sChar = Chr(iChar)
sString = sString&sChar
End If
Next
regReadBinary=sString
End If
End Function
''' No Warrenty Provided for this code. Use at your own risk.
'''
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
'' Looking at the local machines registry
Set reg = GetObject("winmgmts://./root/default:StdRegProv")
'' Check the current user hive for values
FindAndDeleteKey HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Connections"
'' get a list of user hives
reg.EnumKey HKEY_USERS, "", subkeys
If Not IsNull(subkeys) Then
'' Iterate through each hive and call the sub to find and delete the values
For Each sk In subkeys
FindAndDeleteKey HKEY_USERS, sk & "\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Connections"
Next
End If
''' sub '''
''Find and display the value of the related keys.
Sub FindAndDeleteKey(root, key)
reg.EnumValues root, key, names, types
If Not IsNull(names) Then
For Each name In names
'' For each value in this key searh for the two valeus we are looking for.
If (name = "DefaultConnectionSettings") Or (name = "SavedLegacySettings") Then
Dim strValue
reg.GetBinaryValue root, key, name, strValue
PrintData key, name, regReadBinary(strValue)
'''''''''
'' We have all the data we need, we could put a delete command here
'' to remove the entry if the user has the permissions to do this.
'''''''''
End If
Next
End If
End Sub
Sub PrintData(heading,body,data)
wScript.Echo VbCrLf + "#################"
wScript.Echo "### Key ###"
wScript.Echo heading
wScript.Echo "### Value ###"
wScript.Echo body
wScript.Echo "### Data ###"
wScript.Echo data
wScript.Echo "#################" + VbCrLf
End Sub
''Convert REG_BINARY to ASCII String.
Function regReadBinary(aBin)
Dim aInt(), i, iBinSize, sString, iChar, sChar
If Err.Number = 0 Then
iBinSize = UBound(aBin)
ReDim aInt(iBinSize)
For i = LBound(aBin) To UBound(aBin)
aInt(i) = CInt(aBin(i))
If aInt(i) <> 0 Then
iChar = aInt(i)
sChar = Chr(iChar)
sString = sString&sChar
End If
Next
regReadBinary=sString
End If
End Function
No comments:
Post a Comment