by Mark Balasundram (1 Submission)
Category: Registry
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Tue 28th September 1999
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
The following has been writen to read registry. This program will get the username, password and Database name from NT registry. Only thing
API Declarations
Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
Public Const HKEY_LOCAL_MACHINE = &H80000002
VBcoders
Dim GetRegValue
Dim phkResult As Long
Dim lResult As Long, szBuffer As String, lBuffSize As Long
Dim sPassword As String
Dim hKey, SubKey
Dim i, j As Integer
Dim bChk As Boolean
Dim z As String
i = 1
On Error GoTo GetPassword_error
hKey = HKEY_LOCAL_MACHINE
SubKey = "SYSTEM\ControlSet001\Services\ "
szBuffer = Space(255)
lBuffSize = Len(szBuffer)
'Open the key
RegOpenKeyEx hKey, SubKey, 0, 1, phkResult
'Query the value
lResult = RegQueryValueEx(phkResult, "PASSWORD2", 0, 0, szBuffer, lBuffSize)
'Close the key
RegCloseKey phkResult
'Return obtained value
If lResult = 0 Then
GetRegValue = Left(szBuffer, lBuffSize - 1)
Else
GetRegValue = "NOT FOUND"
End If
'if not found then write to the error log file and exit
If GetRegValue = "NOT FOUND" Then
GoTo GetPassword_error
End If
Do While (Not bChk)
If Mid(GetRegValue, i, 2) <> "00" Then
‘ the decryption algorithm code goes here
Else
bChk = True
End If
Loop
GetPassword = sPassword
' End
Exit Function
GetPassword_error:
Open “Filename" For Output As #3
If GetRegValue = "NOT FOUND" Then
Write #3, "Password NOT FOUND"
Else
Write #3, Err.Description
End If
' Close file #3
Close #3
'close Application
End
End Function
Public Function GetUsername() As String
Dim GetRegValue
Dim phkResult As Long
Dim lResult As Long, szBuffer As String, lBuffSize As Long
Dim sUsername As String
Dim hKey, SubKey, z
Dim i, j As Integer
Dim bChk As Boolean
i = 1
On Error GoTo getusername_error
hKey = HKEY_LOCAL_MACHINE
SubKey = "SYSTEM\ControlSet001\Services\ "
szBuffer = Space(255)
lBuffSize = Len(szBuffer)
'Open the key
RegOpenKeyEx hKey, SubKey, 0, 1, phkResult
'Query the value
lResult = RegQueryValueEx(phkResult, "USERID1", 0, 0, szBuffer, lBuffSize)
'Close the key
RegCloseKey phkResult
'Return obtained value
If lResult = 0 Then
GetRegValue = Left(szBuffer, lBuffSize - 1)
Else
GetRegValue = "NOT FOUND"
End If
'if not found then write to the error log file and exit
If GetRegValue = "NOT FOUND" Then
GoTo getusername_error
End If
Do While (Not bChk)
If Mid(GetRegValue, i, 2) <> "00" Then
‘ the decryption algorithm code goes here
Loop
GetUsername = sUsername
Exit Function
getusername_error:
Open “Filename” For Output As #3
If GetRegValue = "NOT FOUND" Then
Write #3, "Username NOT FOUND"
Else
Write #3, Err.Description
End If
' Close file #3
Close #3
'close Application
End
End Function
Public Function GETDSNAME() As String
On Error GoTo getdsname_error
Dim GetRegValue
Dim phkResult As Long
Dim lResult As Long, szBuffer As String, lBuffSize As Long
Dim sGetDsname As String
Dim hKey, SubKey, z
Dim i, j As Integer
Dim bChk As Boolean
i = 1
'Initilize some public variables
'Operation flag values
'Registry key we want to use
hKey = HKEY_LOCAL_MACHINE
SubKey = "SYSTEM\ControlSet001\Services\ "
szBuffer = Space(255)
lBuffSize = Len(szBuffer)
'Open the key
RegOpenKeyEx hKey, SubKey, 0, 1, phkResult
'Query the value
lResult = RegQueryValueEx(phkResult, "DSNAME2", 0, 0, szBuffer, lBuffSize)
'Close the key
RegCloseKey phkResult
'Return obtained value
If lResult = 0 Then
GetRegValue = Left(szBuffer, lBuffSize - 1)
Else
GetRegValue = "NOT FOUND"
End If
'if not found then write to the error log file and exit
If GetRegValue = "NOT FOUND" Then
GoTo getdsname_error
End If
Do While (Not bChk)
If Mid(GetRegValue, i, 2) <> "00" Then
z = "&H" & Mid(GetRegValue, i, 2)
sGetDsname = sGetDsname & Chr(Val(z))
i = i + 3
Else
bChk = True
End If
Loop
GETDSNAME = sGetDsname
Exit Function
getdsname_error:
Open “Filename” For Output As #3
If GetRegValue = "NOT FOUND" Then
Write #3, "DSN NOT FOUND" & Now
Else
Write #3, Err.Description
End If
' Close file #3
Close #3
'close Application
End
End Function
No comments have been posted about The following has been writen to read registry. This program will get the username, password and Da. Why not be the first to post a comment about The following has been writen to read registry. This program will get the username, password and Da.
