Option Explicit

Private Sub Form_Load()
    Command1.Caption = "Get connected device name"
End Sub

Private Sub Command1_Click()
    Dim lret As Long
    Dim lcon As Long
    
    ' Initialize RAPI
    lcon = ConnectRapi
    If lcon <> ERROR_SUCCESS Then
       MsgBox "Failure to initialize RAPI"
    Else
       MsgBox "RAPI was initialized successfully"
    End If
    
    ' Retrieve the registry information on the remote device
    lret = ReadCEREgistry
    
    ' Uninitialize RAPI
    lcon = DisconnectRapi
    If lcon <> ERROR_SUCCESS Then
       MsgBox "Failure to uninitialize RAPI"
    Else
       MsgBox "RAPI was uninitialized successfully"
    End If
       
End Sub
					

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const ERROR_SUCCESS = 0
Public Const REG_DWORD = 4        '32-bit number.
Public Const REG_SZ = 1

Type RAPIINIT
    cbsize As Long
    heRapiInit As Long
    hrRapiInit As Long
End Type

Declare Function CeRapiUninit Lib "rapi.dll" () As Long

Declare Function CeRapiInitEx Lib "rapi.dll" ( _
    pRapiInit As RAPIINIT) As Long
    
Declare Function CeRegOpenKeyEx Lib "rapi.dll" ( _
    ByVal hkey As Long, _
    ByVal lpSubKey As Long, _
    ByVal ulOptions As Long, _
    ByVal samDesired As Long, _
    phkResult As Long) As Long
    
Declare Function CeRegQueryValueEx Lib "rapi.dll" ( _
    ByVal hkey As Long, _
    ByVal lpValueName As Long, _
    ByVal lpReserved As Long, _
    lpType As Long, _
    ByVal lpdata As Long, _
    lpcbData As Long) As Long
    
Declare Function CeRegQueryValueExLong Lib "rapi.dll" _
    Alias "CeRegQueryValueEx" ( _
    ByVal hkey As Long, _
    ByVal lpValueName As Long, _
    ByVal lpReserved As Long, _
    lpType As Long, _
    lpdata As Long, _
    lpcbData As Long) As Long
    
Declare Function CeRegQueryValueExString Lib "rapi.dll" _
    Alias "CeRegQueryValueEx" ( _
    ByVal hkey As Long, _
    ByVal lpValueName As Long, _
    ByVal lpReserved As Long, _
    lpType As Long, _
    ByVal lpdata As Long, _
    lpcbData As Long) As Long

Declare Function CeRegCloseKey Lib "rapi.dll" ( _
    ByVal hkey As Long) As Long

' Initialize RAPI
Function ConnectRapi() As Long
    Dim lcon As Long
    Dim lRapiInit As RAPIINIT
    
    With lRapiInit
        .cbsize = Len(lRapiInit)
        .heRapiInit = 0
        .hrRapiInit = 0
    End With
    
    lcon = CeRapiInitEx(lRapiInit)
    ConnectRapi = lcon
End Function

' Uninitialize RAPI
Function DisconnectRapi() As Long
    Dim lcon As Long
    lcon = CeRapiUninit
    DisconnectRapi = lcon
End Function

' Read the registry on the CE device
Function ReadCEREgistry() As Long
    Dim lret As Long
    Dim phkResult As Long
    Dim lpType As Long
    Dim lpdata As String
    Dim lpvalue As Long
    Dim lpcbData As Long
    Dim data As String
    Dim key As String
    Dim lpdwdisposition As Long
    Dim value As String
    
    key = "Ident"
    lret = CeRegOpenKeyEx(HKEY_LOCAL_MACHINE, StrPtr(key), _
                          0, 0, phkResult)
    
    If lret <> ERROR_SUCCESS Then
        MsgBox "Failure to open key.  Error: " & lret
    Else
        value = "Name"
        lret = CeRegQueryValueEx(phkResult, StrPtr(value), _
                                 0, lpType, 0, lpcbData)
        Select Case lpType
            ' -- For strings
            Case REG_SZ:
                ' Allocate string space
                lpdata = String(lpcbData, 0)
                
                ' Query the string value
                lret = CeRegQueryValueExString(phkResult, StrPtr(value), _
                          CLng(0), lpType, StrPtr(lpdata), lpcbData)
                          
                If lret = ERROR_SUCCESS Then
                    MsgBox "The name of the currently connected " & _
                            "device is " & Left(lpdata, lpcbData - 1)
                Else
                    MsgBox "Your device does not have a name"
                    lpdata = ""
                End If
                
            '-- For DWORDS
            Case REG_DWORD:
                lret = CeRegQueryValueExLong(phkResult, StrPtr(value), _
                        CLng(0), lpType, lpvalue, lpcbData)
                If lret = ERROR_SUCCESS Then MsgBox lpvalue
                
            ' -- All other data types not supported
            Case Else
                lret = -1
        End Select
    End If
    
    ReadCEREgistry = lret
End Function