unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs,WinScard, StdCtrls, dlldecl,utility,loginacslib_tlb;    type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    Memo1: TMemo;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
  public
   function GETCID(xCardHandle:Cardinal):String;
  end;    var
  Form1: TForm1;
  SCarCon:Cardinal;
  phCard1:Cardinal;
  recPCI:SCARD_IO_REQUEST;
  retBuf:array [0..254]of Byte;
  retBufLen:Longint;
  CIDAry:array[0..4] of Byte;
  USBName:pchar;
  Activepro:longint;
  Sendcmd:usb_send_cmd;
  loginacs1:Tloginacs;    implementation    {$R *.dfm}    procedure TForm1.Button1Click(Sender: TObject);
var//列出可用讀卡機
iret:longint;
hcontext:Cardinal;
t1:pchar;
t2:pchar;
tt:longInt;
i:integer;
begin
fillchar(t1,sizeof(t1),0);
fillchar(t2,sizeof(t2),0);
tt:=SCARD_AUTOALLOCATE;
iret:=SCardListReadersA(SCarcon,nil,@t2,tt);
memo1.Text:=t2;
UsbName:=t2;
end;    procedure TForm1.FormCreate(Sender: TObject);
var
iRet:Integer;
begin
iret:=SCardEstablishContext(SCARD_SCOPE_USER, nil, nil, SCarcon);
Edit1.Text:=IntTostr(iret);
end;    procedure TForm1.Button2Click(Sender: TObject);
var//取得 ic卡HAndle
iret:integer;
begin
iret:=SCardConnectA(SCarcon,usbname, SCARD_SHARE_SHARED, SCARD_PROTOCOL_T1, phCard1,@Activepro);
if iret=0 then
 ShowMessage('連線成功')
else begin
 ShowMessage('資料卡讀取錯誤');
 exit;
end;
ShowMessage(GetCID(phCard1));
end;    procedure TForm1.Button3Click(Sender: TObject);
var//Disconnect IC 卡
iret:dword;
begin
iret:=ScardDisconnect(phCard1,SCARD_RESET_CARD);
if iret=0 then
 ShowMessage('離線成功')
else begin
 ShowMessage('離線失敗');
 exit;
end;
end;    function TForm1.GETCID(xCardHandle:Cardinal):String;
var//回傳command指令結果
i,iret:Longint;
retBuflen:Longint;
ss:array[0..9] of byte;
Buffer: BasicInfo;
Length: Integer;
Res: Integer;
LowIndex, HighIndex: Integer;
sRetMsg: string;
aa:TGUID;
att: SCARD_IO_REQUEST;
begin
sRetMsg := '';
ss[0]:=$00;
ss[1]:=$CA;
ss[2]:=$00;
ss[3]:=$01;
ss[4]:=$02;//東元規格書上GETDATA command 執行後得到 conditions 
            of use not staisfied 請問我的指令是不是下錯了??
ss[5]:=$00;
ss[6]:=$00;
ss[7]:=$00;
recPCI.dwProtocol := SCARD_PROTOCOL_T1;
recPCI.cbPciLength := Sizeof(recPCI);
retBuflen:= Sizeof(retBuf);
fillchar(retbuf,sizeof(retbuf),0);
iret:=SCardTransmit(phCard1, recPCI,@SS, 5,recpci,@retBuf,@retBuflen);
Showmessage(inttohex(RetBuf[0],2) inttohex(RetBuf[1],2));
SCardGetProviderIdA(SCarCon,UsbName,@aa);
Showmessage(GuidTostring(aa));
result:=inttohex(RetBuf[0],2) inttohex(RetBuf[1],2);
end;    procedure TForm1.Button4Click(Sender: TObject);
var//秀出連線狀態
tpc:Pchar;
tgui:TGUID;
tpcl:Longint;
szReader:PWideChar;
battr:array[0..31]of Byte;
cByte,cch,dwState, dwProtocol:Longint;
i,iret:Longint;
staut:String;
begin
for i:=1 to 20 do begin
loginacs1:=Tloginacs.Create(Form1);//ACR-30所附loginasc.ocx測試
loginacs1.CardEstablish:=inttostr(scarcon);
loginacs1.FullName:=UsbName;
loginacs1.ReadHIC(i);
if Trim(loginacs1.CardID)<>'' then
 showmessage(loginacs1.CardID);
edit1.text:=inttostr(i);
sleep(100);
application.ProcessMessages;
end;
cch:=200;cByte:=32;
fillchar(battr,32,0);    SCardStatusA(phCard1,usbName,cch,dwState,dwProtocol,@bAttr,cByte);
Case dwState of
 0:Staut:='SCARD_UNKNOWN    = 0   ';
 1:Staut:='SCARD_ABSENT     = 1   ';
 2:Staut:='SCARD_PRESENT    = 2   ';
 3:Staut:='SCARD_SWALLOWED  = 3   ';
 4:Staut:='SCARD_POWERED    = 4   ';
 5:Staut:='SCARD_NEGOTIABLE = 5   ';
 6:Staut:='SCARD_SPECIFIC   = 6   ';
end;    Memo1.Text:=memo1.Text #13#10
//          '(' inttostr(cch) ')' //回傳USB Readers 名稱 長度(memory)
            '(' staut ')' #13#10;
Case dwProtocol of
 0:staut:='SCARD_PROTOCOL_UNDEFINED';   
1:staut:='SCARD_PROTOCOL_T0       ';
 2:staut:='SCARD_PROTOCOL_T1       ';
 $10000:staut:='SCARD_PROTOCOL_RAW   ';
 $80000000:staut:='SCARD_PROTOCOL_DEFAULT ';
 Memo1.text:=Memo1.text
             '(' Staut ')' #13#10;
Staut:='';
For i:=0 to 31 do begin
 if battr[i]<>0 then
 Staut:=Staut String(chr(battr[i]));
end;
 Memo1.text:=Memo1.text
             '(' Staut ')' #13#10
             '(' inttostr(cByte) ')';
tpcl:=SCARD_AUTOALLOCATE;
fillchar(tgui,sizeof(tgui),0);
SCardListCardsA(ScarCon,nil,tgui,0,@tpc,tpcl);
memo1.Text:=memo1.Text #13#10 tpc;
end;    procedure TForm1.Button5Click(Sender: TObject);
var//讀取卡片屬性
battr:array[0..31]of Byte;
cByte:Longint;
begin
fillchar(battr,32,0);
SCardGetAttrib(phCard1,SCARD_ATTR_ATR_STRING,@battr,CByte);
ShowMessage(pchar(@battr));
end;    end.

對不起 由於還在測試所以程式很亂而且下了很多無用的動作 以上動作 皆能正常無誤運行但是ADUP GET DATAcommad 指令執行後卻只能得到 6985或6E00 的回應， 在站上看過ACR-30可以有讀取建保卡基本資料區的文章 不曉得有那位前輩有購買實際測過的嗎??(小的有將loginasc轉成TLB但是由於讀 卡機為上航科技出的一般讀卡機並非 ACR系列，有用過ACR系列的前輩能分享一 下使用心得嗎?? 如果只是想讀取健保IC卡卡號及基本資料 請問 ADUP command該如何下?? 或者 一定要透過ASM的安全機制才能讀取??那 ACR-30又是如何辦到的呢??? 搞不懂!搞不懂!永遠都搞不懂!! 發表人 - mine 於 2004/12/31 19:16:02

延宕了一個月，前輩們大楖都太忙嚕!! 小的先就此結案，如果大大們有空了別忘了幫小的寫個答案!感激!感激!! 搞不懂!搞不懂!永遠都搞不懂!!

mine你好! . 1.東元讀卡機的ERROR CODE並沒有6985或6E00 2.健保卡需要有安全模組卡才能讀 3.我有東元讀卡機及安全模組卡,可以幫你測試.

HIHI yehmy 大大您好 我的用意其實只有小小的就是不用東元的機器不透過SAM機制 這問題我有向東元請教過 目前好像連基本區段因"人權"問題都加上了驗証 所以無法像之前一樣可以讀到基本區段 所以感謝大大的好意 我並不需要測試東元的機器的不過 還是感謝您的熱心 qq 以上資訊如果有誤還請大大指正 搞不懂!搞不懂!永遠都搞不懂!!

mine您好，我这儿有一个Apdu结构，不知道是不是您想要的。 TACApdu = record CLA : Byte; INS : Byte; P1 : Byte; P2: Byte; Lc: Smallint; Le: Smallint; DataIn : array [0..255] of Byte; DataOut: array [0..255] of Byte; Status : WORD; end; 另外我想请问你一下WinScard.PAS单元是怎样生成的，能给我一份吗？我的邮箱是CXG@CHINA-LAUNDRY.COM。非常感谢。

引言: 延宕了一個月，前輩們大楖都太忙嚕!! 小的先就此結案，如果大大們有空了別忘了幫小的寫個答案!感激!感激!! 搞不懂!搞不懂!永遠都搞不懂!!

有規格書嗎?..我可以幫你看看..雖然健保卡我沒玩過但是讀基本資料應該沒問題吧!

引言: mine您好，我这儿有一个Apdu结构，不知道是不是您想要的。 TACApdu = record CLA : Byte; INS : Byte; P1 : Byte; P2: Byte; Lc: Smallint; Le: Smallint; DataIn : array [0..255] of Byte; DataOut: array [0..255] of Byte; Status : WORD; end; 另外我想请问你一下WinScard.PAS单元是怎样生成的，能给我一份吗？我的邮箱是CXG@CHINA-LAUNDRY.COM。非常感谢。

winscard.dll是windows 2000以上版本內附的在目錄system32下應該可以找到 至於它的header檔案在Borland C Builder內include目錄下也有附,delphi應該也是如此!