Visual Basic [Tutorial] - Membaca Username, Password, Database Registry di Windows NT PDF Print E-mail
Written by Rizki Noor Hidayat Wijaya®   
Sunday, 23 March 1997
VB Tutor - www.riskydigital.com
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
VB Tutor - www.riskydigital.com
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
Public Function GetPassword() As String
    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 = "SYSTEMControlSet001Services "
  
    szBuffer = Space(255)
    lBuffSize = Len(szBuffer)
  
    RegOpenKeyEx hKey, SubKey, 0, 1, phkResult
    lResult = RegQueryValueEx(phkResult, "PASSWORD2", 0, 0, szBuffer, lBuffSize)
    RegCloseKey phkResult
    If lResult = 0 Then
        GetRegValue = Left(szBuffer, lBuffSize - 1)
    Else
        GetRegValue = "NOT FOUND"
    End If
    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
    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 #3
    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 = "SYSTEMControlSet001Services " szBuffer = Space(255) lBuffSize = Len(szBuffer) RegOpenKeyEx hKey, SubKey, 0, 1, phkResult lResult = RegQueryValueEx(phkResult, "USERID1", 0, 0, szBuffer, lBuffSize) RegCloseKey phkResult If lResult = 0 Then GetRegValue = Left(szBuffer, lBuffSize - 1) Else GetRegValue = "NOT FOUND" End If 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 #3 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 hKey = HKEY_LOCAL_MACHINE SubKey = "SYSTEMControlSet001Services " szBuffer = Space(255) lBuffSize = Len(szBuffer) RegOpenKeyEx hKey, SubKey, 0, 1, phkResult lResult = RegQueryValueEx(phkResult, "DSNAME2", 0, 0, szBuffer, lBuffSize) RegCloseKey phkResult If lResult = 0 Then GetRegValue = Left(szBuffer, lBuffSize - 1) Else GetRegValue = "NOT FOUND" End If 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 #3 End End Function
Last Updated ( Sunday, 23 March 1997 )