Xojo Conferences
MBSSep2018MunichDE
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Tools/SmartCard/SmartCard
Function:
Required plugins for this example: MBS Tools Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Tools/SmartCard/SmartCard
This example is the version from Fri, 20th Oct 2016.
Project "SmartCard.rbp"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
End Class
Class MainWindow Inherits Window
Control GroupMenu Inherits PopupMenu
ControlInstance GroupMenu Inherits PopupMenu
EventHandler Sub Change() dim groupname as string = me.Text dim devices() as string = context.Readers(array(groupname)) DeviceMenu.DeleteAllRows for each d as string in devices DeviceMenu.AddRow d next End EventHandler
End Control
Control Label1 Inherits Label
ControlInstance Label1 Inherits Label
End Control
Control Label2 Inherits Label
ControlInstance Label2 Inherits Label
End Control
Control DeviceMenu Inherits PopupMenu
ControlInstance DeviceMenu Inherits PopupMenu
EventHandler Sub Change() CheckConnect End EventHandler
End Control
Control ConnectButton Inherits PushButton
ControlInstance ConnectButton Inherits PushButton
EventHandler Sub Action() ConnectButton.Enabled = false dim DeviceName as string = DeviceMenu.Text card = context.Connect(DeviceName, SmartCardMBS.kShareShared, SmartCardMBS.kProtocolAny) if card <> nil then GroupMenu.Enabled = false DeviceMenu.Enabled = False QueryVersionButton.Enabled = true QuerySerialNoButton.Enabled = true QueryStatusButton.Enabled = true else MsgBox "Error: "+str(context.Lasterror) end if End EventHandler
End Control
Control QueryVersionButton Inherits PushButton
ControlInstance QueryVersionButton Inherits PushButton
EventHandler Sub Action() dim header as new memoryBlock(8) header.Int32Value(0) = 2 // T1 header.Int32Value(4) = 8 // size of this block dim command as new MemoryBlock(5) command.Int8Value(0) = 0 command.Int8Value(1) = &hCA command.Int8Value(2) = 1 command.Int8Value(3) = &h82 command.Int8Value(4) = 2 dim buffer as new MemoryBlock(512) dim ReceiveHeader as new MemoryBlock(8) dim RecvLength as UInt32 = 512 card.Transmit(header, command, command.Size, nil, buffer, RecvLength) if card.Lasterror = 0 then // MsgBox "Received "+str(RecvLength)+" bytes: " // C9039000 dim answer as string = buffer.StringValue(0, RecvLength) Select case answer.Left(4) case "C903" MsgBox "Version 53" case "C901" MsgBox "Version 50" else MsgBox EncodeHex(answer) end Select else MsgBox "Error: "+str(card.Lasterror) end if End EventHandler
End Control
Control QuerySerialNoButton Inherits PushButton
ControlInstance QuerySerialNoButton Inherits PushButton
EventHandler Sub Action() dim header as new memoryBlock(8) header.Int32Value(0) = 2 // T1 header.Int32Value(4) = 8 // size of this block dim command as new MemoryBlock(5) command.Int8Value(0) = 0 command.Int8Value(1) = &hCA command.Int8Value(2) = 1 command.Int8Value(3) = &h81 command.Int8Value(4) = 8 dim buffer as new MemoryBlock(512) dim ReceiveHeader as new MemoryBlock(8) dim RecvLength as UInt32 = 512 card.Transmit(header, command, command.Size, nil, buffer, RecvLength) if card.Lasterror = 0 then 'MsgBox "Received "+str(RecvLength)+" bytes: " // 020610BF000241429000 dim answer as string = buffer.StringValue(0, 8) MsgBox EncodeHex(answer) else MsgBox "Error: "+str(card.Lasterror) end if End EventHandler
End Control
Control QueryStatusButton Inherits PushButton
ControlInstance QueryStatusButton Inherits PushButton
EventHandler Sub Action() dim state as integer dim protocol as integer dim cardID as string card.Status(state, protocol, cardID) if card.Lasterror <> 0 then MsgBox "Error: "+str(card.Lasterror) else dim states() as string if BitwiseAnd(state, card.kCardStateAbsent) <> 0 then states.Append "absent" end if if BitwiseAnd(state, card.kCardStateNegotiable) <> 0 then states.Append "Negotiable" end if if BitwiseAnd(state, card.kCardStatePowered) <> 0 then states.Append "powered" else states.Append "not powered" end if if BitwiseAnd(state, card.kCardStatePresent) <> 0 then states.Append "present" end if if BitwiseAnd(state, card.kCardStateSpecific) <> 0 then states.Append "Specific" else states.Append "not Specific" end if if BitwiseAnd(state, card.kCardStateSwallowed) <> 0 then states.Append "Swallowed" end if if BitwiseAnd(state, card.kCardStateUnknown) <> 0 then states.Append "Unknown" end if dim protocolName as string Select case protocol case card.kProtocolT0 protocolName = "T0" case card.kProtocolT1 protocolName = "T1" case card.kProtocolRAW protocolName = "RAW" case card.kProtocolT15 protocolName = "T15" case card.kProtocolAny protocolName = "Any" case card.kProtocolUnset protocolName = "Unset" case card.kProtocolUndefined protocolName = "Undefined" else protocolName = "?" end Select MsgBox "State: "+Join(states,", ")+EndOfLine+"Protocol: "+protocolName+EndOfLine+"CardID: "+EncodeHex(cardID) end if End EventHandler
End Control
EventHandler Sub Open() context = new SmartCardContextMBS dim groups() as string = context.ReaderGroups GroupMenu.DeleteAllRows for each g as string in groups GroupMenu.AddRow g next dim devices() as string = context.Readers DeviceMenu.DeleteAllRows for each d as string in devices DeviceMenu.AddRow d next End EventHandler
Private Sub CheckConnect() if DeviceMenu.ListIndex >= 0 then ConnectButton.Enabled = true else ConnectButton.Enabled = false end if End Sub
Property Private card As SmartCardMBS
Property Private context As SmartCardContextMBS
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

Feedback, Comments & Corrections

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




Links
MBS FileMaker Plugins