unit1.~pas

同方PC读卡器驱动

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,WINScard,WinSmCrd,SCardErr, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    CB_SelReader: TComboBox;
    Edit1: TEdit;
    Button2: TButton;
    Timer1: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  hContext:SCARDCONTEXT;
//  hContext:Longint;
  dwReaders:integer;
  mszGroups,mszReaders:LPSTR;
  ret,Count:Longint;
  Busy:Boolean;
 szReader:string;
 dwState,hCard,ReaderLen,atrlen,RecvLen:Longint;
 dwAP,sendlen:DWORD;
 szReaderName:array[0..255]of char;
 dwProtocol:DWORD;
 ATR,SendBuf,RecvBuf:array[0..255]of byte;
 IOSend,IORecv:SCARD_IO_REQUEST;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
Readers:string;
Reader:array[0..255]of char;
len:integer;
begin
    ret:=SCardEstablishContext(SCARD_SCOPE_SYSTEM,nil,nil,@hContext);
    if ret=SCARD_S_SUCCESS then showmessage('OK');
    ret:=SCardListReaders(hContext,Nil,Nil,dwReaders);
    setlength(Readers,dwReaders);
    ret:=SCardListReaders(hContext,nil,@Reader,dwReaders);
//也可以这样    ret:=SCardListReadersa(hContext,nil,pchar(Readers),dwReaders);
    if ret<>SCARD_S_SUCCESS then showmessage('Error '+IntToHex(ret,4))
    else
      begin
         len:=0;
         strcopy(pchar(readers),reader);
         While Readers[1]<>#0 do
          begin
           CB_SelReader.Items.Add(Readers);
           //strPcopy(reader,Readers+Length(Reader);
           len:=len+strlen(pchar(readers));
           strcopy(pchar(readers),@Reader[len+1]);
           CB_SelReader.ItemIndex:=CB_SelReader.ItemIndex+1;
          end;
      end;

end;

procedure TForm1.Button1Click(Sender: TObject);

 begin
      szReader:=CB_SelReader.Text;
      ret:=SCardConnect(hContext,pchar(szReader),SCARD_SHARE_EXCLUSIVE,SCARD_PROTOCOL_T0,hCard,@dwAP);
      if ret<>SCARD_S_SUCCESS then
       begin showmessage('Error '+IntToHex(ret,4));exit;end;
      ReaderLen:=strlen(pchar(szReader))+2;
      ret:=SCardStatus(hCard,pchar(szReader),ReaderLen,dwState,@dwProtocol,@ATR,atrlen);
      IOSend.dwProtocol:=dwProtocol;IORecv.dwProtocol:=dwProtocol;
      IOSend.dbPciLength:=sizeof(IOSend);IORecv.dbPciLength:=sizeof(IOSend);
{
      SendBuf[0]:=$00;SendBuf[1]:=$84;SendBuf[2]:=$00;
      SendBuf[3]:=$00;SendBuf[4]:=$04;
      SendLen:=5;
      ret:=SCardTransmit(hCard,@IOSend,@SendBuf,SendLen,@IORecv,@RecvBuf,@RecvLen);
      SendBuf[0]:=$00;SendBuf[1]:=$84;SendBuf[2]:=$00;
      SendBuf[3]:=$00;SendBuf[4]:=$04;
      SendLen:=5;
      ret:=SCardTransmit(hCard,@IOSend,@SendBuf,SendLen,@IORecv,@RecvBuf,@RecvLen);


      SendBuf[0]:=$00;SendBuf[1]:=$A4;SendBuf[2]:=$00;
      SendBuf[3]:=$00;SendBuf[4]:=$02;
      SendBuf[5]:=$3D;SendBuf[6]:=$00;
      SendLen:=7;
      ret:=SCardTransmit(hCard,@IOSend,@SendBuf,SendLen,@IORecv,@RecvBuf,@RecvLen);


 //     ret:=SCardStatusA(hCard,pchar(szReader),ReaderLen,dwState,@dwProtocol,@ATR,atrlen);
      SendBuf[0]:=$00;SendBuf[1]:=$C0;SendBuf[2]:=$00;
      SendBuf[3]:=$00;SendBuf[4]:=$10;
      SendLen:=5;
      ret:=SCardTransmit(hCard,@IOSend,@SendBuf,SendLen,@IORecv,@RecvBuf,@RecvLen);
  }
end;

procedure TForm1.Button2Click(Sender: TObject);
var
comd:array[0..255]of byte;
ComdStr,Msg,Status,retstr:string;
ComdLen,i:integer;
begin
     SendLen:=Length(Edit1.Text) div 2;
     comdstr:='';
     for i:=0 to SendLen-1 do
       SendBuf[i]:=StrToInt('$'+Edit1.Text[2*i+1]+Edit1.Text[2*i+2]);
     RecvLen:=$FF;
     ret:=SCardTransmit(hCard,@IOSend,@SendBuf,SendLen,@IORecv,@RecvBuf,@RecvLen);
     if ret<> SCARD_S_SUCCESS then
       showmessage('Error '+IntToHex(ret,4))
     else
       Begin
         retstr:='';
         Status:=IntToHex((RecvBuf[RecvLen-2]*$100+RecvBuf[RecvLen-1]),4);
         for i:=0 to RecvLen-3 do
           retstr:=retstr+IntToHex(RecvBuf[i],2);
         Msg:=Format('Status=%s,return=%s',[Status,retstr]);
         showmessage(msg);
       End;


end;

procedure TForm1.Timer1Timer(Sender: TObject);
const
  comd:array[0..4] of byte=($00,$84,$00,$00,$04);
var
i,j:integer;
MSG:string;
begin
    SendLen:=5;
    RecvLen:=$FF;
    if Busy then exit;
    Busy:=True;
    ret:=SCardTransmit(hCard,@IOSend,@comd,SendLen,@IORecv,@RecvBuf,@RecvLen);
    if ret<> SCARD_S_SUCCESS then
      begin
       showmessage('Error '+IntToHex(ret,4));

      szReader:=CB_SelReader.Text;
      ret:=SCardConnect(hContext,pchar(szReader),SCARD_SHARE_SHARED,SCARD_PROTOCOL_T0,hCard,@dwAP);
      if ret<>SCARD_S_SUCCESS then
       begin showmessage('Error '+IntToHex(ret,4));exit;end;
      ReaderLen:=strlen(pchar(szReader))+2;

      ret:=SCardStatus(hCard,pchar(szReader),ReaderLen,dwState,@dwProtocol,@ATR,atrlen);
      IOSend.dwProtocol:=dwProtocol;IORecv.dwProtocol:=dwProtocol;
      IOSend.dbPciLength:=sizeof(IOSend);IORecv.dbPciLength:=sizeof(IOSend);
      Busy:=False;
  //    Timer1.Enabled:=False;
      end
    else
      Begin
        Msg:='';
        INC(Count);
        Label1.Caption:=IntToStr(Count);
        for j:=0 to 3 do
           Msg:=Msg+IntToHex(RecvBuf[j],2);
        Label2.Caption:=Msg;
        Application.ProcessMessages;
        Busy:=False;
      End;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
     Timer1.Enabled:=not Timer1.Enabled;
end;

end.