'initialize contstants for control Dim CEVT_I2,CEVT_UI2,CEVT_I4,CEVT_UI4,CEVT_FILETIME,CEVT_LPWSTR,CEVT_BLOB,CEVT_BOOL,CEVT_R8 Dim CEDB_NO_AUTOINCREMENT,CEDB_AUTOINCREMENT Dim OPEN_EXISTING Dim CEDB_NOCOMPRESS Dim CEDB_PROPNOTFOUND,CEDB_PROPDELETE Dim ERROR_INVALID_PARAMETER,ERROR_NO_DATA,ERROR_INSUFFICIENT_BUFFER,ERROR_KEY_DELETED,ERROR_NO_MORE_ITEMS Dim CEDB_SORT_DEFAULT,CEDB_SORT_DESCENDING,CEDB_SORT_CASEINSENSITIVE,CEDB_SORT_UNKNOWNFIRST,CEDB_SORT_GENERICORDER Dim CEDB_SEEK_CEOID,CEDB_SEEK_BEGINNING,CEDB_SEEK_END,CEDB_SEEK_CURRENT,CEDB_SEEK_VALUESMALLER,CEDB_SEEK_VALUEFIRSTEQUAL,CEDB_SEEK_VALUEGREATER,CEDB_SEEK_VALUENEXTEQUAL Dim ERROR_DISK_FULL,ERROR_DUP_NAME Dim HKEY_CLASSES_ROOT,HKEY_CURRENT_USER,HKEY_LOCAL_MACHINE,HKEY_USERS Dim PROCESSOR_INTEL_386,PROCESSOR_INTEL_486,PROCESSOR_INTEL_PENTIUM,PROCESSOR_INTEL_860,PROCESSOR_MIPS_R2000,PROCESSOR_MIPS_R3000,PROCESSOR_MIPS_R4000,PROCESSOR_HITACHI_SH3,PROCESSOR_HITACHI_SH4,PROCESSOR_ALPHA_21064 Dim PROCESSOR_PPC_601,PROCESSOR_PPC_603,PROCESSOR_PPC_604,PROCESSOR_PPC_620,PROCESSOR_PPC_821,PROCESSOR_SHx_SH3,PROCESSOR_SHx_SH4,PROCESSOR_STRONGARM,PROCESSOR_ARM720,PROCESSOR_ARM820,PROCESSOR_ARM920 Dim BATTERY_CHG_HIGH,BATTERY_CHG_LOW,BATTERY_CHG_CRITICAL,BATTERY_CHG_CHARGING,BATTERY_CHG_NO_SYSTEM_BATTERY,BATTERY_CHG_UNKNOWN_STATUS Dim AC_LINE_DISCONNECTED,AC_LINE_CONNECTED,AC_LINE_STATUS_UNKNOWN Dim CONNECTION_EVENT_ACTIVE,CONNECTION_EVENT_ANSWERED,CONNECTION_EVENT_DISCONNECTION,CONNECTION_EVENT_ERROR,CONNECTION_EVENT_INACTIVE,CONNECTION_EVENT_IP_ADDRESS,CONNECTION_EVENT_LISTEN,CONNECTION_EVENT_TERMINATED Dim SYSMET_CXSCREEN,SYSMET_CYSCREEN CEVT_I2 = 2 ' short CEVT_UI2 = 18 ' unsigned short CEVT_I4 = 3 ' long CEVT_UI4 = 19 ' unsigned long CEVT_FILETIME = 64 ' DateTime CEVT_LPWSTR = 31 ' String CEVT_BLOB = 65 ' BLOB CEVT_BOOL = 11 ' Boolean CEVT_R8 = 5 ' Double CEDB_NO_AUTOINCREMENT = 0 CEDB_AUTOINCREMENT = 1 OPEN_EXISTING = 3 CEDB_NOCOMPRESS = 65536 CEDB_PROPNOTFOUND = 64 CEDB_PROPDELETE = 512 ERROR_INVALID_PARAMETER = 87 ERROR_NO_DATA = 232 ERROR_INSUFFICIENT_BUFFER = 122 ERROR_KEY_DELETED = 1018 ERROR_NO_MORE_ITEMS = 259 CEDB_SORT_DEFAULT = 0 CEDB_SORT_DESCENDING = 1 CEDB_SORT_CASEINSENSITIVE = 2 CEDB_SORT_UNKNOWNFIRST = 4 CEDB_SORT_GENERICORDER = 8 CEDB_SEEK_CEOID = 1 CEDB_SEEK_BEGINNING = 2 CEDB_SEEK_END = 4 CEDB_SEEK_CURRENT = 8 CEDB_SEEK_VALUESMALLER = 16 CEDB_SEEK_VALUEFIRSTEQUAL = 32 CEDB_SEEK_VALUEGREATER = 64 CEDB_SEEK_VALUENEXTEQUAL = 128 ERROR_DISK_FULL = 112 ERROR_DUP_NAME = 52 HKEY_CLASSES_ROOT = 0 HKEY_CURRENT_USER = 1 HKEY_LOCAL_MACHINE = 2 HKEY_USERS = 3 PROCESSOR_INTEL_386 = 386 PROCESSOR_INTEL_486 = 486 PROCESSOR_INTEL_PENTIUM = 586 PROCESSOR_INTEL_860 = 860 PROCESSOR_MIPS_R2000 = 2000 PROCESSOR_MIPS_R3000 = 3000 PROCESSOR_MIPS_R4000 = 4000 PROCESSOR_HITACHI_SH3 = 10003 PROCESSOR_HITACHI_SH4 = 10005 PROCESSOR_ALPHA_21064 = 21064 PROCESSOR_PPC_601 = 601 PROCESSOR_PPC_603 = 603 PROCESSOR_PPC_604 = 604 PROCESSOR_PPC_620 = 620 PROCESSOR_PPC_821 = 821 PROCESSOR_SHx_SH3 = 103 PROCESSOR_SHx_SH4 = 104 PROCESSOR_STRONGARM = 2577 PROCESSOR_ARM720 = 1824 PROCESSOR_ARM820 = 2080 PROCESSOR_ARM920 = 2336 BATTERY_CHG_HIGH = 1 BATTERY_CHG_LOW = 2 BATTERY_CHG_CRITICAL = 4 BATTERY_CHG_CHARGING = 8 BATTERY_CHG_NO_SYSTEM_BATTERY = 128 BATTERY_CHG_UNKNOWN_STATUS = 255 AC_LINE_DISCONNECTED = 0 AC_LINE_CONNECTED = 1 AC_LINE_STATUS_UNKNOWN = 255 CONNECTION_EVENT_ACTIVE = 0 CONNECTION_EVENT_ANSWERED = 1 CONNECTION_EVENT_DISCONNECTION = 2 CONNECTION_EVENT_ERROR = 3 CONNECTION_EVENT_INACTIVE = 4 CONNECTION_EVENT_IP_ADDRESS = 5 CONNECTION_EVENT_LISTEN = 6 CONNECTION_EVENT_TERMINATED = 7 SYSMET_CXSCREEN = 0 SYSMET_CYSCREEN = 1 Sub Form_Load 'This sample uses the Srego CE ToolPack ActiveX Control 'http://www.srego.com/products/CEToolPackX.htm 'The control can also be used to copy files, access databases directly, etc. AddObject "sregoCEtpx.sregoCEtpxCtrl.1","SregoCETPx1" ResetValues End Sub '------------------------------------------------------------------------------ ' Srego CE ToolPack ActiveX Control ' Example #1 - Device Information '------------------------------------------------------------------------------ Sub SregoCETPx1_ConnectionEvent(ByVal eventType, ByVal message) 'this doesn't seem to be working - needs to be investigated. Print "Connection Event received" Select Case eventType ' Refresh info if a connection has been detected Case CONNECTION_EVENT_ACTIVE: ConnectiontEventLabel.caption = "Connection Event Received" IPAddrLabel.Caption = "" RefreshCommand_Click RefreshCommand.Enabled = True ' Reset Info if the device is not connected Case CONNECTION_EVENT_DISCONNECTION, _ CONNECTION_EVENT_TERMINATED, _ CONNECTION_EVENT_INACTIVE: ResetValues RefreshCommand.Enabled = False ' Update IP address label if IP event received Case CONNECTION_EVENT_IP_ADDRESS: IPAddrLabel.Caption = message End Select End Sub Sub RefreshCommand_Click() GetDeviceId GetMemoryInfo GetStorageInfo GetProcessorType GetPowerInfo GetScreenInfo End Sub Sub GetMemoryInfo() Dim total Dim available MemoryLabel.Caption = "Unavailable" AvailableLabel.Caption = "Unavailable" If SregoCETPx1.GetMemoryInfo(total, available) Then MemoryLabel.Caption = FormatNumber(total,0) + " bytes" AvailableLabel.Caption = FormatNumber(available,0) + " bytes" MemoryPercentLabel.Caption = FormatNumber(100 - (available / total) * 100,2) End If End Sub Sub GetStorageInfo() Dim total Dim available StorageLabel.Caption = "Unavailable" StorageFreeLabel.Caption = "Unavailable" If SregoCETPx1.GetStorageInfo(total, available) Then StorageLabel.Caption = FormatNumber(total,0) + " bytes" StorageFreeLabel.Caption = FormatNumber(available,0) + " bytes" StoragePercentLabel.Caption = FormatNumber(100 - (available / total) * 100,2) End If End Sub Sub GetProcessorType() Dim procType procType = SregoCETPx1.GetDeviceProcessorType Dim message message = "Unknown: " & proctype If procType = 0 Then message = "Unavailable" Else Select Case procType Case PROCESSOR_INTEL_386: message = "INTEL 386" Case PROCESSOR_INTEL_486: message = "INTEL 486" Case PROCESSOR_INTEL_PENTIUM: message = "INTEL PENTIUM" Case PROCESSOR_INTEL_860: message = "INTEL 860" Case PROCESSOR_MIPS_R2000: message = "MIPS R2000" Case PROCESSOR_MIPS_R3000: message = "MIPS R3000" Case PROCESSOR_MIPS_R4000: message = "MIPS R4000" Case PROCESSOR_HITACHI_SH3: message = "HITACHI SH3" Case PROCESSOR_HITACHI_SH4: message = "HITACHI SH4" Case PROCESSOR_ALPHA_21064: message = "ALPHA 21064" Case PROCESSOR_PPC_601: message = "PPC 601" Case PROCESSOR_PPC_603: message = "PPC 603" Case PROCESSOR_PPC_604: message = "PPC 604" Case PROCESSOR_PPC_620: message = "PPC 620" Case PROCESSOR_PPC_821: message = "PPC 821" Case PROCESSOR_SHx_SH3: message = "SHx SH3" Case PROCESSOR_SHx_SH4: message = "SHx SH4" Case PROCESSOR_STRONGARM: message = "STRONGARM" Case PROCESSOR_ARM720: message = "ARM 720" Case PROCESSOR_ARM820: message = "ARM 820" Case PROCESSOR_ARM920: message = "ARM 920" End Select End If ProcessorLabel.Caption = message & " (" & proctype & ")" End Sub Sub GetPowerInfo() ' Get Battery Info Dim batteryFlag Dim batteryLifePercent Dim batteryLifeTime Dim batteryLifeFullTime Dim message If SregoCETPx1.GetBatteryInfo(batteryFlag, batteryLifePercent, _ batteryLifeTime, batteryLifeFullTime) Then Select Case batteryFlag Case BATTERY_CHG_HIGH: message = "High" Case BATTERY_CHG_LOW: message = "Low" Case BATTERY_CHG_CRITICAL: message = "Critical" Case BATTERY_CHG_CHARGING: message = "Charging" Case BATTERY_CHG_NO_SYSTEM_BATTERY: message = "No System Battery" Case BATTERY_CHG_UNKNOWN_STATUS: message = "Unknown" End Select BatteryStatusLabel.Caption = message BatteryLifeLabel.Caption = FormatTimeString(batteryLifeTime) BatteryFullTimeLabel.Caption = FormatTimeString(batteryLifeFullTime) If batteryLifePercent >= 0 And batteryLifePercent <= 100 Then BatteryPercentLabel.Caption = Int(batteryLifePercent) Else BatteryPercentLabel.Caption = 0 End If End If ' Get AC Line Status Dim acLineStatus acLineStatus = SregoCETPx1.GetACLineInfo Select Case acLineStatus Case AC_LINE_CONNECTED: message = "Connected" Case AC_LINE_DISCONNECTED: message = "Disconnected" Case AC_LINE_STATUS_UNKNOWN: message = "Unknown" Case Else message = "Unknown" End Select ACLineStatusLabel.Caption = message End Sub Function FormatTimeString(seconds) Dim minutes Dim hours Dim buffer buffer = "" hours = Int(seconds / 3600) minutes = Int((seconds - (hours * 3600)) / 60 + 0.5) If hours > 0 Then buffer = buffer + Trim(cStr(hours)) If hours = 1 Then buffer = buffer + " hour " Else buffer = buffer + " hours " End If End If If minutes > 0 Then buffer = buffer + cStr(minutes) + " min" End If FormatTimeString = buffer End Function Sub GetScreenInfo() Dim width Dim height width = SregoCETPx1.GetSystemMetric(SYSMET_CXSCREEN) height = SregoCETPx1.GetSystemMetric(SYSMET_CYSCREEN) If width > 0 And height > 0 Then ScreenWidthLabel.Caption = cStr(width) + " pixels" ScreenHeightLabel.Caption = cStr(height) + " pixels" Else ScreenWidthLabel.Caption = "" ScreenHeightLabel.Caption = "" End If End Sub Sub GetDeviceId() Dim v v = SregoCETPx1.RegGetValue(HKEY_LOCAL_MACHINE, "IDENT", "name") Dim buffer buffer = "Device Info" If v <> "" Then buffer = buffer + " (" + v + ")" End If Output.Caption = buffer End Sub Sub ResetValues() MemoryLabel.Caption = "" AvailableLabel.Caption = "" ProcessorLabel.Caption = "" BatteryStatusLabel.Caption = "" BatteryLifeLabel.Caption = "" BatteryFullTimeLabel.Caption = "" ACLineStatusLabel.Caption = "" ScreenHeightLabel.Caption = "" ScreenWidthLabel.Caption = "" Output.Caption = "Device Info" ConnectionEventLabel.Caption="" IPAddrLabel.Caption = "" StorageLabel.caption = "" StorageFreeLabel.caption = "" End Sub