Distributing an ADOCE application can be complex because several components must be installed on the desktop computer as well as on the device. One way to distribute an ADOCE application is to make modifications to the sample setup application included with the Microsoft® Windows® CE Toolkit for Visual Basic® 6.0. The sample below describes how to do this. All ADOCE setup applications need to do the following:
The following procedure shows how to create a desktop computer application that installs an ADOCE application.
Code Listing 1
Option Explicit
'*************************************************
' Global variables
'*************************************************
Public gCEAppMgrPath As String
Public gCEServicesPath As String
Public gCEServicesMajorVersion As Integer
Public gCEServicesMinorVersion As Integer
'*************************************************
' Win32 API Constants
'*************************************************
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const KEY_QUERY_VALUE = &H1
Public Const REG_DWORD = 4 ' 32-bit number
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const SYNCHRONIZE = &H100000
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const REG_SZ = 1 ' Unicode null terminated string
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Public Const ERROR_SUCCESS = 0&
Public Const REG_OPTION_NON_VOLATILE = 0&
'*************************************************
' Arrays to store list of cabfiles
' necessary to pass on to ceappmgr.exe
'*************************************************
Public CabList(10) As String
'*************************************************
' Win32 API declarations
'*************************************************
Declare Function RegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal szValueName _
As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal _
lpData As String, ByRef lpcbData As Long) As Long
' If you declare the lpData parameter as String,
' you must pass it By Value.
Declare Function RegOpenKeyEx Lib "advapi32.dll" 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.dll" (ByVal hKey As Long) _
As Long
' Function to create a registry key
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
"RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _
As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes _
As Long, phkResult As Long, lpdwDisposition As Long) As Long
' Function to set REG_SZ values
Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As _
String, ByVal cbData As Long) As Long
' Function to set REG_DWORD values
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
ByVal cbData As Long) As Long
'*************************************************
' Global Functions
'*************************************************
'*************************************************
' Function Name: SetValueEx
' Purpose: Sets a Key Value from the system
' registry
' Inputs: hkey: a key returned by RegCreateKeyEx
' sValueName: A Value for the registry key
' lType: REG_SZ or REG_DWORD
' vValue: the data for the value in sValueName
' Returns: Boolean
'
'*************************************************
Public Function SetValueEx(ByVal hKey As Long, sValueName As String, _
lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ
sValue = vValue & Chr$(0)
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, _
lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, _
lType, lValue, 4)
End Select
End Function
'*************************************************
' Function Name: GetKeyValue
' Purpose: Get a Key Value from the system
' registry
' Inputs: lngKeyRoot:
' strKeyName: Key Name in the system registry
' strSubKeyRef:
' strKEYVAL
' Returns: Boolean
'
'*************************************************
Public Function GetKeyValue(lngKeyRoot As Long, strKeyName As String, _
strSubKeyRef As String, ByRef strKeyVal As String) As Boolean
Dim i As Long ' Loop Counter
Dim lngRetCode As Long ' Return Code
Dim lngHKey As Long ' Handle To An Open Registry Key
Dim lngKeyValType As Long ' Data Type Of A Registry Key
Dim strTmpVal As String ' Tempory Storage For A Registry Key Value
Dim lngKeyValSize As Long ' Size Of Registry Key
' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
'------------------------------------------------------------
' Open Registry Key
lngRetCode = RegOpenKeyEx(lngKeyRoot, strKeyName, 0, KEY_ALL_ACCESS, lngHKey)
' Handle Error...
If (lngRetCode <> ERROR_SUCCESS) Then GoTo GetKeyError
strTmpVal = String$(1024, 0) ' Allocate Variable Space
lngKeyValSize = 1024 ' Mark Variable Size
'------------------------------------------------------------
' Retrieve Registry Key Value...
'------------------------------------------------------------
lngRetCode = RegQueryValueEx(lngHKey, strSubKeyRef, 0, _
lngKeyValType, strTmpVal, lngKeyValSize)
' Get/Create Key Value
If (lngRetCode <> ERROR_SUCCESS) Then GoTo GetKeyError
' Handle Errors
If (Asc(Mid(strTmpVal, lngKeyValSize, 1)) = 0) Then
' Win95 Adds Null Terminated String...
strTmpVal = VBA.Left(strTmpVal, lngKeyValSize - 1)
' Null Found, Extract From String
Else
' WinNT Does NOT Null Terminate String...
strTmpVal = VBA.Left(strTmpVal, lngKeyValSize)
' Null Not Found, Extract String Only
End If
'------------------------------------------------------------
' Determine Key Value Type For Conversion...
'------------------------------------------------------------
Select Case lngKeyValType
' Search Data Types...
Case REG_SZ
' String Registry Key Data Type
strKeyVal = strTmpVal
' Copy String Value
Case REG_DWORD
' Double Word Registry Key Data Type
strKeyVal = ""
For i = Len(strTmpVal) To 1 Step -1
' Convert Each Bit
strKeyVal = strKeyVal + Hex(Asc(Mid(strTmpVal, i, 1)))
' Build Value Char. By Char.
Next
strKeyVal = Format$("&h" + strKeyVal)
' Convert Double Word To String
End Select
GetKeyValue = True
' Return Success
lngRetCode = RegCloseKey(lngHKey)
' Close Registry Key
Exit Function ' Exit
GetKeyError: ' Cleanup After An Error Has Occurred...
strKeyVal = "" ' Set Return Val To Empty String
GetKeyValue = False ' Return Failure
lngRetCode = RegCloseKey(lngHKey)
' Close Registry Key
End Function
Code Listing 2
Option Explicit
Private Sub cmdExitSetup_Click()
Dim strMsg As String
Dim Style As Integer
Dim strTitle As String
Dim Response As Integer
' Ask if the user really wants to exit
strMsg = "Are you sure you want to exit? " _
& "Setup has not yet modified any files." ' Define message.
Style = vbYesNo + vbInformation ' Define buttons.
strTitle = "Setup" ' Define title.
' Display message.
Response = MsgBox(strMsg, Style, strTitle)
If Response = vbYes Then ' User chose Yes.
Unload Me
Else ' User chose No.
' Return to frmSelectC.
End If
End Sub
Private Sub cmdFinish_Click()
Dim ShellPath
On Error GoTo Bail
' Copy all the files to the CE Services directory
' The cab files are not copied at all
FileCopy App.Path & "\adofiltr.dll", gCEServicesPath & "\adofiltr.dll"
FileCopy App.Path & "\adofiltr.hlp", gCEServicesPath & "\adofiltr.hlp"
FileCopy App.Path & "\dbexport.exe", gCEServicesPath & "\dbexport.exe"
' Call regsvr32 on the adofiltr.dll
Shell "regsvr32 /s " & Chr(34) & gCEServicesPath & "\adofiltr.dll" & Chr(34)
' Add the registry keys for dbexport.exe
Dim sKeyName As String
Dim sValueName As String
Dim vValueSetting As Variant
Dim lValueType As Long
Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key
'Open the Windows CE Services key to add Export to the Windows CE Services Tools menu
lRetVal = RegCreateKeyEx(HKEY_LOCAL_MACHINE, _
"SOFTWARE\Microsoft\Windows CE Services\CustomMenus\DBExport", _
0&, _
vbNullString, _
REG_OPTION_NON_VOLATILE, _
KEY_ALL_ACCESS, _
0&, hKey, lRetVal)
lRetVal = SetValueEx(hKey, "Command", REG_SZ, gCEServicesPath & "\dbexport.exe")
lRetVal = SetValueEx(hKey, "DisplayName", REG_SZ, "&Export Database Tables...")
lRetVal = SetValueEx(hKey, "StatusHelp", REG_SZ, "This tool exports data from tables on the device to the host PC")
lRetVal = SetValueEx(hKey, "Version", REG_DWORD, "&H20000")
RegCloseKey (hKey)
'Open the Windows CE Services key to add Import to the Windows CE Services Tools menu
lRetVal = RegCreateKeyEx(HKEY_LOCAL_MACHINE, _
"SOFTWARE\Microsoft\Windows CE Services\CustomMenus\DBImport", _
0&, _
vbNullString, _
REG_OPTION_NON_VOLATILE, _
KEY_ALL_ACCESS, _
0&, hKey, lRetVal)
lRetVal = SetValueEx(hKey, "Command", REG_SZ, gCEServicesPath & "\dbexport.exe /import")
lRetVal = SetValueEx(hKey, "DisplayName", REG_SZ, "&Import Database Tables...")
lRetVal = SetValueEx(hKey, "StatusHelp", REG_SZ, "This tool imports data from the host PC to the device")
lRetVal = SetValueEx(hKey, "Version", REG_DWORD, "&H20000")
RegCloseKey (hKey)
' Call ceappmgr.exe with the appropriate ini files
MsgBox "Desktop setup successful!" & vbCrLf & "Setup will launch AppMgr and terminate." & vbCrLf, vbOKOnly, "ADOCE Setup is A-OK!"
ShellPath = Chr(34) & gCEAppMgrPath & Chr(34) & " " & Chr(34) & App.Path & "\Adoapmgr.ini" & Chr(34)
Shell ShellPath, vbNormalFocus
Unload Me
Exit Sub
Bail:
MsgBox "Setup did not finish successfully due to the following error condition" & vbCrLf & vbCrLf & _
"(" & Err.Number & ") " & Err.Description, vbExclamation, "Setup Error"
Unload Me
End Sub
Private Sub Form_Load()
Dim strCabFiles As String ' Name of cab file
Dim i As Integer ' Loop count
Dim strCabVar As String '
Dim strKeyVal As String
Dim blnRetVal As Boolean
' Get the full path of the Windows CE Services AppMgr program
blnRetVal = GetKeyValue(HKEY_LOCAL_MACHINE, _
"SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\CEAPPMGR.EXE", _
"", strKeyVal)
If blnRetVal = True Then
gCEAppMgrPath = strKeyVal
End If
' Get the path to the Windows CE Services directory
blnRetVal = GetKeyValue(HKEY_LOCAL_MACHINE, _
"SOFTWARE\Microsoft\Windows CE Services", _
"InstalledDir", strKeyVal)
If blnRetVal = True Then
gCEServicesPath = strKeyVal
End If
' Get the MajorVersion of Windows CE Services
blnRetVal = GetKeyValue(HKEY_LOCAL_MACHINE, _
"SOFTWARE\Microsoft\Windows CE Services", _
"MajorVersion", strKeyVal)
If blnRetVal = True Then
gCEServicesMajorVersion = Val(strKeyVal)
End If
' Get the MinorVersion of Windows CE Services
blnRetVal = GetKeyValue(HKEY_LOCAL_MACHINE, _
"SOFTWARE\Microsoft\Windows CE Services", _
"MinorVersion", strKeyVal)
If blnRetVal = True Then
gCEServicesMinorVersion = Val(strKeyVal)
End If
If (gCEServicesMajorVersion <> 2) Or (gCEServicesMinorVersion < 1) Then
cmdFinish.Enabled = False
lblInstr2.ForeColor = vbRed
End If
End Sub