at24.pas

IC卡编程

unit At24;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons;

type
  TForm1 = class(TForm)
    Button1: TButton;
    readdata1: TEdit;
    Label1: TLabel;
    writedata: TEdit;
    Label2: TLabel;
    readdata2: TEdit;
    Label3: TLabel;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  icdev: longint;
  Form1: TForm1;
  {a example for your to try using .dll. add_s return i+1}
  function add_s(i: smallint): smallint; stdcall;
  far;external 'ic32.DLL' name 'add_s';
  {comm function.}
  function IC_InitComm(port: smallint): longint; stdcall;
  far;external 'ic32.DLL' name 'IC_InitComm';
  function IC_ExitComm(icdev: longint):smallint;stdcall;
  far;external 'ic32.dll'name 'IC_ExitComm';
  function IC_Status(icdev: longint):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_Status';
  function IC_InitType(icdev: longint; cardtype: smallint):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_InitType';
  function IC_Write(icdev: longint;offset:smallint;len:smallint;databuff:pchar):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_Write';
  function IC_Read(icdev:longint;offset:smallint;len:smallint;databuff:pchar):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_Read';
  function IC_Erase(icdev:longint;offset:smallint;len:smallint):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_Erase';
  function IC_Read_Float(icdev:longint;offset:smallint;fdata:pointer):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_Read_Float';
  function IC_Write_Float(icdev:longint;offset:smallint;fdata:single):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_Write_Float';
  function IC_Down(icdev:longint):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_Down';
  function IC_Pushout(icdev:longint):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_Down';
  {4442 function.}
  function IC_ReadProtection(icdev:longint;offset:smallint;len:smallint;databuff:pchar):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_ReadProtection';
  function IC_WriteProtection(icdev:longint;offset:smallint;len:smallint;databuff:pchar):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_WriteProtection';
  function IC_ReadCount_SLE4442(icdev:longint):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_ReadCount_SLE4442';
  function IC_CheckPass_SLE4442(icdev:longint;password:pchar):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_CheckPass_SLE4442';
  function IC_ChangePass_SLE4442(icdev:longint;password:pchar):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_ChangePass_SLE4442';
  {4428 function.}
  function IC_ReadWithProtection(icdev:longint;offset:smallint;len:smallint;databuff:pchar):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_ReadWithProtection';
  function IC_WriteWithProtection(icdev:longint;offset:smallint;len:smallint;databuff:pchar):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_WriteWithProtection';
  function IC_ReadCount_SLE4428(icdev:longint):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_ReadCount_SLE4428';
  function IC_CheckPass_SLE4428(icdev:longint;password:pchar):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_CheckPass_SLE4428';
  function IC_ChangePass_SLE4428(icdev:longint;password:pchar):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_ChangePass_SLE4428';
  {102 function}
  function IC_CheckPass_102(icdev:longint;password:pchar):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_CheckPass_102';
  function IC_ChangePass_102(icdev:longint;password:pchar):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_ChangePass_102';
  function IC_ReadCount_102(icdev:longint):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_ReadCount_102';
  function IC_Erase_102(icdev:longint;offset:smallint;len:smallint):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_Erase_102';
  function IC_CheckAZPass_102(icdev:longint;zone:smallint;password:pchar):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_CheckAZPass_102';
  function IC_ChangeAZPass_102(icdev:longint;zone:smallint;password:pchar):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_ChangeAZPass_102';
  function IC_Fuse_102(icdev:longint):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_Fuse_102';
  {4406 function.}
  function IC_RValue(icdev:longint):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_RValue';
  function IC_DEValue(icdev:longint):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_DEValue';
  {1604 function.}
  function IC_ChangePass_1604(icdev:longint;area:smallint;password:pchar):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_ChangePass_1604';
  function IC_CheckPass_1604(icdev:longint;area:smallint;password:pchar):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_CheckPass_1604';
  function IC_ReadCount_1604(icdev:longint):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_ReadCount_1604';
  function IC_Fuse_1604(icdev:longint):smallint;stdcall;
  far;external 'ic32.dll' name 'IC_Fuse_1604';
implementation

{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
  st: smallint;
  len: smallint;
  s: pchar;
  stringtemp: string[128];
  wdata: single;
  rdata: single;
begin
  {this pro must can use in you system. the 2 is the result in the screen.}
  {len:=add_s(1);
  str(len,s);
  showmessage(s);
  exit;}
  {next,you should to use com1,else you must change 0 to other.}
  s:=stralloc(100);
  if icdev>=0 then
  begin
     st:=IC_Status(icdev);
     if st<>0 then
     begin
       showmessage('system error. you must exit the program and retry again...');
       exit;
     end;
     if st=1 then
        begin
        showmessage('Please insert card.');
        exit;
        end
     else
        begin
        st:=IC_InitType(icdev,64);
        if st=0 then
           begin
             stringtemp:=writedata.text;
             strpcopy(s,stringtemp);
             len:=strlen(s);
             if len=0 then
             begin
                showmessage('you should write some data...');
                exit;
             end;
             st:=IC_Write(icdev,32,len,s);
             if st<>0 then
             begin
                showmessage('write is error.');
                exit;
             end;
             st:=IC_Read(icdev,32,len,s);
             if st=0 then
                begin
                s[len]:=#0;
                readdata2.text:=strpas(s);
                end
             else
                showmessage('read is bad...');
             st:=IC_Read(icdev,0,12,s);
             if st=0 then
                begin
                s[12]:=#0;
                readdata1.text:=strpas(s);
                end
             else
                showmessage('read is bad...');
             wdata:=1.2345678;
             st:=IC_Write_Float(icdev,0,wdata);
             if st<0 then
             begin
                showmessage('read_flaot unsuccseccful');
                exit;
             end;
             st:=IC_Read_Float(icdev,0,addr(rdata));
             if st<0 then
             begin
                showmessage('write_float is unsuccseccful');
                exit;
             end;
             {FloatToStrF(rdata,ffGenera,7,1)}
             stringtemp:=FloatToStr(rdata);
             showmessage(stringtemp);
           end
        else
           showmessage('initcard error.');
        end;
  end;
  StrDispose(s);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
   password102: pchar;
   st: smallint;
begin
   password102:=stralloc(4);
   password102:=chr(240)+chr(240);
   st:=IC_InitType(icdev,32);
   if st>=0 then
   begin
      st:=IC_CheckPass_102(icdev,password102);
      if st<0 then
         showmessage('the password is not 0xf0f0.')
      else
         showmessage('the password ok!');
    end
    else
       showmessage('inittype 102 is error.');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  icdev:=IC_InitComm(0);
  if icdev<0 then
  begin
      showmessage('error to initcomm.');
      exit;
  end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
  st:integer;
begin
  st:=IC_ExitComm(icdev);
  if st<0 then
  begin
     showmessage('error on exitcomm.');
     exit;
  end;
end;
end.