Xojo Conferences

Platforms to show: All Mac Windows Linux Cross-Platform

Required plugins for this example: MBS USB Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /USB/HID Mac/USB HID Test Mac
This example is the version from Sun, 17th Mar 2012.
Project "USB HID Test Mac.rbp"
Filetype text
End FileTypes
MenuBar MenuBar1
MenuItem UntitledMenu2 = ""
MenuItem FileMenu = "&File"
MenuItem FileLoadConfiguration = "Load Configuration..."
MenuItem FileSaveConfiguration = "Save Configuration..."
MenuItem UntitledMenu1 = "-"
MenuItem FileQuit = "Quit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem UntitledMenu0 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "Clear"
MenuItem ToolsMenu = "Tools"
MenuItem ToolsChangeall = "Change all"
MenuItem AppleAboutthisapplication = "About this application..."
End MenuBar
Class App Inherits Application
EventHandler Sub Close() app.quitting=true End EventHandler
EventHandler Sub Open() if TargetMachO then MsgBox "This example does not work unless you modify it for your device!" else MsgBox "This example requires a Mac OS X target." end if if not InitInstance then quit end if End EventHandler
Sub CheckFirmware() dim s as string dim m as MemoryBlock dim firmwareversion as integer // you can send data h.Send "P" // and read data m=h.Read(16) if m<>nil then // for this example device, the device returns firmware version after you sent P command. s=m.CString(0) // this device returns a C String in a 16byte package 'MsgBox "firmwareversion: "+s firmwareversion=val(s) if firmwareversion<10 then MsgBox "Please reset the USB device!" app.quitting=true quit Return elseif firmwareversion<15 then MsgBox "Firmware Version xxx below V1.5!" app.quitting=true quit Return end if else MsgBox "Failed to query Firmware version" app.quitting=true quit end if End Sub
Protected Function FindDevice() As MyHID dim h as MyHID dim p as string h=new MyHID if h.FindFirstDevice then // compare here Product name, ProductID and VendorID p=h.Product if left(p,3)="xxx" then Return h end if while h.FindNextDevice p=h.Product if left(p,3)="xxx" then Return h end if wend end if End Function
Function InitInstance() As boolean If OpenUSBDevice =false then Return false else CheckFirmware end if Return true End Function
Function OpenUSBDevice() As boolean dim i as integer h=FindDevice if h=nil then MsgBox "No xxx device found." quit Return false end if h.Connect if h.Lasterror<>0 then MsgBox "Failed to connect to xxx Device." quit Return false end if h.InstallCallback Return true End Function
Property Protected h As myhid
Property quitting As boolean
End Class
Class MyHID Inherits MacHIDMBS
EventHandler Sub ReceivedData(data as string, size as integer) dim m as MemoryBlock dim s as string dim i as integer m=data // debug output for i=0 to 15 s=s+str(m.Byte(i))+" " next s=s+"= "+data System.DebugLog s // and store it for the read command datas.Append m End EventHandler
Sub Constructor() EventRecord=NewMemoryBlock(100) TimeOut=2222 End Sub
Protected Sub MyWait() // Boolean WaitNextEvent(EventMask eventMask,EventRecord * theEvent,UInt32 sleep,RgnHandle mouseRgn) declare function WaitNextEvent lib "Carbon" (eventmask as integer, EventRecord as Ptr, sleep as integer, mouse as integer) as Boolean call WaitNextEvent(0,EventRecord,1,0) End Sub
Function Read(count as integer) As memoryBlock // This read command is to read syncronous. // Normally you should handle data in the event and work asyncronous, but this is not always possible. const DelayDontMPYield = 1 const DelayDontRBYield = 2 const DelayDontThreadYield = 4 const DelayDontQuickTimeYield = 8 const DelayDontWait = 16 const DelayDontWaitNextEvent = 32 const DelayDontSleep = 64 dim t as integer dim m as MemoryBlock t=Ticks+60 // quitting already? if app.quitting then quit end if while t>ticks // delay some time MyWait if app.quitting then quit end if // and if we got data we return it. if UBound(datas)>=0 then Return datas.Pop end if wend Return nil // timeout End Function
Sub Send(data as string) // this is a special send command for this device. // For this device we need to package data into a 8 byte package. dim m as MemoryBlock dim n as integer dim d,s as string dim i as integer if app.quitting then quit end if // this device wants 8 byte per command n=lenb(data) if n>8 then n=8 end if m=NewMemoryBlock(8) m.StringValue(0,n)=data for i=0 to 7 s=s+str(m.Byte(i))+" " next d=m s=s+"= "+d System.DebugLog s me.SendMessageMemory m,0,8 'System.DebugLog "SendMessageMemory lasterror: "+Format(me.Lasterror,"-0") if me.Lasterror=-536854447 then app.quitting=true MsgBox "The USB Receiver failed with a timeout to send an answer. Please restart application and device." quit end if End Sub
Property Protected EventRecord As memoryBlock
Property datas() As memoryBlock
End Class
End Project

See also:

Feedback, Comments & Corrections

The items on this page are in the following plugins: MBS USB Plugin.

MBS FileMaker tutorial videos