XProfan

cls
importdll("Winscard.dll", "")
def %NULL 0
def %SCARD_SCOPE_USER 0
def %SCARD_SHARE_SHARED 2
def %SCARD_AUTOALLOCATE -1
def %SCARD_LEAVE_CARD 0
def %SCARD_PROTOCOL_T0 1
def %SCARD_PROTOCOL_T1 2
Struct SCARD_IO_REQUEST = dwProtocol&, cbPciLength&
declare memory SCARD_PCI_T0, SCARD_PCI_T1
Dim SCARD_PCI_T0, SCARD_IO_REQUEST
SCARD_PCI_T0.dwProtocol& = %SCARD_PROTOCOL_T0
SCARD_PCI_T0.cbPciLength& = SizeOf(SCARD_PCI_T0)
Dim SCARD_PCI_T1, SCARD_IO_REQUEST
SCARD_PCI_T1.dwProtocol& = %SCARD_PROTOCOL_T1
SCARD_PCI_T1.cbPciLength& = SizeOf(SCARD_PCI_T1)
declare lever hContext, hCard/* Resource manager Context *//* Verbindug to Smartcard */
declare pointer pReaders, pSendPci/* list the Lesegeräte */
declare memory mResponse/* response the ticket */
declare int dwReaders, dwProtocol, dwRecv/* length of pReaders *//* Verwendetes log *//* length the response */
declare string reader/* Gewählter reader */
dim mResponse, 255
// Resource manager Context create
err "SCardEstablishContext", SCardEstablishContext(%SCARD_SCOPE_USER, %NULL, %NULL, ADDR(hContext))
// list the available Kartenleser
dwReaders = %SCARD_AUTOALLOCATE
err "SCardListReaders", SCardListReadersA(hContext, %NULL, ADDR(pReaders), ADDR(dwReaders))
// name the To verwendenden Lesers
var string rdrSel = "SCM Microsystems"
// reader search
print "Gefundene Kartenleser:"
var int offs = 0
declare string crdr// Aktueller Listeneintrag

while (dwReaders - offs)

    crdr = String $(pReaders, offs)// Listeneintrag reading
    casenot len(crdr) : break// end access
    offs = offs + len(crdr) + 1// Offset for nachsten entry
    // Verify whether gewählter reader

    if lower$(left$(crdr, len(rdrSel))) = lower$(rdrSel)

        reader = crdr
        print "*", crdr

    else

        print " ", crdr

    endif

endwhile

// list enable
err "SCardFreeMemory", SCardFreeMemory(hContext, pReaders)

if reader = ""

    MessageBox "Kartenleser not found!", "", 0
    end

endif

print
print "Verwende Kartenleser:", reader
print
// link with ticket produce
err "SCardConnect", SCardConnectA(hContext, reader, %SCARD_SHARE_SHARED, %SCARD_PROTOCOL_T0 | %SCARD_PROTOCOL_T1, ADDR(hCard), ADDR(dwProtocol))

if dwProtocol = %SCARD_PROTOCOL_T0

    pSendPci = SCARD_PCI_T0

else

    pSendPci = SCARD_PCI_T1

endif

// communication with ticket
dwRecv = scTransmit("00 A4 04 00 07 D2 76 00 00 85 01 01 00", mResponse)// NDEF Applet dial
dwRecv = scTransmit("00 A4 00 0C 02 E1 04", mResponse)// File with NDEF Message dial
dwRecv = scTransmit("00 B0 00 00 00", mResponse)// File reading
// OTP from Message
var string ndef = string $(mResponse, 25)
ndef = mid$(ndef, 1, len(ndef) - 1)
// OTP spend and Clipboard
print "OTP:", ndef
ClearClip
PutClip ndef
// link separate
err "SCardDisconnect", SCardDisconnect(hCard, %SCARD_LEAVE_CARD)
// Resource manager Context enable
err "SCardReleaseContext", SCardReleaseContext(hContext)
dispose SCARD_PCI_T0
dispose SCARD_PCI_T1
waitend
// commands on ticket Send

proc scTransmit

    Parameters string hexApdu, memory response
    hexApdu = translate $(hexApdu, " ", "")

    if (len(hexApdu) mod 2)

        MessageBox "Ungültiger Hex String", "", 0
        end

    endif

    declare memory apdu
    dim apdu, len(hexApdu)/2
    declare int i
    for i, 0, (len(hexApdu)/2) - 1
    byte apdu, i = val("$" + mid$(hexApdu, 1 + 2 * i, 2))
    endfor
    clear response
    var int recv = sizeOf(response)
    print "Sende:  ", hexString(apdu, sizeOf(apdu))
    err "SCardTransmit", SCardTransmit(hCard, pSendPci, apdu, sizeOf(apdu), %NULL, response, ADDR(recv))
    print "Antwort:", hexString(response, recv)
    print
    dispose apdu
    return recv

endproc

proc hexString

    Parameters memory buffer, int size
    declare string out
    declare int i
    for i, 0, size - 1
    out = out + right$("00" + hex$(byte(buffer, i)), 2) + " "
    endfor
    return out

endproc

proc err

    parameters string func, long result

    if result

        MessageBox func + ": " + st$(result), "", 0
        end

    endif

endproc