Magnetic strip reader and barcode scanner visual basic 6 modules source code.
'File globals.bas
Attribute VB_Name =
"globals"
Option Explicit
Public scans1, scans2, scan As String
Public sNewXlsFile As String
Public sXlsTemplate As String
'File USBDefs.bas
Attribute VB_Name =
"USBDefs"
Option Explicit
' Windows API definitions
'from setupapi.h
Public Const DIGCF_PRESENT = &H2
Public Const DIGCF_DEVICEINTERFACE = &H10
Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
'Modified
'09/17/03
'by Paul Deignan
Public Const GENERIC_NOACCESS = 0
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const FILE_FLAG_OVERLAPPED = &H40000000
Public Const ERROR_IO_PENDING = 997
Public Const ERROR_IO_INCOMPLETE = 996
'from winerror.h
Public Const ERROR_INSUFFICIENT_BUFFER = 122
'from winbase.h
Public Const INVALID_HANDLE_VALUE = &HFFFFFFFF
'from hidpi.h
Public Const HIDP_STATUS_SUCCESS = &H110000
'Typedef enum defines a set of integer constants for HidP_Report_Type
'Remember to declare these as integers
(16 bits)
Public Const HidP_Input = 0
Public Const HidP_Output = 1
Public Const HidP_Feature = 2
Public Const OPEN_EXISTING = 3
' Mag-Tek device definitions
Public Const MagTekVendorID = &H801
Public Const HIDMSRKeyBoardEmulProdID = &H1
Public Const HIDMSRVendDefProdID = &H2
Public Const InsertRdrProdID = &H3
'HID USB swipe reader usages
Public Const UPG_MSR = &HFF00
Public Const UID_DECODING_RDR = &H1
Public Const UID_TRACK_1_DECODE_STATUS = &H20
Public Const UID_TRACK_2_DECODE_STATUS = &H21
Public Const UID_TRACK_3_DECODE_STATUS = &H22
Public Const UID_TRACK_1_LEN = &H28
Public Const UID_TRACK_2_LEN = &H29
Public Const UID_TRACK_3_LEN = &H2A
Public Const UID_TRACK_1_DATA = &H30
Public Const UID_TRACK_2_DATA = &H31
Public Const UID_TRACK_3_DATA = &H32
Public Const UID_CARD_ENCODE_TYPE = &H38
Public Const UID_CARD_STATUS = &H39
' Card status bit
definitions
Public Const CS_CARD_INSERTED = &H1
'Decode status
Public Const DS_ERROR = &H1
'Card encode types
Public Const MSD_CET_ISO = 0
Public Const MSD_CET_AAMVA = 1
Public Const MSD_CET_CA = 2
Public Const MSD_CET_BLANK = 3
Public Const MSD_CET_OTHER = 4
Public Const MSD_CET_UNDETERMINED = 5
Public Const MSD_CET_NONE = 6
'Feature report indexes
Public Const FRI_CMD = 1
Public Const FRI_LEN = 2
Public Const FRI_DATA = 3
Public Const FRI_RC = 1
'Send command status
Public Const SCS_SUCCESS = 0
Public Const SCS_TRX_FAILED = 1
Public Const SCS_RCV_FAILED = 2
'******************************************************************************
'User-defined types for API calls,
listed alphabetically
'******************************************************************************
Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Public Type HIDD_ATTRIBUTES
Size As Long
VendorID As Integer
ProductID As Integer
VersionNumber As Integer
End Type
'Windows 98 DDK documentation is
incomplete.
'Use the structure defined in hidpi.h
Public Type HIDP_CAPS
Usage As Integer
UsagePage As Integer
InputReportByteLength As Integer
OutputReportByteLength As Integer
FeatureReportByteLength As Integer
Reserved(16) As Integer
NumberLinkCollectionNodes As Integer
NumberInputButtonCaps As Integer
NumberInputValueCaps As Integer
NumberInputDataIndices As Integer
NumberOutputButtonCaps As Integer
NumberOutputValueCaps As Integer
NumberOutputDataIndices As Integer
NumberFeatureButtonCaps As Integer
NumberFeatureValueCaps As Integer
NumberFeatureDataIndices As Integer
End Type
'If IsRange is false, UsageMin is Usage and UsageMax is unused.
'If IsStringRange is false, StringMin is StringIndex and StringMax is unused.
'If IsDesignatorRange is false, DesignatorMin is DesignatorIndex and DesignatorMax is unused.
Public Type HIDP_VALUE_CAPS
UsagePage As Integer
ReportID As Byte
' IsAlias As Byte
BitField As Integer
LinkCollection As Integer
LinkUsage As Integer
LinkUsagePage As Integer
IsRange As Byte
IsStringRange As Byte
IsDesignatorRange As Byte
IsAbsolute As Byte
HasNull As Byte
Reserved1 As Byte
BitSize As Integer
ReportCount As Integer
Reserved2 As Integer
Reserved3 As Integer
Reserved4 As Integer
Reserved5 As Integer
Reserved6 As Integer
UnitsExp As Long
Units As Long
LogicalMin As Long
LogicalMax As Long
PhysicalMin As Long
PhysicalMax As Long
UsageMin As Integer
UsageMax As Integer
StringMin As Integer
StringMax As Integer
DesignatorMin As Integer
DesignatorMax As Integer
DataIndexMin As Integer
DataIndexMax As Integer
End Type
Public Type SP_DEVICE_INTERFACE_DATA
cbSize As Long
InterfaceClassGuid As GUID
Flags As Long
Reserved As Long
End Type
Public Type SP_DEVICE_INTERFACE_DETAIL_DATA
cbSize As Long
DevicePath As Byte
End Type
Public Type OVER_LAPPED
Internal As Long
InternalHigh As Long
Offset As Long
OffsetHigh As Long
hEvent As Long
End Type
'Modified
'09/17/03
'by Paul Deignan
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
'******************************************************************************
'API functions, listed alphabetically
'******************************************************************************
Public Declare Function CloseHandle _
Lib "kernel32" _
(ByVal hObject As Long) _
As Long
'Modified
'09/17/03
'by Paul Deignan
'added lpSecurityAttributes as SECURITY_ATTRIBUTES
Public Declare Function CreateFile _
Lib "kernel32" _
Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) _
As Long
Public Declare Function FormatMessage _
Lib "kernel32" _
Alias "FormatMessageA" _
(ByVal dwFlags As Long, _
ByRef lpSource As Any, _
ByVal dwMessageId As Long, _
ByVal dwLanguageZId As Long, _
ByVal lpBuffer As String, _
ByVal nSize As Long, _
ByVal Arguments As Long)
_
As Long
Public Declare Function HidD_FreePreparsedData _
Lib "hid.dll" _
(ByVal PreparsedData As Long) _
As Long
Public Declare Function HidD_GetAttributes _
Lib "hid.dll" _
(ByVal HidDeviceObject As Long, _
ByRef Attributes As HIDD_ATTRIBUTES) _
As Byte
Public Declare Sub HidD_GetHidGuid _
Lib "hid.dll" _
(ByRef HidGuid As GUID)
Public Declare Function HidD_GetPreparsedData _
Lib "hid.dll" _
(ByVal HidDeviceObject As Long, _
ByRef PreparsedData As Long) _
As Byte
Public Declare Function HidP_GetCaps _
Lib "hid.dll" _
(ByVal PreparsedData As Long, _
ByRef Capabilities As HIDP_CAPS) _
As Long
Public Declare Function HidP_GetValueCaps _
Lib "hid.dll" _
(ByVal ReportType As Integer, _
ByRef ValueCaps As HIDP_VALUE_CAPS, _
ByRef ValueCapsLength As Integer, _
ByVal PreparsedData As Long) _
As Long
Public Declare Function HidP_GetSpecificValueCaps _
Lib "hid.dll" _
(ByVal ReportType As Integer, _
ByVal UsagePage As Integer, _
ByVal LinkCollection As Integer, _
ByVal Usage As Integer,
_
ByRef ValueCaps As HIDP_VALUE_CAPS, _
ByRef ValueCapsLength As Integer, _
ByVal PreparsedData As Long) _
As Long
Public Declare Function lstrcpy _
Lib "kernel32" _
Alias "lstrcpyA" _
(ByVal dest As String, _
ByVal source As Long) _
As String
Public Declare Function lstrlen _
Lib "kernel32" _
Alias "lstrlenA" _
(ByVal source As Long) _
As Long
Public Declare Function ReadFile _
Lib "kernel32" _
(ByVal hFile As Long, _
ByRef lpBuffer As Byte, _
ByVal nNumberOfBytesToRead As Long, _
ByRef lpNumberOfBytesRead As Long, _
ByRef lpOverlapped As OVER_LAPPED) _
As Long
Public Declare Function RtlMoveMemory _
Lib "kernel32" _
(dest As Any, _
src As Any, _
ByVal Count As Long)
_
As Long
Public Declare Function SetupDiCreateDeviceInfoList _
Lib "setupapi.dll" _
(ByRef ClassGuid As GUID, _
ByVal hwndParent As Long) _
As Long
Public Declare Function SetupDiDestroyDeviceInfoList _
Lib "setupapi.dll" _
(ByVal DeviceInfoSet As Long) _
As Long
Public Declare Function SetupDiEnumDeviceInterfaces _
Lib "setupapi.dll" _
(ByVal DeviceInfoSet As Long, _
ByVal DeviceInfoData As Long, _
ByRef InterfaceClassGuid As GUID, _
ByVal MemberIndex As Long, _
ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA) _
As Long
Public Declare Function SetupDiGetClassDevs _
Lib "setupapi.dll" _
Alias "SetupDiGetClassDevsA" _
(ByRef ClassGuid As GUID, _
ByVal Enumerator As String,
_
ByVal hwndParent As Long, _
ByVal Flags As Long) _
As Long
Public Declare Function SetupDiGetDeviceInterfaceDetail _
Lib "setupapi.dll" _
Alias "SetupDiGetDeviceInterfaceDetailA" _
(ByVal DeviceInfoSet As Long, _
ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA, _
ByVal DeviceInterfaceDetailData As Long, _
ByVal DeviceInterfaceDetailDataSize As Long, _
ByRef RequiredSize As Long, _
ByVal DeviceInfoData As Long) _
As Long
Public Declare Function WriteFile _
Lib "kernel32" _
(ByVal hFile As Long, _
ByRef lpBuffer As Byte, _
ByVal nNumberOfBytesToWrite As Long, _
ByRef lpNumberOfBytesWritten As Long, _
ByVal lpOverlapped As Long) _
As Long
Public Declare Function CancelIo _
Lib "kernel32" _
(ByVal hFile As Long) _
As Long
Public Declare Function GetOverlappedResult _
Lib "kernel32" _
(ByVal hFile As Long, _
ByRef lpOverlapped As OVER_LAPPED, _
ByRef lpNumberOfBytesRead As Long, _
ByVal bWait As Long) _
As Long
Public Declare Function CreateEvent _
Lib "kernel32" _
Alias "CreateEventA" _
(ByVal lpEventAttributes As Long, _
ByVal bManualReset As Long, _
ByVal bInitialState As Long, _
ByVal lpName As Long) _
As Long
Public Declare Function ResetEvent _
Lib "kernel32" _
(ByVal hEvent As Long) _
As Long
Public Declare Function HidP_GetUsageValue _
Lib "hid.dll" _
(ByVal ReportType As Integer, _
ByVal UsagePage As Integer, _
ByVal LinkCollection As Integer, _
ByVal Usage As Integer,
_
ByRef UsageValue As Long, _
ByVal PreparsedData As Long, _
ByRef Report As Byte,
_
ByVal ReportLength As Long) _
As Long
Public Declare Function HidP_GetUsageValueArray _
Lib "hid.dll" _
(ByVal ReportType As Integer, _
ByVal UsagePage As Integer, _
ByVal LinkCollection As Integer, _
ByVal Usage As Integer,
_
ByRef UsageValue As Byte, _
ByVal UsageValueByteLength As Integer, _
ByVal PreparsedData As Long, _
ByRef Report As Byte,
_
ByVal ReportLength As Long) _
As Long
Public Declare Function HidD_GetFeature _
Lib "hid.dll" _
(ByVal HidDeviceObject As Long, _
ByRef ReportBuffer As Byte, _
ByVal ReportBufferLength As Long) _
As Byte
Public Declare Function HidD_SetFeature _
Lib "hid.dll" _
(ByVal HidDeviceObject As Long, _
ByRef ReportBuffer As Byte, _
ByVal ReportBufferLength As Long) _
As Byte
'File USBIO.bas
Attribute VB_Name =
"USBIO"
Option Explicit
Public FatalError As String
Public HidDevice As Long
Dim PreparsedData As Long
Public Capabilities As HIDP_CAPS
Dim hEventObject As Long
Dim ReadPending As Boolean
Dim Overlapped As OVER_LAPPED
Dim NumberOfBytesRead As Long
Dim ReadBuffer() As Byte
Dim Tk1Data() As Byte
Dim Tk2Data() As Byte
Dim Tk3Data() As Byte
Dim Tk1RptDataLen As Integer
Dim Tk2RptDataLen As Integer
Dim Tk3RptDataLen As Integer
Public Tk1DcdSts As Long
Public Tk2DcdSts As Long
Public Tk3DcdSts As Long
Public Tk1Len As Long
Public Tk2Len As Long
Public Tk3Len As Long
Public CrdEcdTyp As Long
Public Tk1DataStr As String
Public Tk2DataStr As String
Public Tk3DataStr As String
Public FtrRptTrxBfr() As Byte
Public FtrRptRcvBfr() As Byte
Public SendCmdSts As Byte
Public DeviceAttributes As HIDD_ATTRIBUTES
Public CardSts As Long
Public Security As SECURITY_ATTRIBUTES
Public Sub DetectDevice()
'Modified
'09/17/03
'by Paul Deignan
'Tries to CreateFile Read/Write first - if that fails creates file with NoAccess
'to deal with
Keyboard Emulation under XP and 2K.
'Windows XP and 2K opens all keyboards and mice exclusively
'with a CreateFile call of its own so all subsequent CreateFile calls
'for read or
write access fail.
'Feature reports still work with NoAccess because they are sent through HID API function.
'Makes a series of API
calls to locate the desired HID-class device.
Dim HidGuid As GUID
Dim DeviceInfoSet As Long
Dim Result As Long
Dim MemberIndex As Long
Dim MyDeviceInterfaceData As SP_DEVICE_INTERFACE_DATA
Dim LastDevice As Boolean
Dim RequiredSize As Long
Dim DumRequiredSize As Long
Dim MyDeviceInterfaceDetailData As SP_DEVICE_INTERFACE_DETAIL_DATA
Dim DetailDataBuffer() As Byte
Dim DevicePathName As String
'******************************************************************************
'HidD_GetHidGuid
'Get the GUID for all system HIDs.
'Returns: the GUID in HidGuid.
'******************************************************************************
Call HidD_GetHidGuid(HidGuid)
'******************************************************************************
'SetupDiGetClassDevs
'Returns: a handle to a device
information set for all installed devices.
'Requires: the HidGuid returned in GetHidGuid.
'******************************************************************************
DeviceInfoSet = SetupDiGetClassDevs _
(HidGuid, _
vbNullString, _
0, _
(DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE))
If DeviceInfoSet =
INVALID_HANDLE_VALUE Then
Exit Sub
End If
'******************************************************************************
'SetupDiEnumDeviceInterfaces
'On return, MyDeviceInterfaceData contains the handle to a
'SP_DEVICE_INTERFACE_DATA
structure for a detected device.
'Requires:
'the DeviceInfoSet returned in SetupDiGetClassDevs.
'the HidGuid returned in GetHidGuid.
'An index to specify a
device.
'******************************************************************************
LastDevice = False
MemberIndex = 0
Do
'The cbSize element of the MyDeviceInterfaceData structure must be set to
'the structure's size in bytes.
MyDeviceInterfaceData.cbSize = LenB(MyDeviceInterfaceData)
Result = SetupDiEnumDeviceInterfaces _
(DeviceInfoSet, _
0, _
HidGuid, _
MemberIndex, _
MyDeviceInterfaceData)
If Result = 0 Then
LastDevice = True
Else
'******************************************************************************
'SetupDiGetDeviceInterfaceDetail
'Returns: an SP_DEVICE_INTERFACE_DETAIL_DATA structure
'containing information about a
device.
'To retrieve the information, call this function twice.
'The first time returns the size of the structure in RequiredSize.
'The second time returns a pointer to the data in DeviceInfoSet.
'Requires:
'A DeviceInfoSet returned by SetupDiGetClassDevs and
'an SP_DEVICE_INTERFACE_DATA
structure returned by SetupDiEnumDeviceInterfaces.
'*******************************************************************************
Result = SetupDiGetDeviceInterfaceDetail _
(DeviceInfoSet, _
MyDeviceInterfaceData, _
0,
_
0,
_
RequiredSize, _
0)
If Result = 0 And Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then
'Store the
structure's size.
MyDeviceInterfaceDetailData.cbSize = _
Len(MyDeviceInterfaceDetailData)
'Use a byte array to allocate memory for
'the MyDeviceInterfaceDetailData structure
ReDim DetailDataBuffer(RequiredSize)
'Store cbSize in the first four bytes of the array.
Call RtlMoveMemory _
(DetailDataBuffer(0), _
MyDeviceInterfaceDetailData, _
4)
'Call SetupDiGetDeviceInterfaceDetail again.
'This time, pass the address of the first element of DetailDataBuffer
'and the returned required buffer
size in DetailData.
Result = SetupDiGetDeviceInterfaceDetail _
(DeviceInfoSet, _
MyDeviceInterfaceData, _
VarPtr(DetailDataBuffer(0)), _
RequiredSize, _
DumRequiredSize, _
0)
'Convert the byte array to a string.
DevicePathName = CStr(DetailDataBuffer())
'Convert to Unicode.
DevicePathName = StrConv(DevicePathName, vbUnicode)
'Strip cbSize (4 bytes) from the
beginning.
DevicePathName = Right$(DevicePathName, Len(DevicePathName) - 4)
'******************************************************************************
'CreateFile
'Returns: a handle that enables reading and writing to the
device.
'Requires:
'The DevicePathName returned by SetupDiGetDeviceInterfaceDetail.
'******************************************************************************
'Modified
'09/17/03
'by Paul Deignan
'Values for SECURITY_ATTRIBUTES structure:
Security.lpSecurityDescriptor = 0
Security.bInheritHandle = True
Security.nLength = Len(Security)
'Modified
'09/17/03
'by Paul Deignan
'Try to open Read/Write first - This will fail on XP/2K on the KB
Emulation
HidDevice = CreateFile _
(DevicePathName, _
GENERIC_READ Or GENERIC_WRITE, _
(FILE_SHARE_READ Or FILE_SHARE_WRITE), _
Security, _
OPEN_EXISTING, _
FILE_FLAG_OVERLAPPED, _
0)
'Modified
'09/17/03
'by Paul Deignan
'If the above CreateFile failed -
try to open with NoAccess
If HidDevice =
INVALID_HANDLE_VALUE Then
HidDevice = CreateFile _
(DevicePathName, _
GENERIC_NOACCESS, _
(FILE_SHARE_READ Or FILE_SHARE_WRITE), _
Security, _
OPEN_EXISTING, _
FILE_FLAG_OVERLAPPED, _
0)
End If
If HidDevice <>
INVALID_HANDLE_VALUE Then
'Now we can find out if it's the device we're
looking for.
'******************************************************************************
'HidD_GetAttributes
'Requests information from
the device.
'Requires: The handle
returned by CreateFile.
'Returns: an HIDD_ATTRIBUTES structure
containing
'the Vendor ID, Product ID, and Product Version Number.
'Use this information to determine if the
detected device
'is the one we're
looking for.
'******************************************************************************
'Set the Size property to the number of bytes
in the structure.
DeviceAttributes.Size = LenB(DeviceAttributes)
If HidD_GetAttributes(HidDevice, DeviceAttributes) Then
If DeviceAttributes.VendorID = MagTekVendorID And _
(DeviceAttributes.ProductID = HIDMSRVendDefProdID Or _
DeviceAttributes.ProductID = HIDMSRKeyBoardEmulProdID Or _
DeviceAttributes.ProductID = InsertRdrProdID) Then
If HidD_GetPreparsedData(HidDevice, PreparsedData) Then
'******************************************************************************
'HidP_GetCaps
'Find out the device's capabilities.
'For standard devices such as joysticks, you can find out
the specific
'capabilities of the device.
'For
a custom device, the software will probably know what the device is capable of,
'so this call only verifies the
information.
'Requires: The pointer to a buffer containing the
information.
'The pointer is returned by HidD_GetPreparsedData.
'Returns: a Capabilites structure
containing the information.
'******************************************************************************
Result = HidP_GetCaps _
(PreparsedData, _
Capabilities)
If Result = HIDP_STATUS_SUCCESS Then
' If Capabilities.Usage <> UID_DECODING_RDR Or Capabilities.UsagePage <> UPG_MSR Then
' CloseDevice
' End If
Else
CloseDevice
End If
Else
CloseDevice
End If
Else
CloseDevice
End If
Else
CloseDevice
End If
End If
End If
End If
MemberIndex = MemberIndex + 1
Loop Until (LastDevice = True) Or (HidDevice <> INVALID_HANDLE_VALUE)
Result = SetupDiDestroyDeviceInfoList _
(DeviceInfoSet)
End Sub
Public Sub CloseDevice()
'closes the
device properly
Dim Result As Long
If HidDevice <>
INVALID_HANDLE_VALUE Then
If ReadPending Then
ReadPending = False
Result = CancelIo(HidDevice)
End If
Result = CloseHandle(HidDevice)
HidDevice = INVALID_HANDLE_VALUE
End If
If PreparsedData <> 0 Then
Result = HidD_FreePreparsedData(PreparsedData)
PreparsedData = 0
End If
End Sub
Public Sub InitUSB()
'Initializes USB data
FatalError = ""
HidDevice = INVALID_HANDLE_VALUE
PreparsedData = 0
hEventObject = CreateEvent(0,
1, 0, 0)
If hEventObject = 0 Then
FatalError = "CreateEvent Failed"
End If
ReadPending = False
End Sub
Public Sub CloseUSB()
' closes the USB communication
session properly
Dim Result As Long
If hEventObject <> 0 Then
Result = CloseHandle(hEventObject)
End If
End Sub
Public Function ReadInputRpt() As Boolean
'Reads the input
report if one is available.
'The device only sends an input report
when a card is swiped.
'Therefore, to avoid having the ReadFile()
call lock up the application while waiting
'for a card to
be swiped, overlapped IO should be used as shown.
'This routine should be called
periodically. A good way to do this is
using a timer.
Dim Result As Long
ReadInputRpt = False
If ReadPending Then
'A read was already started so check to
see if it has completed yet.
If GetOverlappedResult _
(HidDevice, _
Overlapped, _
NumberOfBytesRead, _
0) =
0 Then
'The read hasn't completed yet.
If Err.LastDllError <> ERROR_IO_INCOMPLETE Then
'Something went wrong with the read
'Maybe the device was unplugged
CloseDevice
End If
Else
'The read has completed.
ReadPending = False
ReadInputRpt = True
End If
Else
'No read is pending so we will start a
new one.
'Do overlapped IO setup
If ResetEvent(hEventObject) = 0 Then
FatalError = "ResetEvent Failed"
Exit Function
End If
Overlapped.hEvent = hEventObject
Overlapped.Internal = 0
Overlapped.InternalHigh = 0
Overlapped.Offset = 0
Overlapped.OffsetHigh = 0
'Start the read
If ReadFile _
(HidDevice, _
ReadBuffer(0),
_
CLng(Capabilities.InputReportByteLength),
_
NumberOfBytesRead, _
Overlapped) = 0 Then
'The read did not complete yet
If Err.LastDllError =
ERROR_IO_PENDING Then
'The read is pending
'We are waiting on an input report to
be sent from the device
'A report will only be sent when a card
is swiped
ReadPending = True
Else
'Something went wrong with the read
'Maybe the device was unplugged
CloseDevice
End If
Else
'The read completed allready.
ReadInputRpt = True
End If
End If
End Function
Public Function GetMSRResults() As Boolean
'Extracts the magnetic stripe read
results from the HID report and places the data
'into specific
variables
'This routine uses the HID API to
extract the data from the HID report.
'This is the recommended way of
extracting the data. Using the HID API
to extract
'the data
allows the HID report data to be reordered with no affect on the
'application.
'
'If the exact data format of the HID
report is known, then the application could
'manually extract the data from its specific locations in the HID report without
'using the HID
API calles.
'However, this is not recommended
because if the data format of the HID report
'changes then
the application will no longer work correctly.
Dim TkDataIndex As Integer
GetMSRResults = False
If HidP_GetUsageValue _
(HidP_Input, _
UPG_MSR, _
0, _
UID_TRACK_1_DECODE_STATUS, _
Tk1DcdSts, _
PreparsedData, _
ReadBuffer(0),
_
CLng(Capabilities.InputReportByteLength))
<> HIDP_STATUS_SUCCESS _
Then
FatalError = "HidP_GetUsageValue Failed on Tk1DcdSts"
Exit Function
End If
If HidP_GetUsageValue _
(HidP_Input, _
UPG_MSR, _
0, _
UID_TRACK_2_DECODE_STATUS, _
Tk2DcdSts, _
PreparsedData, _
ReadBuffer(0),
_
CLng(Capabilities.InputReportByteLength))
<> HIDP_STATUS_SUCCESS _
Then
FatalError = "HidP_GetUsageValue Failed on Tk2DcdSts"
Exit Function
End If
If HidP_GetUsageValue _
(HidP_Input, _
UPG_MSR, _
0, _
UID_TRACK_3_DECODE_STATUS, _
Tk3DcdSts, _
PreparsedData, _
ReadBuffer(0),
_
CLng(Capabilities.InputReportByteLength))
<> HIDP_STATUS_SUCCESS _
Then
FatalError = "HidP_GetUsageValue Failed on Tk3DcdSts"
Exit Function
End If
If HidP_GetUsageValue _
(HidP_Input, _
UPG_MSR, _
0, _
UID_TRACK_1_LEN, _
Tk1Len, _
PreparsedData, _
ReadBuffer(0),
_
CLng(Capabilities.InputReportByteLength))
<> HIDP_STATUS_SUCCESS _
Then
FatalError = "HidP_GetUsageValue Failed on Tk1Len"
Exit Function
End If
If HidP_GetUsageValue _
(HidP_Input, _
UPG_MSR, _
0, _
UID_TRACK_2_LEN, _
Tk2Len, _
PreparsedData, _
ReadBuffer(0),
_
CLng(Capabilities.InputReportByteLength))
<> HIDP_STATUS_SUCCESS _
Then
FatalError = "HidP_GetUsageValue Failed on Tk2Len"
Exit Function
End If
If HidP_GetUsageValue _
(HidP_Input, _
UPG_MSR, _
0, _
UID_TRACK_3_LEN, _
Tk3Len, _
PreparsedData, _
ReadBuffer(0),
_
CLng(Capabilities.InputReportByteLength))
<> HIDP_STATUS_SUCCESS _
Then
FatalError = "HidP_GetUsageValue Failed on Tk3Len"
Exit Function
End If
If HidP_GetUsageValueArray _
(HidP_Input, _
UPG_MSR, _
0, _
UID_TRACK_1_DATA, _
Tk1Data(0), _
Tk1RptDataLen, _
PreparsedData, _
ReadBuffer(0),
_
CLng(Capabilities.InputReportByteLength))
<> HIDP_STATUS_SUCCESS _
Then
FatalError = "HidP_GetUsageValueArray Failed on Tk1Data"
Exit Function
End If
Tk1DataStr = ""
For TkDataIndex = 1 To Tk1Len
Tk1DataStr = Tk1DataStr & Chr(Tk1Data(TkDataIndex - 1))
Next
If HidP_GetUsageValueArray _
(HidP_Input, _
UPG_MSR, _
0, _
UID_TRACK_2_DATA, _
Tk2Data(0), _
Tk2RptDataLen, _
PreparsedData, _
ReadBuffer(0),
_
CLng(Capabilities.InputReportByteLength))
<> HIDP_STATUS_SUCCESS _
Then
FatalError = "HidP_GetUsageValueArray Failed on Tk2Data"
Exit Function
End If
Tk2DataStr = ""
For TkDataIndex = 1 To Tk2Len
Tk2DataStr = Tk2DataStr & Chr(Tk2Data(TkDataIndex - 1))
Next
If HidP_GetUsageValueArray _
(HidP_Input, _
UPG_MSR, _
0, _
UID_TRACK_3_DATA, _
Tk3Data(0), _
Tk3RptDataLen,
_
PreparsedData, _
ReadBuffer(0),
_
CLng(Capabilities.InputReportByteLength))
<> HIDP_STATUS_SUCCESS _
Then
FatalError = "HidP_GetUsageValueArray Failed on Tk3Data"
Exit Function
End If
Tk3DataStr
= ""
For TkDataIndex = 1 To Tk3Len
Tk3DataStr = Tk3DataStr & Chr(Tk3Data(TkDataIndex - 1))
Next
If HidP_GetUsageValue _
(HidP_Input, _
UPG_MSR, _
0, _
UID_CARD_ENCODE_TYPE, _
CrdEcdTyp, _
PreparsedData, _
ReadBuffer(0),
_
CLng(Capabilities.InputReportByteLength))
<> HIDP_STATUS_SUCCESS _
Then
FatalError = "HidP_GetUsageValue Failed on CrdEcdTyp"
Exit Function
End If
If DeviceAttributes.ProductID = InsertRdrProdID Then
If HidP_GetUsageValue _
(HidP_Input, _
UPG_MSR, _
0, _
UID_CARD_STATUS, _
CardSts, _
PreparsedData, _
ReadBuffer(0),
_
CLng(Capabilities.InputReportByteLength))
<> HIDP_STATUS_SUCCESS _
Then
FatalError = "HidP_GetUsageValue Failed on CardSts"
Exit Function
End If
End If
GetMSRResults = True
End Function
Public Sub InitRead()
'Gets the lengths of the individual track data from the HID report using HID API calls.
'If these lengths are known they could
be hard coded but it is not recommended because
'then a
different device with different track data lengths would not work with the
'application.
Dim ValueCaps As HIDP_VALUE_CAPS
Dim NumberInputValueCaps As Integer
Dim Result As Long
ReDim ReadBuffer(Capabilities.InputReportByteLength - 1)
NumberInputValueCaps = 1
Result = HidP_GetSpecificValueCaps _
(HidP_Input, _
UPG_MSR,
_
0, _
UID_TRACK_1_DATA, _
ValueCaps, _
NumberInputValueCaps, _
PreparsedData)
If Result <> HIDP_STATUS_SUCCESS Then
FatalError = Hex(Result) & " HidP_GetSpecificValueCaps Failed on Track 1 data usage"
Exit Sub
End If
If NumberInputValueCaps = 1 Then
Tk1RptDataLen = ValueCaps.ReportCount
Else
FatalError = "HidP_GetSpecificValueCaps Failed to find Track 1 data
usage"
Exit Sub
End If
NumberInputValueCaps = 1
If HidP_GetSpecificValueCaps _
(HidP_Input, _
UPG_MSR,
_
0, _
UID_TRACK_2_DATA, _
ValueCaps, _
NumberInputValueCaps, _
PreparsedData) <> HIDP_STATUS_SUCCESS Then
FatalError = "HidP_GetSpecificValueCaps Failed on Track 2 data
usage"
Exit Sub
End If
If NumberInputValueCaps = 1 Then
Tk2RptDataLen = ValueCaps.ReportCount
Else
FatalError = "HidP_GetSpecificValueCaps Failed to find Track 2 data
usage"
Exit Sub
End If
NumberInputValueCaps = 1
If HidP_GetSpecificValueCaps _
(HidP_Input, _
UPG_MSR,
_
0, _
UID_TRACK_3_DATA, _
ValueCaps, _
NumberInputValueCaps, _
PreparsedData) <> HIDP_STATUS_SUCCESS Then
FatalError = "HidP_GetSpecificValueCaps Failed on Track 3 data
usage"
Exit Sub
End If
If NumberInputValueCaps = 1 Then
Tk3RptDataLen = ValueCaps.ReportCount
Else
FatalError = "HidP_GetSpecificValueCaps Failed to find Track 3 data
usage"
Exit Sub
End If
' Tk1RptDataLen = 110
' Tk2RptDataLen = 110
' Tk3RptDataLen = 110
ReDim Tk1Data(Tk1RptDataLen
- 1)
ReDim Tk2Data(Tk2RptDataLen
- 1)
ReDim Tk3Data(Tk3RptDataLen
- 1)
End Sub
Public Function GetCardEncodeTypeStr(ByVal CardEncodeType As Byte) As String
' translates the card encode type
into a string
Select Case CardEncodeType
Case MSD_CET_ISO
GetCardEncodeTypeStr = "ISO"
Case MSD_CET_AAMVA
GetCardEncodeTypeStr = "AAMVA"
Case MSD_CET_CA
GetCardEncodeTypeStr = "CADL"
Case MSD_CET_BLANK
GetCardEncodeTypeStr = "BLANK"
Case MSD_CET_OTHER
GetCardEncodeTypeStr = "OTHER"
Case MSD_CET_UNDETERMINED
GetCardEncodeTypeStr = "UNDETERMINED"
Case MSD_CET_NONE
GetCardEncodeTypeStr = "NONE"
Case Else ' this condition should not occur
GetCardEncodeTypeStr = ""
End Select
End Function
Public Sub InitCmd()
'Initialize the command variables
'Capabilities.FeatureReportByteLength is 1 longer than feature report
'The first byte of the feature report
buffer holds the report id
ReDim FtrRptTrxBfr(Capabilities.FeatureReportByteLength - 1)
ReDim FtrRptRcvBfr(Capabilities.FeatureReportByteLength - 1)
End Sub
Public Sub SendCmd()
'Sends a command to
the device and recieves the response.
'Commands are sent and received using
feature reports.
Dim FtrRptIndex As Long
SendCmdSts = SCS_SUCCESS
' send request to device
' The HidD_SetFeature()
function will not successfully return until the request
' is completed and the
device is ready to send a response
If HidD_SetFeature _
(HidDevice, _
FtrRptTrxBfr(0),
_
Capabilities.FeatureReportByteLength) <> 1 Then
SendCmdSts = SCS_TRX_FAILED
CloseDevice ' maybe the device
was unplugged
Exit Sub
End If
' initialize response buffer to
make HidD_GetFeature() happy
For FtrRptIndex = 1 To Capabilities.FeatureReportByteLength
FtrRptRcvBfr(FtrRptIndex - 1) = 0
Next
' get response from device
If HidD_GetFeature _
(HidDevice, _
FtrRptRcvBfr(0),
_
Capabilities.FeatureReportByteLength) <> 1 Then
SendCmdSts = SCS_RCV_FAILED
CloseDevice ' maybe the device
was unplugged
Exit Sub
End If
End Sub