Mengakses windows registry komputer lain

Artikel kali ini terilhami dari salah satu postingan yang ada di forum vb bego, waktu itu Penanya memposting beberapa baris kode untuk mengakses mengakses windows registry komputer lain dan ternyata gagal saat dijalankan.

Adapun fungsi API yang digunakan adalah RegConnectRegistry.

Berhubung hal ini juga baru bagi saya, akhirnya saya pun memulai pencarian dan tentunya ditemanin mbah Goeoegle dan Alhamdulillah mendapatkan pencerahan .

Ternyata sebelum kita bisa mengakses fungsi RegConnectRegistry, terlebih dahulu kita harus memanggil fungsi API LogonUser dan ImpersonateLoggedOnUser.

Oke berikut kode lengkapnya :

Option Explicit

Private Declare Function LogonUser Lib "advapi32.dll" Alias "LogonUserA" (ByVal lpszUsername As String, ByVal lpszDomain As String, ByVal lpszPassword As String, ByVal dwLogonType As Integer, ByVal dwLogonProvider As Integer, ByRef phToken As Long) As Boolean
Private Declare Function ImpersonateLoggedOnUser Lib "advapi32.dll" (ByVal hToken As Long) As Long

Private Declare Function RegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hKey As Long, phkResult As Long) As Long

Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000

Private Const LOGON32_PROVIDER_DEFAULT As Long = 0
Private Const LOGON32_LOGON_NEW_CREDENTIALS As Long = 9
Private Const ERROR_SUCCESS = 0&

Private Const HKEY_CURRENT_USER = &H80000001

Private Function apiErrorText(ByVal ErrNum As Long) As String
    Dim msg As String
    Dim nRet As Long

    msg = Space$(1024)
    nRet = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, ErrNum, 0&, msg, Len(msg), ByVal 0&)
    If nRet Then
        apiErrorText = Left$(msg, nRet)
    Else
        apiErrorText = "Error (" & ErrNum & ") not defined."
    End If
End Function

Private Function validateLogin(ByVal username As String, ByVal password As String, Optional ByVal komputerTarget As String = ".") As Boolean
    Dim result As Long
    Dim hToken As Long

    If LogonUser(username, komputerTarget, password, LOGON32_LOGON_NEW_CREDENTIALS, LOGON32_PROVIDER_DEFAULT, hToken) Then
        result = ImpersonateLoggedOnUser(hToken)
    End If

    validateLogin = result
End Function

Adapun contoh untuk penggunaan fungsi diatas sebagai berikut :

Private Sub cmdRemoteRegistry_Click()
    Dim lRet            As Long
    Dim hRemoteReg      As Long

    Dim komputerTarget  As String

    komputerTarget = "192.168.0.2"

    If validateLogin("lab-01", "rahasia", komputerTarget) Then
        lRet = RegConnectRegistry(komputerTarget, HKEY_CURRENT_USER, hRemoteReg)

        If (lRet = ERROR_SUCCESS) Then
            MsgBox "Successfully connected to remote registry"

            'TODO : lakukan akses registry seperti biasa
            'ex : MsgBox getFromWindowsRegistry(hRemoteReg, "Software\K4m4r82's Laboratory\SLS", "version")

        Else
            MsgBox "Error:" & Err.LastDllError & " -> " & apiErrorText(Err.LastDllError), vbExclamation, "Akses registry error"
            Unload Me
        End If
    End If
End Sub

Selain itu agar kode diatas berjalan dengan sempurna ada beberapa settingan yang harus disesuaikan dikomputer yang akan diremote.

Selain itu Windows Firewall juga harus dinonaktifkan

Adapun alternatif lain jika ingin Windows Firewall tetap aktif maka pilihan File and Printer Sharing harus diaktifkan

Selamat mencoba