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 handle hContext, hCard/* Resource Manager Context *//* Verbindug zur Smartcard */
declare pointer pReaders, pSendPci/* Liste der Lesegeräte */
declare memory mResponse/* Antwort der Karte */
declare int dwReaders, dwProtocol, dwRecv/* Länge von pReaders *//* Verwendetes Protokoll *//* Länge der Antwort */
declare string reader/* Gewählter Leser */
dim mResponse, 255
// Resource Manager Context erstellen
err "SCardEstablishContext", SCardEstablishContext(%SCARD_SCOPE_USER, %NULL, %NULL, ADDR(hContext))
// Liste der verfügbaren Kartenleser
dwReaders = %SCARD_AUTOALLOCATE
err "SCardListReaders", SCardListReadersA(hContext, %NULL, ADDR(pReaders), ADDR(dwReaders))
// Name des zu verwendenden Lesers
var string rdrSel = "SCM Microsystems"
// Leser suchen
print "Gefundene Kartenleser:"
var int offs = 0
declare string crdr// Aktueller Listeneintrag

while (dwReaders - offs)

    crdr = String$(pReaders, offs)// Listeneintrag lesen
    casenot len(crdr) : break// Ende erreicht
    offs = offs + len(crdr) + 1// Offset für nachsten Eintrag
    // Prüfen ob gewählter Leser

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

        reader = crdr
        print "*", crdr

    else

        print " ", crdr

    endif

endwhile

// Liste freigeben
err "SCardFreeMemory", SCardFreeMemory(hContext, pReaders)

if reader = ""

    MessageBox "Kartenleser nicht gefunden!", "", 0
    end

endif

print
print "Verwende Kartenleser:", reader
print
// Verbindung mit Karte herstellen
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

// Kommunikation mit Karte
dwRecv = scTransmit("00 A4 04 00 07 D2 76 00 00 85 01 01 00", mResponse)// NDEF Applet wählen
dwRecv = scTransmit("00 A4 00 0C 02 E1 04", mResponse)// Datei mit NDEF Nachricht wählen
dwRecv = scTransmit("00 B0 00 00 00", mResponse)// Datei lesen
// OTP aus Nachricht
var string ndef = string$(mResponse, 25)
ndef = mid$(ndef, 1, len(ndef) - 1)
// OTP ausgeben und in Zwischenablage
print "OTP:", ndef
ClearClip
PutClip ndef
// Verbindung trennen
err "SCardDisconnect", SCardDisconnect(hCard, %SCARD_LEAVE_CARD)
// Resource Manager Context freigeben
err "SCardReleaseContext", SCardReleaseContext(hContext)
dispose SCARD_PCI_T0
dispose SCARD_PCI_T1
waitend
// Befehl an Karte senden

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 + ": " + str$(result), "", 0
        end

    endif

endproc