gsmdemou.pas

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

unit gsmdemou;

interface

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

type
  TForm1 = class(TForm)
    card: TGSM1111APDU;
    ResourceManager1: TResourceManager;
    Splitter1: TSplitter;
    lCommands: TListBox;
    Splitter2: TSplitter;
    pcTestPages: TPageControl;
    tsSelect: TTabSheet;
    tsStatus: TTabSheet;
    tsReadBinary: TTabSheet;
    tsUpdateBinary: TTabSheet;
    tsReadRecord: TTabSheet;
    tsUpdateRecord: TTabSheet;
    tsSeek: TTabSheet;
    tsVerifyCHV: TTabSheet;
    tsChangeCHV: TTabSheet;
    tsDisableCHV: TTabSheet;
    tsRehabilitate: TTabSheet;
    tsEnableCHV: TTabSheet;
    tsUnblockCHV: TTabSheet;
    tsInvalidate: TTabSheet;
    tsGetResponse: TTabSheet;
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    tsNull: TTabSheet;
    Button1: TButton;
    Button3: TButton;
    mReport: TFormatMemo;
    StatusBar1: TStatusBar;
    Label2: TLabel;
    cbFileID: TComboBox;
    Button2: TButton;
    Panel3: TPanel;
    Label3: TLabel;
    eLen: TEdit;
    Label4: TLabel;
    chbAutoGetResponse: TCheckBox;
    fmResponse: TFormatMemo;
    Panel4: TPanel;
    Label5: TLabel;
    eStatusLen: TEdit;
    Button4: TButton;
    Label6: TLabel;
    Panel5: TPanel;
    Panel6: TPanel;
    fmStatus: TFormatMemo;
    registry: TRegistryUse;
    Button5: TButton;
    Label13: TLabel;
    tsIncrease: TTabSheet;
    Label11: TLabel;
    Label15: TLabel;
    Label17: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    Label21: TLabel;
    Label22: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    Label25: TLabel;
    Label26: TLabel;
    Button12: TButton;
    Button13: TButton;
    Button9: TButton;
    Button14: TButton;
    Button15: TButton;
    Button16: TButton;
    Button17: TButton;
    Button18: TButton;
    Button7: TButton;
    Button8: TButton;
    Button10: TButton;
    Button11: TButton;
    rgCHVID: TRadioGroup;
    pCurCHV: TPanel;
    eCHV: TEdit;
    Label12: TLabel;
    pUnblCHV: TPanel;
    eunblockchv: TEdit;
    pNewCHV2: TPanel;
    Label8: TLabel;
    eNewCHV2: TEdit;
    pNewCHV1: TPanel;
    Label16: TLabel;
    eNewCHV1: TEdit;
    Button6: TButton;
    eRBOffset: TEdit;
    eRBLen: TEdit;
    Offset: TLabel;
    e: TLabel;
    fmReadBinary: TFormatMemo;
    eRRecID: TEdit;
    Label9: TLabel;
    Label10: TLabel;
    eRRecLen: TEdit;
    fmReadRecord: TFormatMemo;
    procedure lCommandsClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cardCardAbsent(Sender: TObject);
    procedure cardCardSwallowed(Sender: TObject);
    procedure cardConnected(Sender: TObject);
    procedure cardDisconnected(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button14Click(Sender: TObject);
    procedure Button16Click(Sender: TObject);
    procedure Button17Click(Sender: TObject);
    procedure Button15Click(Sender: TObject);
    procedure Button18Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
  private
   procedure UpdateStatusBar;
   procedure SelectTab(i:integer);
   procedure FillMemo(fm:TFormatMemo;buf:TBuffer);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
 pSelect = 0;
 pStatus = 1;
 pReadBinary=2;
 pUpdateBinary=3;
 pReadRecord=4;
 pUpdateRecord=5;
 pSeek=6;
 pIncrease=7;
 pVerifyCHV=8;
 pChangeCHV=9;
 pDisableCHV=10;
 pEnableCHV=11;
 pUnblockCHV=12;
 pInvalidate=13;
 pRehabilitate=14;
 pGetResponse=15;

procedure TForm1.SelectTab(i:integer);
var
 p:TTabSheet;
begin
 lCommands.ItemIndex:=i;
 p:=pcTestPages.Pages[i];
 if i<>-1 then
 begin
  case i of
   pVerifyCHV:begin pCurCHV.parent:=p;rgChvID.parent:=p;end;
   pChangeCHV:begin pCurCHV.parent:=p;pNewCHV1.parent:=p;pNewCHV2.parent:=p;rgChvID.parent:=p;end;
   pDisableCHV:begin pCurCHV.parent:=p;end;
   pEnableCHV:begin pCurCHV.parent:=p;end;
   pUnblockCHV:begin pNewCHV1.parent:=p;pNewCHV2.parent:=p;rgChvID.parent:=p;pUnblCHV.parent:=p;end
  else;
  end;
  pcTestPages.activePage:=pcTestPages.Pages[i];
  label1.caption:=lCommands.Items[i]
 end
 else
 begin
  pcTestPages.activePage:=pcTestPages.Pages[16];
  label1.caption:='';
 end;
end;

procedure TForm1.lCommandsClick(Sender: TObject);
begin
 SelectTab(lCommands.ItemIndex);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 id:integer;
begin
 id:=StrToIntDef('$'+cbFileID.text,-1);
 card.Select(id);
 if id<>-1 then
  if cbFileID.Items.IndexOf(cbFileID.text)=-1 then
    cbFileID.Items.Add(cbFileID.text);
 mReport.AddLine('/bSelect/b '+cbFileID.text+'/t030->'+ADJ(card.ResultDescription));
 if card.sw1 in swOKBytesLeft then
 begin
  eLen.text:=inttohex(card.sw2,2);
  if chbAutoGetResponse.Checked then
   SelectTab(15);
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 card.SelectReader(nil);
 UpdateStatusbar;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 card.Reset;
 UpdateStatusbar;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 registry.SetStrings('FileID',cbFileID.Items);
 registry.SetVar('ReaderName',card.readername);
 registry.SetVar('Len',eLen.text);
 registry.SetVar('StatusLen',eStatusLen.text);
 registry.SetDWORD('AutoGetResponse',DWORD(chbAutoGetResponse.Checked));
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 s:tStringList;
begin
 s:=TStringList.Create;
 try
  s.sorted:=true;
  s.duplicates:=dupIgnore;
  registry.GetStrings('FileID',s);
  cbFileId.Items.Assign(s);
 finally
  s.Free;
 end;
 eLen.text:=registry.GetVar('Len');
 eStatusLen.text:=registry.GetVar('StatusLen');
 card.readername:=registry.GetVar('ReaderName');
 if card.readername<>'' then
  card.reset;
 UpdateStatusBar;
 chbAutoGetResponse.Checked:=Boolean(registry.GetDWORD('AutoGetResponse'));
end;

procedure TForm1.UpdateStatusBar;
begin
 if Assigned(statusbar1) then
 with statusbar1 do
 begin
  if card.readername='' then
   Panels[0].text:='(no reader)'
  else
   Panels[0].text:=card.readername;
  if card.connected then
   Panels[1].text:='connected'
  else
   Panels[1].text:='not connected';
  if card.atr.length>0 then
   Panels[2].text:=card.Atr.Hex
  else
   Panels[2].text:='(no ATR)';
 end;
end;


procedure TForm1.cardCardAbsent(Sender: TObject);
begin
 UpdateStatusBar;
end;

procedure TForm1.cardCardSwallowed(Sender: TObject);
begin
 UpdateStatusBar;
 card.Reset;
end;

procedure TForm1.cardConnected(Sender: TObject);
begin
 UpdateStatusbar;
end;

procedure TForm1.cardDisconnected(Sender: TObject);
begin
 UpdateStatusbar;
end;

procedure TForm1.FillMemo(fm:TFormatMemo;buf:TBuffer);
var
 l,i:integer;
 s,t:string;
begin
 fm.Clear;
 i:=0;
 s:='';
 t:='';
 l:=buf.len-2;
 while i<l do
 begin
  s:=s+inttohex(buf[i],2)+' ';
  if (buf[i] in [32..127]) then t:=t+char(buf[i])+'' else
   t:=t+'.';
  inc(i);
  if (i mod 16=0) or (i=l-1) then
  begin
   while Length(s)<50 do
    s:=s+' ';
   fm.AddLine('/c808'+s+'/c000'+t);
   s:='';
   t:='';
  end;
 end;
end;


procedure TForm1.Button4Click(Sender: TObject);
begin
 card.Status(strtointdef('$'+eStatusLen.text,-1));
 mReport.AddLine('/bStatus /b('+eStatusLen.text+' bytes) /t030->'+ADJ(card.ResultDescription));
 FillMemo(fmStatus,card.answer);
end;


procedure TForm1.Button5Click(Sender: TObject);
begin
 card.GetResponse(StrToIntDef('$'+eLen.text,-1));
 if card.sw=swOK then
  if (card.answer[6]=4) and (card.answer[13] in [1,3]) then
   eRRecLen.text:=inttohex(card.answer[14],2);
 mReport.AddLine('/bGet response/b /c008'+eLen.text+'/c000 bytes/t030->'+ADJ(card.ResultDescription));
 FillMemo(fmResponse,card.answer);
end;

procedure TForm1.Button13Click(Sender: TObject);
begin
 if rgCHVID.itemindex=0 then
  card.VerifyCHV(echv.text,chv_CHV1)
 else
  card.VerifyCHV(echv.text,chv_CHV2);
 mReport.AddLine('/bVerify CHV/b '+rgCHVID.Items[rgCHVID.itemindex]+'/c000 /t030->'+ADJ(card.ResultDescription));
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
 if (eNewCHV1.text<>eNewCHV2.text) then
  ShowMessage('NewCHV''s are not identical!')
 else
 begin
  if rgCHVID.itemindex=0 then
   card.ChangeCHV(echv.text,eNewCHV1.text,chv_CHV1)
  else
   card.ChangeCHV(echv.text,eNewCHV1.text,chv_CHV2);
  mReport.AddLine('/bChange CHV/b '+rgCHVID.Items[rgCHVID.itemindex]+'/c000 /t030->'+ADJ(card.ResultDescription));
 end;
end;

procedure TForm1.Button14Click(Sender: TObject);
begin
 card.DisableCHV(echv.text);
 mReport.AddLine('/bDisable CHV/b /t030->'+ADJ(card.ResultDescription));
end;

procedure TForm1.Button16Click(Sender: TObject);
begin
 card.EnableCHV(echv.text);
 mReport.AddLine('/bEnable CHV/b /t030->'+ADJ(card.ResultDescription));
end;

procedure TForm1.Button17Click(Sender: TObject);
begin
 if (eNewCHV1.text<>eNewCHV2.text) then
  ShowMessage('NewCHV''s are not identical!')
 else
 begin
  if rgCHVID.itemindex=0 then
   card.UnblockCHV(eunblockCHV.text,enewCHV1.text,chv_CHV1)
  else
   card.UnblockCHV(eunblockCHV.text,enewCHV1.text,chv_CHV2);
  mReport.AddLine('/bUnblock CHV/b '+rgCHVID.Items[rgCHVID.itemindex]+'/c000 /t030->'+ADJ(card.ResultDescription));
 end;
end;

procedure TForm1.Button15Click(Sender: TObject);
begin
 card.Rehabilitate;
 mReport.AddLine('/bRehabilitate CHV/b /t030->'+ADJ(card.ResultDescription));
end;

procedure TForm1.Button18Click(Sender: TObject);
begin
 card.Invalidate;
 mReport.AddLine('/bInvalidate CHV/b /t030->'+ADJ(card.ResultDescription));
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
 card.ReadBinary(StrToIntDef('$'+eRBOffset.Text,-1),StrToIntDef('$'+eRBLen.Text,-1));
 mReport.AddLine('/bRead binary /b From:'+eRBOffset.Text+' Length:'+ERBLen.Text+' /t030->'+ADJ(card.ResultDescription));
 FillMemo(fmReadBinary,card.answer);
end;

procedure TForm1.Button7Click(Sender: TObject);
var
 recid:TRecordID;
begin
 if eRRecID.Text='p' then recid:=rec_Prev else
 if eRRecID.Text='n' then recid:=rec_Next else
 if (eRRecID.Text='c') or (eRRecID.Text='0') then recid:=rec_Current else
  recid:=StrToIntDef('$'+eRRecID.text,0);
 card.ReadRecord(RecID,StrToIntDef('$'+eRRecLen.Text,-1));
 case RecID of
  rec_prev:mReport.AddLine('/bRead record /b Previous, Length:'+ERRecLen.Text+' /t030->'+ADJ(card.ResultDescription));
  rec_next:mReport.AddLine('/bRead record /b Next, Length:'+ERRecLen.Text+' /t030->'+ADJ(card.ResultDescription));
  rec_current:mReport.AddLine('/bRead record /b Current, Length:'+ERRecLen.Text+' /t030->'+ADJ(card.ResultDescription))
 else
  mReport.AddLine('/bRead record /b '+eRRecID.Text+' Length:'+ERRecLen.Text+' /t030->'+ADJ(card.ResultDescription));
 end;
 FillMemo(fmReadRecord,card.answer);
end;

end.