It requires the RAPI.dll in the same directory of the executable / source code to work, and activesync installed!
At this time it just connects to the remote device, get's the windows version of the device and reports the power status.
The file IO function where not converted yet
It was tested using activesync 4.1 and a HP PDA with windows CE 2.1.
Code: Select all
#ONE_SECOND = 1000
#E_FAIL = $80004005
#E_SUCESS = 0
#FILE_ATTRIBUTE_NORMAL = $80
#INVALID_HANDLE_VALUE = -1
#GENERIC_READ = $80000000
#GENERIC_WRITE = $40000000
#CREATE_NEW = 1
#CREATE_ALWAYS = 2
#OPEN_EXISTING = 3
#ERROR_FILE_EXISTS = 80
#ERROR_INVALID_PARAMETER = 87
#ERROR_DISK_FULL = 112
#FAF_ATTRIBUTES = $00000001;
#FAF_CREATION_TIME = $00000002 ;
#FAF_LASTACCESS_TIME = $00000004 ;
#FAF_LASTWRITE_TIME = $00000008 ;
#FAF_SIZE_HIGH = $00000010;
#FAF_SIZE_LOW = $00000020;
#FAF_OID = $00000040;
#FAF_NAME = $00000080;
#FAF_FLAG_COUNT = 8 ;
#FAF_ATTRIB_CHILDREN = $00001000 ;
#FAF_ATTRIB_NO_HIDDEN = $00002000 ;
#FAF_FOLDERS_ONLY = $00004000 ;
#FAF_NO_HIDDEN_SYS_ROMMODULES = $00008000;
#FAD_OID = $1 ;
#FAD_FLAGS = $2 ;
#FAD_NAME = $4 ;
#FAD_TYPE = $8 ;
#FAD_NUM_RECORDS = $10 ;
#FAD_NUM_SORT_ORDER = $20 ;
#FAD_SIZE = $40 ;
#FAD_LAST_MODIFIED = $80 ;
#FAD_SORT_SPECS = $100 ;
#FAD_FLAG_COUNT = $9 ;
#CeDB_SORT_DESCENDING = $00000001;
#CeDB_SORT_CASEINSENSITIVE = $00000002;
#CeDB_SORT_UNKNOWNFIRST = $00000004;
#CeDB_SORT_GENERICORDER = $00000008;
#CeDB_MAXDBASENAMELEN = 32 ;
#CeDB_MAXSORTORDER = 4 ;
#CeDB_VALIDNAME = $0001 ;
#CeDB_VALIDTYPE = $0002 ;
#CeDB_VALIDSORTSPEC = $0004 ;
#CeDB_VALIDMODTIME = $0008
;
#OBJTYPE_INVALID = 0 ;
#OBJTYPE_FILE = 1 ;
#OBJTYPE_DIRECTORY = 2 ;
#OBJTYPE_DATABASE = 3 ;
#OBJTYPE_RECORD = 4 ;
#CeDB_AUTOINCREMENT = $00000001;
#CeDB_SEEK_CeOID = $00000001;
#CeDB_SEEK_BEGINNING = $00000002 ;
#CeDB_SEEK_END = $00000004;
#CeDB_SEEK_CURRENT = $00000008;
#CeDB_SEEK_VALUESMALLER = $00000010;
#CeDB_SEEK_VALUEFIRSTEQUAL = $00000020;
#CeDB_SEEK_VALUEGREATER = $00000040;
#CeDB_SEEK_VALUENEXTEQUAL = $00000080;
#CeVT_I2 = 2 ;
#CeVT_UI2 = 18 ;
#CeVT_I4 = 3 ;
#CeVT_UI4 = 19 ;
#CeVT_FILETIME = 64 ;
#CeVT_LPWSTR = 31 ;
#CeVT_BLOB = 65 ;
#CeDB_PROPNOTFOUND = $0100 ;
#CeDB_PROPDELETE = $0200 ;
#CeDB_MAXDATABLOCKSIZE = 4092 ;
#CeDB_MAXPROPDATASIZE = #CeDB_MAXDATABLOCKSIZE*16;
#CeDB_MAXRECORDSIZE = (128*1024);
#CeDB_ALLOWREALLOC = $00000001 ;
#SYSMEM_CHANGED = 0 ;
#SYSMEM_MUSTREBOOT = 1 ;
#SYSMEM_REBOOTPENDING = 2 ;
#SYSMEM_FAILED = 3 ;
Structure SYSTEM_POWER_STATUS_EX
ACLineStatus.b ;
BatteryFlag.b ;
BatteryLifePercent.b ;
Reserved1.b ;
BatteryLifeTime.d ;
BatteryFullLifeTime.d ;
Reserved2.b ;
BackupBatteryFlag.b ;
BackupBatteryLifePercent.b ;
Reserved3.b ;
BackupBatteryLifeTime.d ;
BackupBatteryFullLifeTime.d ;
EndStructure
#AC_LINE_OFFLINE = $00 ;
#AC_LINE_ONLINE = $01 ;
#AC_LINE_BACKUP_POWER = $02 ;
#AC_LINE_UNKNOWN = $FF ;
#BATTERY_FLAG_HIGH = $01 ;
#BATTERY_FLAG_LOW = $02 ;
#BATTERY_FLAG_CRITICAL = $04 ;
#BATTERY_FLAG_CHARGING = $08 ;
#BATTERY_FLAG_NO_BATTERY = $80 ;
#BATTERY_FLAG_UNKNOWN = $FF ;
#BATTERY_PERCENTAGE_UNKNOWN = $FF ;
Structure CEOSVERSIONINFO
dwOSVersionInfoSize.l
dwMajorVersion.l
dwMinorVersion.l
dwBuildNumber.l
dwPlatformId.l
szCSDVersion.s[128]
EndStructure
Structure RAPIINIT
cbSize.l
heRapiInit.l
hrRapiInit.l
EndStructure
Procedure Device_Connect()
If OpenLibrary(0, "rapi.dll")
Protected pRapiInit.RAPIINIT
pRapiInit\cbSize = SizeOf(pRapiInit)
pRapiInit\heRapiInit = 0
pRapiInit\hrRapiInit = 0
CallFunction(0, "CeRapiInitEx", @pRapiInit)
Debug pRapiInit\hrRapiInit
EndIf
EndProcedure
Procedure RapiGetCEOSVersionString()
; Returns the Major, Minor, and Build number of the OS In a string.
ceosver.CEOSVERSIONINFO
ceosver\dwOSVersionInfoSize = SizeOf(ceosver)
CallFunction(0, "CeGetVersionEx", @ceosver)
Debug ceosver\dwMajorVersion
Debug ceosver\dwBuildNumber
Debug ceosver\szCSDVersion
EndProcedure
Procedure Remote_GetPowerStatus()
Protected pStatus.SYSTEM_POWER_STATUS_EX
CallFunction(0, "CeGetSystemPowerStatusEx", @pStatus, #True)
Debug pStatus\ACLineStatus
Debug pStatus\BatteryLifePercent
Debug pStatus\BatteryFlag
EndProcedure
Device_Connect()
RapiGetCEOSVersionString()
Remote_GetPowerStatus()
Code: Select all
Option Explicit
Private Declare Function WaitForSingleObject Lib "kernel32" (
ByVal _ hHandle As Long
ByVal dwMilliseconds As Long) As Long
Public Const ONE_SECOND = 1000
Public Const E_FAIL = &H80004005
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const INVALID_HANDLE_VALUE = -1
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const CREATE_NEW = 1
Public Const CREATE_ALWAYS = 2
Public Const OPEN_EXISTING = 3
Public Const ERROR_FILE_EXISTS = 80
Public Const ERROR_INVALID_PARAMETER = 87
Public Const ERROR_DISK_FULL = 112
Public Type CEOSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Public Type RAPIINIT
cbSize As Long
heRapiInit As Long
hrRapiInit As Long
End Type
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
Public Type MyType
value As Integer
End Type
Public Declare Function CeCloseHandle Lib "rapi.dll" ( _
ByVal hObject As Long) As Boolean
Public Declare Function CeCreateFile Lib "rapi.dll" ( _
ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
lpSecurityAttributes As SECURITY_ATTRIBUTES, _
ByVal dwCreationDistribution As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Public Declare Function CeGetVersionEx Lib "rapi.dll" ( _
lpVersionInformation As CEOSVERSIONINFO) As Boolean
Public Declare Function CeRapiInitEx Lib "rapi.dll" ( _
pRapiInit As RAPIINIT) As Long
Public Declare Function CeRapiUninit Lib "rapi.dll" () As Long
Public Declare Function CeReadFile Lib "rapi.dll" ( _
ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Long) As Boolean
Public Declare Function CeWriteFile Lib "rapi.dll" ( _
ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, _
ByVal lpOverlapped As Long) As Boolean
Public Declare Function CeGetLastError Lib "rapi.dll" () As Long
'Wrapper functions for above API calls
Private Function GetSub(Addr As Long) As Long
'Used for the init call.
GetSub = Addr
End Function
Public Sub ConnectedRapi()
'Used for the init call. Do not remove.
End Sub
Public Function RapiConnect() As Boolean
'Initiates a connection and returns true
' if it connected, false if it did not.
'Modified to match suggestion of Microsoft KB article 831883
'http://support.microsoft.com/default.aspx?scid=kb;en-us;831883
Dim pRapiInit As RAPIINIT
Dim dwWaitRet, dwTimeout As Long
Dim hr As Long
On Error GoTo RapiConnect_Err
pRapiInit.cbSize = Len(pRapiInit)
pRapiInit.heRapiInit = 0
pRapiInit.hrRapiInit = 0
hr = E_FAIL
dwWaitRet = 0
dwTimeout = 10 * ONE_SECOND 'However long you want to wait
'Call CeRapiInitEx one time.
hr = CeRapiInitEx(pRapiInit)
If hr < 0 Then 'FAILED
GoTo Failed
End If
'Wait for the RAPI event until timeout.
'Use the WaitForSingleObject function for the worker thread
'Use the WaitForMultipleObjects function if you are also waiting for other events.
dwWaitRet = WaitForSingleObject(pRapiInit.heRapiInit, dwTimeout)
If dwWaitRet = 0 Then 'WAIT_OBJECT_0
'If the RAPI init is returned, check result
If pRapiInit.hrRapiInit >= 0 Then 'SUCCEEDED
GoTo Succeeded
Else
GoTo Failed
End If
Else
'Timeout or failed.
GoTo Failed
End If
'success
Succeeded:
'Now you can make RAPI calls.
RapiConnect = True
Exit Function
Failed:
'Uninitialize RAPI if you ever called CeRapiInitEx.
If hr >= 0 Then 'SUCCEEDED
Call CeRapiUninit
End If
RapiConnect = False
Exit Function
RapiConnect_Err:
RapiConnect = False
End Function
Public Sub RAPICopyCEFileToPC(ByVal CESourceFile As String, _
ByVal PCDestFile As String)
Dim lCeFileHandle As Long
Dim iFile As Integer
Dim BytePos As Long
Dim lBufferLen As Long
Dim lBytesRead As Long
Dim bytFile(2048) As Byte
Dim lResult As Long
Dim I As Integer
' Open the CE file.
lCeFileHandle = RapiOpenFile(CESourceFile, 1, False, _
FILE_ATTRIBUTE_NORMAL)
If lCeFileHandle <> INVALID_HANDLE_VALUE Then
'Create a file on the PC and write
' the bytes from the CE file to it.
iFile = FreeFile
Open PCDestFile For Binary Access Write As iFile
BytePos = 1
lBufferLen = 2048
Do
lResult = CeReadFile(lCeFileHandle, bytFile(0), _
lBufferLen, lBytesRead, 0&)
If (lResult And (lBytesRead = 0)) Then
lResult = CeCloseHandle(lCeFileHandle)
Close iFile
Exit Do
Else
For I = 0 To lBytesRead - 1
Put iFile, BytePos + I, bytFile(I)
Next I
BytePos = BytePos + lBytesRead
End If
Form1.Label6.Caption = "Bytes Copied:" & _
(BytePos - 1) & " Up."
Form1.Label6.Refresh
Loop
Form1.Label6.Caption = Form1.Label6.Caption & _
" Transfer Completed."
Else
lResult = CeCloseHandle(lCeFileHandle)
MsgBox "Device File Does Not Exist Or Is Empty (0 Bytes)!"
End If
End Sub
Public Sub RAPICopyPCFileToCE(ByVal PCSourceFile As String, _
ByVal CEDestFile As String)
Dim iFile As Integer
Dim bytFile() As MyType
Dim lCeFileHandle As Long
Dim BytePos As Long
Dim lBufferLen As Long
Dim TotalCopied As Long
Dim lBytesWritten As Long
Dim lResult As Long
'Get bytes from PC file.
iFile = FreeFile
Open PCSourceFile For Binary Access Read As iFile
ReDim bytFile(LOF(iFile))
Get iFile, , bytFile
Close iFile
'Create a file on the CE Device and write
' the bytes from the PC file to it.
lCeFileHandle = RapiOpenFile(CEDestFile, 2, _
True, FILE_ATTRIBUTE_NORMAL)
If lCeFileHandle <> INVALID_HANDLE_VALUE Then
BytePos = 0
'Copy this many bytes at a time (MUST BE EVEN #).
lBufferLen = 2048
Do
If UBound(bytFile) - TotalCopied > lBufferLen Then
' Copy the next set of bytes
lResult = CeWriteFile(lCeFileHandle, bytFile(BytePos), _
lBufferLen, lBytesWritten, 0&)
TotalCopied = TotalCopied + lBytesWritten
' Unicode compensation.
BytePos = BytePos + (lBufferLen \ 2)
Form1.Label6.Caption = "Bytes Copied: " & _
TotalCopied & " Down."
Form1.Label6.Refresh
Else
' Copy the remaining bytes if greater than 0
lBufferLen = UBound(bytFile) - TotalCopied
If lBufferLen > 0 Then
' Copy remaining bytes at one time.
lResult = CeWriteFile(lCeFileHandle, _
bytFile(BytePos), lBufferLen, lBytesWritten, 0&)
End If
TotalCopied = TotalCopied + lBytesWritten
Form1.Label6.Caption = "Bytes Copied: " & _
TotalCopied & " Down."
Form1.Label6.Refresh
Exit Do
End If
Loop
Else
'CeCreateFile failed. Why?
Select Case CeGetLastError
Case ERROR_FILE_EXISTS
MsgBox "A file already exists with the specified name."
Case ERROR_INVALID_PARAMETER
MsgBox "A parameter was invalid."
Case ERROR_DISK_FULL
MsgBox "Disk if Full."
Case Else
MsgBox "An unknown error occurred."
End Select
End If
Form1.Label6.Caption = Form1.Label6.Caption & " Transfer Completed."
lResult = CeCloseHandle(lCeFileHandle)
End Sub
Public Sub RapiDisconnect()
Call CeRapiUninit
End Sub
Public Function RapiGetCEOSVersionString() As String
' Returns the Major, Minor, and Build number of the OS In a string.
Dim ceosver As CEOSVERSIONINFO
ceosver.dwOSVersionInfoSize = Len(ceosver)
If CeGetVersionEx(ceosver) Then
RapiGetCEOSVersionString = ceosver.dwMajorVersion & "." & _
ceosver.dwMinorVersion & "." & _
ceosver.dwBuildNumber & " " & _
Left$(ceosver.szCSDVersion, _
InStr(ceosver.szCSDVersion, Chr$(0)) - 1)
Else
RapiGetCEOSVersionString = ""
End If
End Function
Public Function RapiIsConnected() As Boolean
' Returns whether there is a RAPI connection. If the Version
'string is returned then we know we have a valid connection.
RapiIsConnected = RapiGetCEOSVersionString <> ""
End Function
Public Function RapiOpenFile(ByVal FileName As String, _
ByVal mode As Integer, _
ByVal CreateNew As Boolean, _
ByVal flags As Long) As Long
Dim lReturn As Long
Dim lFileMode As Long
Dim Security As SECURITY_ATTRIBUTES
Dim CreateDist As Long
Select Case mode
Case 1: lFileMode = GENERIC_READ
Case 2: lFileMode = GENERIC_WRITE
Case 3: lFileMode = GENERIC_READ Or GENERIC_WRITE
End Select
If CreateNew Then
CreateDist = CREATE_NEW
Else
CreateDist = OPEN_EXISTING
End If
lReturn = CeCreateFile(StrConv(FileName, vbUnicode), lFileMode, _
0, Security, CreateDist, flags, 0&)
RapiOpenFile = lReturn
End Function
Function FileExists(ByVal sFilename As String) As Boolean
'This function will check to make sure that a file exists. It will
'return True if the file was found and False if it was not found.
'Example: If Not FileExists("autoexec.bat") Then...
Dim I As Integer
On Error Resume Next
I = Len(Dir$(sFilename))
If Err Or I = 0 Or Trim(sFilename) = "" Then
FileExists = False
Else
FileExists = True
End If
End Function
