Xojo Conferences

Platforms to show: All Mac Windows Linux Cross-Platform

/USB/Mac and Win USB Example
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/Mac and Win USB Example
This example is the version from Sun, 24th Nov 2012.
Project "Mac and Win USB Example.rbp"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
End Class
Class Window1 Inherits Window
Const kDeviceName = "test"
Const kProductID = &h123
Const kVendorID = &h123
Control List Inherits Listbox
ControlInstance List Inherits Listbox
End Control
Control TextField1 Inherits TextField
ControlInstance TextField1 Inherits TextField
EventHandler Function KeyDown(Key As String) As Boolean if asc(key) = 13 or asc(key) = 3 then send Return true end if End EventHandler
End Control
Control Label1 Inherits Label
ControlInstance Label1 Inherits Label
End Control
EventHandler Sub Close() m.close End EventHandler
EventHandler Sub Open() #if TargetWin32 then dim Path as string dim devices(-1) as WindowsDeviceMBS = WindowsDeviceMBS.Devices for each d as WindowsDeviceMBS in devices if d.Description = kDeviceName then path = d.DevicePath end if next log "path: "+path w = new WinUSBMBS(path) log "Lasterror: "+str(w.Lasterror) if w.Lasterror <>0 then Return log "DeviceHandle: "+hex(w.DeviceHandle) log "PipePolicyMaximumTransferSize: "+str(w.PipePolicyMaximumTransferSize(&h82))+" "+str(w.PipePolicyMaximumTransferSize(1)) log "PipePolicyRawIO: "+str(w.PipePolicyRawIO(&h82))+" "+str(w.PipePolicyRawIO(1)) log "PipePolicyPipeTransferTimeout: "+str(w.PipePolicyPipeTransferTimeout(&h82))+" "+str(w.PipePolicyPipeTransferTimeout(1)) #elseif TargetMacOS then m = new MacUSBMBS m.ProductID = kProductID m.VendorID = kVendorID if m.Connect then log "Connected" else log "Failed to connect: "+str(m.LastError) end if #else break #endif End EventHandler
Protected Sub Send() dim s as string = TextField1.text #if TargetWin32 then if w.WritePipePacket(1, s) <= lenb(s) then log "Failed to write: "+str(w.LastError) else log "sent: "+s end if dim mem as MemoryBlock = w.ReadPipePacket(&h82) if mem<>Nil then dim t as string = mem 'log str(lenb(t))+" "+str(mem.size) log "Read: "+t 'log EncodeHex(t) end if #elseif TargetMacOS then if not m.WritePacket(1, s) then log "Failed to write: "+str(m.LastError) else log "sent: "+s end if dim mem as MemoryBlock = m.ReadPacket(2,64) if mem<>Nil then dim t as string = mem log "Read: "+t end if #else break #endif End Sub
Protected Sub log(s as string) list.AddRow s List.ScrollPosition = List.ListCount End Sub
Note "Notes"
This example was created for a client for a special device. For that we even added the Packet functions which are probably of no use for anyone else.
Property Protected m As MacUSBMBS
Property Protected w As WinUSBMBS
End Class
MenuBar MenuBar1
MenuItem FileMenu = "&Ablage"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Bearbeiten"
MenuItem EditUndo = "&Rückgängig"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "&Ausschneiden"
MenuItem EditCopy = "&Kopieren"
MenuItem EditPaste = "&Einfügen"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "&Alles auswählen"
End MenuBar
End Project

See also:

Feedback, Comments & Corrections

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

MBS Xojo Plugins