Platforms to show: All Mac Windows Linux Cross-Platform
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 Thu, 30th Oct 2019.
Project "SmartCard.xojo_binary_project"
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
// pick first device
If DeviceMenu.ListCount = 1 Then
DeviceMenu.ListIndex = 0
End If
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
QuerySwiss.Enabled = true
QueryBelgian.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 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
Control QuerySwiss Inherits PushButton
ControlInstance QuerySwiss Inherits PushButton
EventHandler Sub Action()
Dim FileID1 As New MemoryBlock(2)
FileID1.UInt8Value(0) = &h2F
FileID1.UInt8Value(1) = &h06
dim FileID2 as new MemoryBlock(2)
FileID2.UInt8Value(0) = &h2F
FileID2.UInt8Value(1) = &h07
dim Data1 as MemoryBlock = card.ReadFile(FileID1)
dim Data2 as MemoryBlock = card.ReadFile(FileID2)
Dim dic1 As Dictionary = card.SplitValues(data1)
dim dic2 as Dictionary = card.SplitValues(data2)
dim list() as string
for each k as Variant in dic1.keys
list.Append k.StringValue + ": "+dic1.Value(k).StringValue
next
for each k as Variant in dic2.keys
list.Append k.StringValue + ": "+dic2.Value(k).StringValue
next
MsgBox Join(list, EndOfLine)
End EventHandler
End Control
Control QueryBelgian Inherits PushButton
ControlInstance QueryBelgian Inherits PushButton
EventHandler Sub Action()
// addressFile
If True Then
Dim FileID1 As New MemoryBlock(4)
FileID1.UInt8Value(0) = &hDF
FileID1.UInt8Value(1) = &h01
FileID1.UInt8Value(2) = &h40
FileID1.UInt8Value(3) = &h33
Dim Data1 As MemoryBlock = card.ReadFile(FileID1)
If Data1 <> Nil Then
Dim dic1 As Dictionary = card.SplitValues(data1)
Dim list() As String
For Each k As Variant In dic1.keys
Dim v As String = dic1.Value(k).StringValue
If InStr(v, ChrB(0)) > 0 Then
// contains zeros
v = EncodeHex(v)
Else
v = DefineEncoding(v, encodings.UTF8)
End If
list.Append k.StringValue + ": "+v
Next
MsgBox Join(list, EndOfLine)
End If
End If
// basicInfoFile
If True Then
Dim FileID2 As New MemoryBlock(4)
FileID2.UInt8Value(0) = &hDF
FileID2.UInt8Value(1) = &h01
FileID2.UInt8Value(2) = &h40
FileID2.UInt8Value(3) = &h31
Dim Data2 As MemoryBlock = card.ReadFile(FileID2)
If Data2 <> Nil Then
Dim dic2 As Dictionary = card.SplitValues(data2)
Dim list() As String
For Each k As Variant In dic2.keys
Dim v As String = dic2.Value(k).StringValue
If InStr(v, ChrB(0)) > 0 Then
// contains zeros
v = EncodeHex(v)
Else
v = DefineEncoding(v, encodings.UTF8)
End If
list.Append k.StringValue + ": "+v
Next
MsgBox Join(list, EndOfLine)
End If
End If
// idFile
If False Then
Dim FileID3 As New MemoryBlock(4)
FileID3.UInt8Value(0) = &hDF
FileID3.UInt8Value(1) = &h01
FileID3.UInt8Value(2) = &h40
FileID3.UInt8Value(3) = &h38
Dim Data3 As MemoryBlock = card.ReadFile(FileID3)
If Data3 <> Nil Then
Dim dic3 As Dictionary = card.SplitValues(data3)
Dim list() As String
For Each k As Variant In dic3.keys
Dim v As String = dic3.Value(k).StringValue
If InStr(v, ChrB(0)) > 0 Then
// contains zeros
v = EncodeHex(v)
Else
v = DefineEncoding(v, encodings.UTF8)
End If
list.Append k.StringValue + ": "+v
Next
MsgBox Join(list, EndOfLine)
End If
End If
// to get photo, use query with &h31 in ID
'FileID.UInt8Value(3) = &h31
// picture
If True Then
Dim FileID3 As New MemoryBlock(4)
FileID3.UInt8Value(0) = &hDF
FileID3.UInt8Value(1) = &h01
FileID3.UInt8Value(2) = &h40
FileID3.UInt8Value(3) = &h35
Dim Data3 As MemoryBlock = card.ReadFile(FileID3)
If Data3 <> Nil Then
Dim p As Picture = picture.FromData(data3)
If p <> Nil Then
Dim w As New PicWindow
w.Backdrop = p
w.show
End If
End If
End If
End EventHandler
End Control
Control Label3 Inherits Label
ControlInstance Label3 Inherits Label
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
// Pick first group
If GroupMenu.ListCount = 1 Then
GroupMenu.ListIndex = 0
End If
// pick first device
If DeviceMenu.ListCount = 1 Then
DeviceMenu.ListIndex = 0
End If
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
Class PicWindow Inherits Window
End Class
End Project
The items on this page are in the following plugins: MBS Tools Plugin.
