unit GetInfos;
//-------------------------------------------------------
//Coypright (c) 2009,Feitian Technologies Co., Ltd.
//All rights reserved
//Description: definition of CGetInfos class
//Created Time:20090625
//Author:Allen of ITD
//-------------------------------------------------------

interface


uses
   Windows, SysUtils,pkcs11;
const
  dllname:string= 'ShuttleCsp11_3003.dll';

//----------------------------------------------------------
type
 CGetInfos=class
 public
    procedure ShowCryptokiInfos(pInfo:CK_INFO_PTR);
    procedure ShowTokenInfo(tokenInfo:CK_TOKEN_INFO_PTR);
    procedure ShowSlotInfo(slotinfo:CK_SLOT_INFO_PTR);

    //load the pkcs11 dll
	  function LoadLib():Boolean;
    //free the pkcs11 dll
    function FreeLib():Boolean;
    //get general information about Cryptoki library
	  function GetCryptokiInfos(pInfo:CK_INFO_PTR):longword;
    //get token information
	  function GetTokenInfos(pTokenInfo:CK_TOKEN_INFO_PTR):longword;
    //get slot information
	  function GetSlotInfos(pSlotInfo:CK_SLOT_INFO_PTR):longword;
 private
   // CK_FUNCTION_LIST_PTR m_pToken;
    m_hDll:HMODULE ;
 end;
//----------------------------------------------------------

implementation

//load the pkcs11 dll
function CGetInfos.LoadLib():Boolean;
var
  rv:longword;
begin
  m_hDll:=LoadLibrary(Pchar(dllname));
  if(m_hDll=0) then begin
    WriteLn('Failed to load the pkcs11 library');
    result:= false;
    exit
    end
  else
  begin
    @C_Initialize:=GetProcAddress(m_hDll, PChar('C_Initialize'));
    @C_Finalize:=GetProcAddress(m_hDll, PChar('C_Finalize'));
    @C_GetSlotList:=GetProcAddress(m_hDll, PChar('C_GetSlotList'));
    @C_GetSlotInfo:=GetProcAddress(m_hDll, PChar('C_GetSlotInfo'));
    @C_GetInfo:=GetProcAddress(m_hDll,PChar('C_GetInfo'));
    @C_GetTokenInfo:=GetProcAddress(m_hDll,PChar('C_GetTokenInfo'));
    if(@C_Initialize=nil)then begin
      WriteLn('Get C_Initialize function failed!');
      result:=false;
      exit
    end
    else if(@C_Finalize=nil) then begin
      WriteLn('Get C_Finalize function failed!');
      result:=false;
      exit
    end
    else if(@C_GetSlotList=nil) then begin
      WriteLn('Get C_GetSlotList function failed!');
      result:=false;
      exit
    end
    else if(@C_GetSlotInfo=nil) then begin
      WriteLn('Get C_GetSlotInfo function failed!');
      result:=false;
      exit
    end
    else if(@C_GetInfo=nil) then begin
      WriteLn('Get C_GetInfo function failed!');
      result:=false;
      exit
    end
    else if(@C_GetTokenInfo=nil) then begin
      WriteLn('Get C_GetTokenInfo function failed!');
      result:=false;
      exit
    end
    else begin
      rv:=C_Initialize(0);
      if(rv<>CKR_OK) then begin
        WriteLn('Call C_Initialize function failed!');
        result:=false;
        exit
      end
      else begin
        result:=true;
        exit
        end
    end
  end;
end;
//----------------------------------------------------------
//free the pkcs11 dll
function CGetInfos.FreeLib():Boolean;
begin
  C_Finalize(0);
  FreeLibrary(m_hDll);
end;

//----------------------------------------------------------
//get general information about Cryptoki library
function CGetInfos.GetCryptokiInfos(pInfo:CK_INFO_PTR):longword;
var
  rv:longword;
  iSize:integer;
begin

  iSize:=sizeof(CK_INFO);
  ZeroMemory(pInfo,iSize);
	rv:=C_GetInfo(pInfo);
  if(rv <> CKR_OK) then begin
    result:=CKR_FUNCTION_FAILED;
    exit
  end
  else begin
    result:=CKR_OK;
    exit;
  end
end;

//----------------------------------------------------------
procedure CGetInfos.ShowCryptokiInfos(pInfo:CK_INFO_PTR);
var
  LibDescBuffer:array[0..31] of Char;
  manuBuffer:array[0..31] of Char;
  i:integer;
  flags:longword;
begin

  flags:=longword(pInfo.flags);
  WriteLn('Cryptoki informations:');
	WriteLn('   CryptokiVersion.major = ', pInfo.cryptokiVersion.major);
	WriteLn('   CryptokiVersion.minor = ', pInfo.cryptokiVersion.minor);
 	WriteLn('   LibraryVersion.major  = ', pInfo.libraryVersion.major);
	WriteLn('   LibraryVersion.minor  = ', pInfo.libraryVersion.minor);
	WriteLn(Format('   Flags                 = 0x%.8x', [flags]));

	ZeroMemory(@LibDescBuffer[0],32);
  Move(pInfo.libraryDescription,LibDescBuffer,31);

	WriteLn('   LibraryDescription    = ', LibDescBuffer);

  ZeroMemory(@manuBuffer[0],32);
	Move(pInfo.manufacturerID,manuBuffer,31);

	WriteLn('   ManufacturerID        = ',manuBuffer);
end;
//----------------------------------------------------------
//get token information
function CGetInfos.GetTokenInfos(pTokenInfo:CK_TOKEN_INFO_PTR):longword;
var
  rv:CK_RV;
  ulCount:CK_ULONG;
  SlotList:array of longword;
  pSlotList:CK_SLOT_ID_PTR;
  i:integer;
begin

	rv := C_GetSlotList(1,nil,ulCount);
	if(0<>rv)then begin
    result:= CKR_DEVICE_ERROR;
    exit
  end
  else begin
    SetLength(SlotList,ulCount);
    pSlotList:=@SlotList[0];
	  rv := C_GetSlotList(1, pSlotList,ulCount);
	  if((rv <> CKR_OK) or (ulCount <= 0)) then begin
      result:= CKR_TOKEN_NOT_PRESENT;
      exit
    end
    else begin
	    //Get slot information for the first token*
	    for i:=0 to ulCount-1 do
      begin
		    rv := C_GetTokenInfo(SlotList[i], pTokenInfo);
		    if(rv <> CKR_OK) then begin
	        result:=CKR_FUNCTION_FAILED;
          exit
        end
      end;
      result:=CKR_OK;
      exit
    end
  end
end;
//----------------------------------------------------------
procedure CGetInfos.ShowTokenInfo(tokenInfo:CK_TOKEN_INFO_PTR);
var
  token_label:array[0..32] of Char;
  manuBuffer:array[0..32] of Char;
  modelBuffer:array[0..17] of Char;
  SNBuffer:array[0..17] of Char;

begin

	WriteLn('Token information:');
	ZeroMemory(@token_label,33);
	Move(tokenInfo.token_label,token_label,32);
	WriteLn('   Label                 = ', token_label);

  ZeroMemory(@manuBuffer,33);
	Move(tokenInfo.manufacturerID,manuBuffer,32);
	WriteLn('   ManufacturerID        = ', manuBuffer);

  ZeroMemory(@modelBuffer,17);
	Move(tokenInfo.model,modelBuffer,16);
	WriteLn('   Model                 = ', modelBuffer);

  ZeroMemory(@SNBuffer,17);
	Move(tokenInfo.serialNumber,SNBuffer,16);
	WriteLn('   SerialNumber          = ', SNBuffer);


	WriteLn(Format('   Flags                 = 0x%.8x', [tokenInfo.flags]));
	WriteLn('   ulMaxSessionCount     = ',tokenInfo.ulMaxSessionCount);
	WriteLn('   ulSessionCount        = ',tokenInfo.ulSessionCount);
	WriteLn('   ulMaxRwSessionCount   = ',tokenInfo.ulMaxRwSessionCount);
	WriteLn('   ulRwSessionCount      = ',tokenInfo.ulRwSessionCount);
	WriteLn('   ulMaxPinLen           = ',tokenInfo.ulMaxPinLen);
	WriteLn('   ulMinPinLen           = ',tokenInfo.ulMinPinLen);
	WriteLn('   ulTotalPublicMemory   = ',tokenInfo.ulTotalPublicMemory);
	WriteLn('   ulTotalPrivateMemory  = ',tokenInfo.ulTotalPrivateMemory);
	WriteLn('   ulFreePublicMemory    = ',tokenInfo.ulFreePublicMemory);
	WriteLn('   ulFreePrivateMemory   = ',tokenInfo.ulFreePrivateMemory);
	WriteLn('   HardwareVersion.major = ',tokenInfo.hardwareVersion.major);
	WriteLn('   HardwareVersion.minor = ',tokenInfo.hardwareVersion.minor);
	WriteLn('   FirmwareVersion.major = ',tokenInfo.firmwareVersion.major);
	WriteLn('   FirmwareVersion.minor = ',tokenInfo.firmwareVersion.minor);
	WriteLn('   Token utcTime         = ', 0);
end;
//----------------------------------------------------------
//get slot information
function CGetInfos.GetSlotInfos(pSlotInfo:CK_SLOT_INFO_PTR):longword;
var
  rv:CK_RV;
  ulCount:CK_ULONG;
  SlotList:array of longword;
  pSlotList:CK_SLOT_ID_PTR;
  i:integer;
begin

	rv := C_GetSlotList(1,nil,ulCount);
	if(0<>rv)then begin
    result:= CKR_DEVICE_ERROR;
    exit
  end
  else begin
    SetLength(SlotList,ulCount);
    pSlotList:=@SlotList[0];
	  rv := C_GetSlotList(1, pSlotList,ulCount);
	  if((rv <> CKR_OK) or (ulCount <= 0)) then begin
      result:= CKR_TOKEN_NOT_PRESENT;
      exit
    end
    else begin
	    //Get slot information for the first token*
	    for i:=0 to ulCount-1 do
      begin
		    rv := C_GetSlotInfo(SlotList[i], pSlotInfo);
		    if(rv <> CKR_OK) then begin
	        result:=CKR_FUNCTION_FAILED;
          exit
        end
      end;
      result:=CKR_OK;
      exit
    end
  end
end;
//----------------------------------------------------------
procedure CGetInfos.ShowSlotInfo(slotinfo:CK_SLOT_INFO_PTR);
var
  DescBuffer:array[0..64] of Char;
  manuBuffer:array[0..32] of Char;
  i:Integer;

begin
	WriteLn('Slot information:');
  ZeroMemory(@DescBuffer,65);
	Move(slotinfo.slotDescription,DescBuffer,64);

	for i := 63 downto 1 do
		if(' ' = DescBuffer[i]) then
		 	DescBuffer[i] := #0
		else
			break ;

 	WriteLn('   SlotDescription       = ', DescBuffer);

  ZeroMemory(@manuBuffer,33);
	Move(slotinfo.manufacturerID,manuBuffer,32);
  for i:=31 downto 1 do
		if(' ' = manuBuffer[i]) then
			manuBuffer[i] := #0
		else
			break;

	WriteLn('   ManufacturerID        = ', manuBuffer);
	WriteLn(Format('   Flags                 = 0x%.8x', [slotinfo.flags]));
	WriteLn('   FirmwareVersion.major = ', slotinfo.firmwareVersion.major);
	WriteLn('   FirmwareVersion.minor = ', slotinfo.firmwareVersion.minor);
	WriteLn('   HardwareVersion.major = ', slotinfo.hardwareVersion.major);
	WriteLn('   HardwareVersion.minor = ', slotinfo.hardwareVersion.minor);
  WriteLn;
end;
//----------------------------------------------------------
end.
