• Home
 · 
• Registry
 · 
• The following has been writen to read registry. This program will get the username, password and Da

The following has been writen to read registry. This program will get the username, password and Da

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




Rate The following has been writen to read registry. This program will get the username, password and Da

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

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
       &#8216; the decryption algorithm  code goes here 
  Else
       bChk = True
  End If
  Loop
  GetPassword = sPassword
' End
  Exit Function
GetPassword_error:
Open &#8220;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
&#8216; the decryption algorithm  code goes here
 Loop
  GetUsername = sUsername
  Exit Function
  
getusername_error:
Open &#8220;Filename&#8221; 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 &#8220;Filename&#8221; 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