apdudemo.pas

用来测试任何pcsc兼容读卡器

unit apdudemo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,  APDUCard, PCSCclasses, ComCtrls, Menus, FormatMemo,
  ExtCtrls, VASBase,ShellAPI;

type
  TAPDUDemoForm = class(TForm)
    ResourceManager1: TResourceManager;
    APDUCard: TAPDUCard;
    statusbar: TStatusBar;
    MainMenu1: TMainMenu;
    Exit1: TMenuItem;
    Reader1: TMenuItem;
    Chose1: TMenuItem;
    Memo: TFormatMemo;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label3: TLabel;
    edCLA: TEdit;
    edINS: TEdit;
    edP2: TEdit;
    edDATA: TEdit;
    bSend: TButton;
    edP1: TEdit;
    Memo1: TMemo;
    Splitter1: TSplitter;
    key: TRegistryUse;
    repository: TFormatMemo;
    edComment: TEdit;
    Label6: TLabel;
    Open1: TMenuItem;
    Save1: TMenuItem;
    Saveas1: TMenuItem;
    N1: TMenuItem;
    Exit2: TMenuItem;
    Reset1: TMenuItem;
    diOpenFile: TOpenDialog;
    diSaveFile: TSaveDialog;
    CounterTimer1: TCounterTimer;
    procedure Exit1Click(Sender: TObject);
    procedure Chose1Click(Sender: TObject);
    procedure bSendClick(Sender: TObject);
    procedure MemoFormatLine(sender: TObject; l: Integer);
    procedure repositorySelectionChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure APDUCardConnected(Sender: TObject);
    procedure APDUCardDisconnected(Sender: TObject);
    procedure repositoryFormatLine(sender: TObject; l: Integer);
    procedure Reset1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure Saveas1Click(Sender: TObject);
    procedure APDUCardReaderNameChange(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure CounterTimer1ThresholdReached(Sender: TObject);
  private
    counter:integer;
    b:TCommandAPDUBuffer;
    Fcurfilename:string;
    procedure SetCurFileName(s:string);
    function AddCommand(c:String):boolean;virtual;
    procedure OpenFile(filename:string);
    procedure SaveFile(filename:string);
    property  CurFileName:string read FCurFileName write SetCurFileName;
  public
  end;

var
  APDUDemoForm: TAPDUDemoForm;

implementation

{$R *.DFM}

procedure TAPDUDemoForm.SetCurFileName(s:string);
begin
 key.SetVar('LastFile',s);
 Fcurfilename:=s;
 if s<>'' then
  caption:='APDU command test - '+s
 else
  caption:='APDU command test - new file';
end;

procedure TAPDUDemoForm.OpenFile(filename:string);
var
 s:TStringList;
begin
 if FileExists(filename) then
 begin
  s:=TStringList.Create;
  s.LoadFromFile(filename);
  repository.Lines.Assign(s);
  s.Free;
  CurFileName:=filename;
 end
 else
 begin
  repository.Lines.Clear;
  curfilename:='';
 end;
 repository.modified:=false; 
end;

procedure TAPDUDemoForm.SaveFile(filename:string);
var
 s:TStringList;
begin
 if filename<>'' then
 begin
  s:=TStringList.Create;
  try
   s.Assign(repository.Lines);
   try
    s.SaveToFile(filename);
    curfilename:=filename;
   except
    on Exception do ShowMessage('Saving to file '+filename+' was not possible.');
   end;
  finally
   s.Free;
  end;
 end; 
end;

procedure TAPDUDemoForm.FormCreate(Sender: TObject);
begin
 b:=TCommandAPDUBuffer.Create;
 if not ResourceManager1.IsPCSCOK then
  exit;
 apducard.readername:=key.GetVar('Reader');
 if apducard.ReaderFound and apducard.CardPresent then
  apducard.Reset;
 if not apducard.connected then
  statusbar.panels[1].text:='Not connected';
 OpenFile(key.GetVar('LastFile'));
 SetCurrentDir(ExtractfileDir(curfilename));
 diOpenFile.InitialDir:=GetCurrentDir;
 diSaveFile.InitialDir:=GetCurrentDir;
end;

procedure TAPDUDemoForm.FormDestroy(Sender: TObject);
begin
 SaveFile(curfilename);
 b.Free;
 key.Free;
end;

procedure TAPDUDemoForm.Exit1Click(Sender: TObject);
begin
 Close;
end;

procedure TAPDUDemoForm.Chose1Click(Sender: TObject);
begin
 if apducard.SelectReader(nil) then
 begin
  statusbar.Panels[0].text:=apducard.ReaderName;
  if apducard.ReaderFound and apducard.CardPresent then
   apducard.Reset;
  bSend.Enabled:=true;
  key.SetVar('Reader',apducard.readername);
 end;
end;


procedure TAPDUDemoForm.bSendClick(Sender: TObject);
var
 c:TWinControl;
begin
 c:=ActiveControl;
 if apducard.connected then
 begin
  with apducard,command do
  try
   inc(counter);
   cla:=strtoint('$'+edCLA.text);
   ins:=strtoint('$'+edINS.text);
   p1:=strtoint('$'+edP1.text);
   p2:=strtoint('$'+edP2.text);
   bodyhex:=edDATA.text;
   answer.capacity:=100;
   AddCommand(command.hex);
   Transmit;
   if answer.len>0 then
    memo.lines.Add(pad(-5,inttostr(counter))+'. '+hex+' -> '+answer.hex+' ; '+SWToString(APDUCard.sw))
   else
    memo.lines.Add(pad(-5,inttostr(counter))+'. '+hex+' -> [no answer];');
   memo1.text:=answer.Str;
   memo.SetFocus;
  except
   on e:ESCardError do ShowMessage(e.message);
   on Exception do ShowMessage('Illegal character in APDU definition!');
  end;
 end;
 c.SetFocus;
end;

procedure TAPDUDemoForm.MemoFormatLine(sender: TObject; l: Integer);
var
 s:string;
begin
 l:=memo.lines.count-1;
 s:=memo.lines[l];
 memo.StartFormat;
 memo.SetRangeFormat(l,Pos(';',s)-1,-1,FColor or FBold,0,clSilver);
 memo.EndFormat;
end;

procedure TAPDUDemoForm.repositorySelectionChange(Sender: TObject);
var
 p,l:integer;
 c,s:string;
begin
 l:=SendMessage(repository.handle,EM_LINEFROMCHAR,repository.selstart,0);
 edCla.text:='';
 edIns.text:='';
 edP1.text:='';
 edP2.text:='';
 edData.text:='';
 edComment.text:='';
 b.Hex:='';
 if repository.lines[l]='' then exit;
 s:=repository.lines[l];
 p:=pos(';',s);
 if p<>0 then
 begin
  c:=copy(s,p+1,length(s)-p);
  delete(s,p,length(s)-p+1);
  edComment.text:=c;
 end
 else
  edComment.text:='';
 try
  b.Hex:=s;
  edCla.text:=inttohex(b.CLA,2);
  edIns.text:=inttohex(b.ins,2);
  edP1.text:=inttohex(b.p1,2);
  edP2.text:=inttohex(b.p2,2);
  edData.text:=b.bodyhex;
 except
  on Exception do;
 end;
end;

procedure TAPDUDemoForm.APDUCardConnected(Sender: TObject);
begin
 statusbar.panels[1].text:=apducard.reader.Atr.Hex;
 bSend.Enabled:=true;
end;

procedure TAPDUDemoForm.APDUCardDisconnected(Sender: TObject);
begin
 statusbar.panels[1].text:='Not connected';
 bSend.Enabled:=false;
end;

procedure TAPDUDemoForm.repositoryFormatLine(sender: TObject; l: Integer);
var
 e,p:integer;
 s:string;
begin
 with repository do
 begin
  s:=lines[l];
  p:=pos(';',s);
  if p=0 then p:=length(s)+1 else s:=copy(s,1,p-1);
  StartFormat;
  e:=IsHex(s);
  if e=0 then
   SetRangeFormat(l,0,p-2,FColor or FBold,0,clLime)
  else
  begin
   SetRangeFormat(l,0,e-2,FColor or FBold,0,clSilver);
   SetRangeFormat(l,e-1,p-2,FColor or FBold,0,clRed)
  end;
  SetRangeFormat(l,p-1,-1,FColor or FBold,0,clSilver);
  EndFormat;
 end;
end;

function TAPDUDemoForm.AddCommand(c:String):boolean;
var
 p,i:integer;
 b:TBuffer;
 s:string;
begin
 b:=TBuffer.Create;
 try
  result:=true;
  b.Hex:=c;
  c:=b.Hex;
  with repository do
   for i:=0 to lines.count-1 do
   begin
    p:=pos(';',lines[i]);
    if p=0 then
     s:=lines[i]
    else
     s:=copy(lines[i],1,p-1);
    if IsHex(s)=0 then
    begin
     b.Hex:=s;
     if b.Hex = c then
     begin
      result:=false;
      if edComment.text<>'' then
       s:=s+';'+edComment.text;
      if lines[i]<>s then
       lines[i]:=s;
      break;
     end;
    end; 
   end;
  if result then
   repository.lines.add(c);
 finally
  b.Free;
 end;
end;

procedure TAPDUDemoForm.Reset1Click(Sender: TObject);
begin
 if apducard.ReaderFound and apducard.CardPresent then
  APDUCard.reset;
end;

procedure TAPDUDemoForm.Open1Click(Sender: TObject);
begin
 diOpenFile.FileName:='*.apd';
 if diOpenFile.Execute then
  OpenFile(diOpenFile.FileName);
end;

procedure TAPDUDemoForm.Save1Click(Sender: TObject);
begin
 SaveFile(curfilename);
end;

procedure TAPDUDemoForm.Saveas1Click(Sender: TObject);
begin
 diSaveFile.FileName:=curFIleName;
 if diSaveFile.Execute then
  SaveFile(diSaveFile.FileName);
 repository.modified:=false; 
end;

procedure TAPDUDemoForm.APDUCardReaderNameChange(Sender: TObject);
begin
 statusbar.panels[0].text:=apducard.readername;
end;

procedure TAPDUDemoForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
 canclose:=true;
 if repository.modified then
  case MessageBox(0,'The command file has changed.'#10'Save it?','APDU demo',MB_ICONSTOP or MB_YESNOCANCEL) of
   IDCANCEL:canclose:=false;
   IDYES:SaveFile(curfilename);
  end;
end;

procedure TAPDUDemoForm.CounterTimer1ThresholdReached(Sender: TObject);
begin
 countertimer1.ACK;
 if not ResourceManager1.IsPCSCOK then
 begin
  MessageBox(0,'PCSC Windows components not installed or Resource Manager is not running!','Error',MB_ICONHAND);
  close;
 end;
end;

end.