pcscconnector.pas

Delphi 用的PSCS控件即例子程序,本人稍作修改了例子程序

        Result := true;
        end;
      end else if Assigned(FOnError) then FOnError(Self, esInit, RetVar);
    end else if Assigned(FOnError) then FOnError(Self, esInit, RetVar);
end;

function TPCSCConnector.Open: boolean;
var
  ThreadID    : LongWord;
begin
  CloseAndDisconnect;
  if (FUseReaderNum > NOREADERSELECTED) and
     (SCardIsValidContext(FContext) = SCARD_S_SUCCESS) then
    begin
    ReaderOpen      := true;
    ActReaderState  := SCARD_STATE_UNAWARE;
    LastReaderState := SCARD_STATE_UNAWARE;
    BeginThread(nil, 0, CardWatcherThread, @FContext, 0, ThreadID);
    Result := true;
    end else Result := false;
end;

procedure TPCSCConnector.Close;
begin
  ReaderOpen := false;
  SCardCancel(FContext);
  if FConnected then Disconnect;
end;

function TPCSCConnector.Connect: boolean;
begin
  if FConnected then Disconnect;
  if FUseReaderNum > NOREADERSELECTED then
    if ConnectSelectedReader then FConnected := true
                             else FConnected := false;
  Result := FConnected;
end;

procedure TPCSCConnector.Disconnect;
begin
  if FConnected then
    begin
    SCardDisconnect(FCardHandle, SCARD_RESET_CARD);
    FConnected  := false;
    FCardHandle := 0;
    end;
end;

procedure TPCSCConnector.CloseAndDisconnect;
begin
  if FConnected then Disconnect;
  if ReaderOpen then Close;
end;

function TPCSCConnector.ConnectSelectedReader: boolean;
var
  RetVar : cardinal;
begin
  RetVar := SCardConnectA(FContext,
                          SelectedReader,
                          SCARD_SHARE_EXCLUSIVE,
                          SCARD_PROTOCOL_Tx,
                          FCardHandle,
                          @FAttrProtocol);
  case RetVar of
    SCARD_S_SUCCESS      : begin
                           CardActiveAction;
                           Result := true;
                           end;
    SCARD_W_REMOVED_CARD : begin
                           Result := true;
                           end;
    else                   begin
                           Result := false;
                           if Assigned(FOnError) then FOnError(Self, esConnect, RetVar);
                           end;
    end;
end;

procedure TPCSCConnector.ProcessReaderState(const OldState,NewState: cardinal);
var
  CardInOld, CardInNew     : boolean;
  ReaderEmOld, ReaderEmNew : boolean;
  CardMuteOld, CardMuteNew : boolean;
  CardIgnore               : boolean;

begin
CardInOld   := (OldState and SCARD_STATE_PRESENT) > 0;
CardInNew   := (NewState and SCARD_STATE_PRESENT) > 0;
ReaderEmOld := (OldState and SCARD_STATE_EMPTY) > 0;
ReaderEmNew := (NewState and SCARD_STATE_EMPTY) > 0;
CardMuteOld := (OldState and SCARD_STATE_MUTE) > 0;
CardMuteNew := (NewState and SCARD_STATE_MUTE) > 0;
CardIgnore  := (NewState and SCARD_STATE_IGNORE) > 0;

if CardMuteNew     and
   not CardMuteold then if Assigned(FOnCardInvalid) then FOnCardInvalid(Self);

if CardInNew       and
   not CardInOld   and
   not CardMuteNew and
   not CardIgnore  then CardInsertedAction;

if CardInOld     and
   not CardInNew then CardRemovedAction;

if ReaderEmNew     and
   not ReaderEmOld then begin
                        if Assigned(FOnReaderWaiting) then FOnReaderWaiting(Self);
                        end;

LastReaderState := NewState;
end;

procedure TPCSCConnector.CardInsertedAction;
begin
  if Assigned(FOnCardInserted) then FOnCardInserted(Self);
  if FConnected then CardActiveAction;
end;

procedure TPCSCConnector.CardActiveAction;
begin
  GetReaderAttributes;
  if FAttrProtocol <> SCARD_PROTOCOL_UNK then
    begin
    GetCardAttributes;
    if Assigned(FOnCardActive) then FOnCardActive(Self);
    end;
end;

procedure TPCSCConnector.CardRemovedAction;
begin
  ClearReaderAttributes;
  ClearCardAttributes;
  if Assigned(FOnCardRemoved) then FOnCardRemoved(Self);
  Disconnect;
end;

procedure TPCSCConnector.SetReaderNum(Value: Integer);
begin
  if Value <> FUseReaderNum then
    begin
    CloseAndDisconnect;
    if Value < FReaderList.Count then
      begin
      SelectedReader := PChar(FReaderList[Value]);
      FUseReaderNum   := Value;
      end else
      begin
      SelectedReader := '';
      FUseReaderNum   := -1;
      end;
    end;
end;

function TPCSCConnector.IsReaderOpen: boolean;
begin
  Result := ReaderOpen;
end;

function TPCSCConnector.GetReaderState: cardinal;
begin
  Result := ActReaderState;
end;

procedure TPCSCConnector.GetReaderAttributes;
var
  RetVar : cardinal;
  ABuf   : string;
  AIBuf  : integer;
  ALen   : integer;
begin
  ABuf := StringOfChar(#0, 127);
  ALen := Length(ABuf);
  RetVar := SCardGetAttrib(FCardHandle, SCARD_ATTR_ATR_STRING, Pointer(ABuf), @ALen);
  if RetVar = SCARD_S_SUCCESS then FAttrCardATR := Copy(ABuf, 1, ALen)
                              else FAttrCardATR := '';

  ALen := Length(ABuf);
  RetVar := SCardGetAttrib(FCardHandle, SCARD_ATTR_VENDOR_NAME, Pointer(ABuf), @ALen);
  if RetVar = SCARD_S_SUCCESS then FAttrVendorName := Copy(ABuf, 1, ALen)
                              else FAttrVendorName := '';

  ALen := Length(ABuf);
  RetVar := SCardGetAttrib(FCardHandle, SCARD_ATTR_VENDOR_IFD_SERIAL_NO, Pointer(ABuf), @ALen);
  if RetVar = SCARD_S_SUCCESS then FAttrVendorSerial := Copy(ABuf, 1, ALen)
                              else FAttrVendorSerial := '';

  ALen := SizeOf(AIBuf);
  RetVar := SCardGetAttrib(FCardHandle, SCARD_ATTR_CURRENT_PROTOCOL_TYPE, @AIBuf, @ALen);
  if RetVar = SCARD_S_SUCCESS then FAttrProtocol := AIBuf
                              else FAttrProtocol := 0;

  ALen := SizeOf(AIBuf);
  AIBuf := 0;
  RetVar := SCardGetAttrib(FCardHandle, SCARD_ATTR_ICC_TYPE_PER_ATR, @AIBuf, @ALen);
  if RetVar = SCARD_S_SUCCESS then begin
                                   case AIBuf of
                                     1  : FAttrICCType := 'ISO7816A';
                                     2  : FAttrICCType := 'ISO7816S';
                                     else FAttrICCType := 'UNKNOWN';
                                     end;
                                   end
                              else FAttrICCType := '';
end;

procedure TPCSCConnector.GetCardAttributes;
begin
if GSMSelect(DFgsm900) = GSMStatusOK then
  begin
  FGSMVoltage30 := (OrdD(FGSMDirInfo, 14) and $10) > 0;
  FGSMVoltage18 := (OrdD(FGSMDirInfo, 14) and $20) > 0;
  end;
end;

procedure TPCSCConnector.ClearReaderAttributes;
begin
  FAttrCardATR      := '';
  FAttrVendorName   := '';
  FAttrVendorSerial := '';
  FAttrProtocol     := 0;
  FAttrICCType      := '';
end;

procedure TPCSCConnector.ClearCardAttributes;
begin
  FGSMCurrentFile := '';
  FGSMFileInfo    := '';
  FGSMDirInfo     := '';
  FGSMVoltage30   := false;
  FGSMVoltage18   := false;
end;

function TPCSCConnector.GetResponseFromCard(const APdu: string): string;
var
  RetVar : cardinal;
  SBuf   : string;
  SLen   : cardinal;
  RBuf   : string;
  RLen   : cardinal;
  Ppci   : Pointer;
begin
SBuf := APdu;
RBuf := StringOfChar(#0,MAXAPDULENGTH);
if Length(SBuf) <= MAXAPDULENGTH then
  begin
  case FAttrProtocol of
    SCARD_PROTOCOL_T0 : Ppci := @SCARD_PCI_T0;
    SCARD_PROTOCOL_T1 : Ppci := @SCARD_PCI_T1;
    else                Ppci := nil;
    end;
  SLen := Length(APdu);
  RLen := Length(RBuf);
  RetVar := SCardTransmit(FCardHandle, Ppci, Pointer(SBuf), SLen, nil, Pointer(RBuf), @RLen);
  if RetVar = SCARD_S_SUCCESS then
    begin
    Result := Copy(RBuf,1,RLen);
    end else
    begin
    Result := '';
    if Assigned(FOnError) then FOnError(Self, esTransmit, RetVar);
    end;
  end;
end;

function TPCSCConnector.GetResponseFromCard(const Command: string; var Data: string; var sw1, sw2: byte): boolean;
var
  Answer  : string;
  AnswerL : integer;
begin
Answer := GetResponseFromCard(Command + Data);
AnswerL := Length(Answer);
if AnswerL >= 2 then
  begin
  Data := Copy(Answer, 1, AnswerL - 2);
  sw1  := Ord(Answer[AnswerL - 1]);
  sw2  := Ord(Answer[AnswerL]);
  if sw1 = GSMStatusResponseData then
    begin
    Data := Chr(sw2);
    if not GetResponseFromCard(GCGetResponse, Data, sw1, sw2) then
      begin
      Data := '';
      sw1  := 0;
      sw2  := 0;
      Result := false;
      end else Result := true;
    end else Result := true;
  end else
  begin
  Data := '';
  sw1  := 0;
  sw2  := 0;
  Result := false;
  end;
end;

function TPCSCConnector.GSMStatus: integer;
var
  Answer   : string;
  sw1, sw2 : byte;
begin
  GetResponseFromCard(GCGetStatus, Answer, sw1, sw2);
  Result := (sw1 shl 8) + sw2;
  if Result = GSMStatusOK then
    begin
    FGSMDirInfo := Answer;
    FGSMCurrentFile := Copy(Answer, 5, 2);
    end else
    begin
    FGSMDirInfo := '';
    end;
end;

function TPCSCConnector.GSMSelect(const FileID: string): integer;
var
  Answer   : string;
  sw1, sw2 : byte;
begin
  Answer := FileID;
  GetResponseFromCard(GCSelectFile, Answer, sw1, sw2);
  Result := (sw1 shl 8) + sw2;
  if Result = GSMStatusOK then
    begin
    FGSMCurrentFile := Copy(Answer, 5, 2);
    if OrdD(Answer, 7) = GSMFileTypeEF then
      begin
      FGSMFileInfo := Answer;
      end else
      begin
      FGSMDirInfo := Answer;
      end;
    end;
end;

function TPCSCConnector.GSMReadBinary(const Offset, Length: integer; var Data: string): integer;
var
  Command  : string;
  sw1, sw2 : byte;
begin
  Command := GCReadBinary + Chr(Offset div 256) + Chr(Offset mod 256) + Chr(Length mod 256);
  GetResponseFromCard(Command, Data, sw1, sw2);
  Result := (sw1 shl 8) + sw2;
  if Result = GSMStatusOK then
    begin
    end;
end;

end.