爱迪尔门锁 A90 V7.31接口范例

【例子介绍】

爱迪尔门锁接口范例程序。

适用门锁系统：V6.51及以上版本。

【相关图片】

【源码结构】

unit FMAIN;

interface

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

CONST
    LOCK3200=1;
    LOCK3200K=2;
    LOCK4200=3;
    LOCK4200D=4;
    LOCK5200=5;
    LOCK6200=6;
    LOCK7200=7;
    LOCK7200D=8;
    LOCK9200=9;
    LOCK9200T=10;

    Adel3200=11;
    Adel4200=12;
    Adel4200D=13;
    Adel5200=14;
    Adel6200=15;
    Adel7200=16;
    Adel7200D=17;
    Adel9200=18;

    Lock611=19;
    Lock612D=20;

    A92=22;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Edit1: TEdit;
    Label3: TLabel;
    ComboBox2: TComboBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Panel2: TPanel;
    Label5: TLabel;
    Edit2: TEdit;
    Label6: TLabel;
    Edit3: TEdit;
    BitBtn3: TBitBtn;
    Panel3: TPanel;
    Label7: TLabel;
    Label8: TLabel;
    Edit4: TEdit;
    Edit5: TEdit;
    BitBtn4: TBitBtn;
    Label9: TLabel;
    Edit6: TEdit;
    Label10: TLabel;
    Edit7: TEdit;
    Label11: TLabel;
    Edit8: TEdit;
    Label12: TLabel;
    Edit9: TEdit;
    Label13: TLabel;
    Edit10: TEdit;
    Label14: TLabel;
    Edit11: TEdit;
    CheckBox2: TCheckBox;
    Panel4: TPanel;
    Label15: TLabel;
    Edit12: TEdit;
    Label16: TLabel;
    Edit13: TEdit;
    BitBtn5: TBitBtn;
    BitBtn6: TBitBtn;
    BitBtn7: TBitBtn;
    BitBtn8: TBitBtn;
    Label4: TLabel;
    ComboBox3: TComboBox;
    Label17: TLabel;
    ComboBox4: TComboBox;
    Panel5: TPanel;
    Button1: TButton;
    Panel6: TPanel;
    Label22: TLabel;
    Edit17: TEdit;
    Edit18: TEdit;
    Label23: TLabel;
    Edit19: TEdit;
    Label24: TLabel;
    Button5: TButton;
    Button6: TButton;
    Label25: TLabel;
    ComboBox1: TComboBox;
    BitBtn9: TBitBtn;
    Panel7: TPanel;
    Label26: TLabel;
    Edit20: TEdit;
    Button7: TButton;
    Label27: TLabel;
    SpinEdit1: TSpinEdit;
    Label28: TLabel;
    SpinEdit2: TSpinEdit;
    Label18: TLabel;
    Edit15: TEdit;
    Button3: TButton;
    Label21: TLabel;
    Edit16: TEdit;
    Button4: TButton;
    Panel8: TPanel;
    Label2: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    Label29: TLabel;
    Label30: TLabel;
    Edit14: TEdit;
    Edit21: TEdit;
    Button8: TButton;
    Edit22: TEdit;
    Button9: TButton;
    ComboBox5: TComboBox;
    Label31: TLabel;
    ComboBox6: TComboBox;
    ComboBox7: TComboBox;
    Label32: TLabel;
    ComboBox8: TComboBox;
    Panel9: TPanel;
    Edit23: TEdit;
    Label33: TLabel;
    Label34: TLabel;
    Edit24: TEdit;
    Button2: TButton;
    Label35: TLabel;
    Edit25: TEdit;
    Label36: TLabel;
    Edit26: TEdit;
    Label37: TLabel;
    Edit27: TEdit;
    Label38: TLabel;
    Edit28: TEdit;
    Button10: TButton;
    Edit29: TEdit;
    Button11: TButton;
    Button12: TButton;
    Button13: TButton;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure BitBtn7Click(Sender: TObject);
    procedure BitBtn8Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button20Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure BitBtn9Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
  private
    { Private declarations }
    software,sound:integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

    FUNCTION Init(SOFT:INTEGER;SERVER,UNAME:PCHAR;PORT,ENCODERTYPE,TMENCODER:INTEGER):INTEGER; stdcall external 'MainDll.Dll';
    function EndSession:integer;stdcall external 'MainDll.Dll';

    function PopCard:integer;STDCALL external 'MainDll.Dll';

    FUNCTION NewKey(ROOMNO,GATE,STIME,GUESTNAME,GUESTID:PCHAR;OVERFLAG:INTEGER;CARDNO:PINTEGER;str1,str2:pchar):INTEGER;STDCALL external 'MainDll.Dll';
    FUNCTION AddKey(ROOMNO,GATE,STIME,GUESTNAME,GUESTID:PCHAR;OVERFLAG:INTEGER;CARDNO:PINTEGER;str1,str2:pchar):INTEGER;STDCALL  external 'MainDll.Dll';
    FUNCTION DupKey(ROOMNO,GATE,STIME,GUESTNAME,GUESTID:PCHAR;OVERFLAG:INTEGER;CARDNO:PINTEGER;str1,str2:pchar):INTEGER;STDCALL  external 'MainDll.Dll';

    function ReadCard(ROOMNO,GATE,STIME,GUESTNAME,GUESTID,track1,track2:pchar;CARDNO,st:pinteger):integer;stdcall external 'MainDll.Dll';

    function EraseCard(cardno:integer;str1,str2:pchar):integer;stdcall external 'MainDll.Dll';
    FUNCTION CheckOut(ROOMNO:PCHAR;CARDNO:INTEGER):INTEGER;STDCALL external 'MainDll.Dll';
    FUNCTION LostCard(ROOMNO:PCHAR;CARDNO:INTEGER):INTEGER;STDCALL external 'MainDll.Dll';

    FUNCTION SetPort(SOFT,PORT,ENCODERTYPE,TMENCODER:INTEGER):INTEGER;STDCALL external 'MainDll.Dll';

    FUNCTION ReadCardId(CardId:PDWORD):INTEGER;STDCALL external 'MainDll.Dll';

    function WriteMagCard(track1,track2,track3:pchar):integer;stdcall external 'MainDll.Dll';
    function ReadMagCard(track1,track2,track3:pchar):integer;stdcall external 'MainDll.Dll';

    function CheckSC(sc:pchar):integer;stdcall external 'MainDll.Dll';
    function ReadIC(start,len:integer;buff:pchar):integer;stdcall external 'MainDll.Dll';
    function WriteIC(start,len:integer;buff:pchar):integer;stdcall external 'MainDll.Dll';

    Function GetCardInfo(cardno,cardtype:integer;cardst:pinteger;roomno,username,stime:pchar):integer;STDCALL external 'MainDll.Dll';
    Function GetBuffInfo(buff:pchar;len:integer;cardtype,cardst,cardno:pinteger;roomno,username,stime:pchar):integer;STDCALL external 'MainDll.Dll';
    Function GetMagBuffInfo(buff:pchar;cardtype,cardst,cardno:pinteger;roomno,username,stime:pchar):integer;STDCALL external 'MainDll.Dll';

    function Reader_Beep(sound:integer):integer;stdcall external 'MainDll.Dll';

implementation

{$R *.dfm}

CONST
    SOFTNAMES:array[1..22] of string=('Lock3200','Lock3200K','Lock4200',
       'Lock4200D','Lock5200','Lock6200','Lock7200','Lock7200D',
       'Lock9200','Lock9200T','A30','A40','A41','A50',
       'A60','A70','A71','A90','Lock611','Lock612D','A91','A92');

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     endsession;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
   i,TMTYPE:integer;
   s:string;
begin
     s:=trim(edit1.Text);
     if s='' then
        exit;
     TMTYPE:=COMBOBOX4.ItemIndex;
     IF TMTYPE=0 THEN
        TMTYPE:=5;
     i:=init(software,pchar(s),'TestUser',combobox2.itemindex,COMBOBOX3.ITEMINDEX,TMTYPE);
     showmessage('Result: ' inttostr(i));
     combobox1.Enabled:=i<>0;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
     showmessage('Result: ' inttostr(endsession));
     combobox1.Enabled:=true;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
VAR
   I:INTEGER;
   ROOM,STIME,GNAME,GID,gate:ARRAY[0..50] OF CHAR;
   CARDNO,ST:INTEGER;
begin
      edit4.text:='';
      edit5.text:='';
      edit6.text:='';
      edit7.text:='';
      edit8.text:='';
      I:=READCARD(ROOM,gate,STIME,GNAME,GID,NIL,NIL,@CARDNO,@ST);
      SHOWMESSAGE('Result: ' inttostr(i));
      if i=0 then begin
         EDIT4.TEXT:=TRIM(ROOM);
         EDIT5.TEXT:=TRIM(STIME);
         EDIT6.TEXT:=INTTOSTR(CARDNO);
         EDIT7.TEXT:=TRIM(GNAME);
         EDIT8.TEXT:=inttostr(ST);
      end;
end;

procedure TForm1.BitBtn6Click(Sender: TObject);
VAR
   ROOM:STRING;
   CARDNO,I:INTEGER;
begin
     ROOM:=EDIT13.Text;
     IF LENGTH(ROOM)<>6 THEN BEGIN
        EDIT13.SETFOCUS;
        EXIT;
     END;
     TRY
        CARDNO:=STRTOINT(EDIT12.Text);
     EXCEPT
        EDIT12.SETFOCUS;
        EXIT;
     END;
     I:=CHECKOUT(PCHAR(ROOM),CARDNO);
     SHOWMESSAGE('Result: ' inttostr(i));
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
VAR
   I,CARDNO,OVERFLAG:INTEGER;
   ROOM,STIME,GNAME,GID:STRING;
begin
     IF CHECKBOX2.Checked THEN
        OVERFLAG:=1
     ELSE
        OVERFLAG:=0;
     ROOM:=EDIT2.TEXT;
     STIME:=EDIT3.TEXT;
     GNAME:=EDIT10.TEXT;
     GID:=EDIT11.Text;
     IF LENGTH(ROOM)<>6 THEN BEGIN
        EDIT2.SetFocus;
        EXIT;
     END;
     IF LENGTH(STIME)<>24 THEN BEGIN
        EDIT3.SetFocus;
        EXIT;
     END;
     EDIT9.TEXT:='';
     I:=NewKey(PCHAR(ROOM),nil,PCHAR(STIME),PCHAR(GNAME),PCHAR(GID),OVERFLAG,@CARDNO,NIL,NIL);
     EDIT9.TEXT:=INTTOSTR(CARDNO);
     SHOWMESSAGE('Result: ' inttostr(i));
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
VAR
     I,CARDNO:INTEGER;
BEGIN
    TRY
       CARDNO:=STRTOINT(EDIT12.TEXT);
    EXCEPT
       EDIT12.SETFOCUS;
       EXIT;
    END;
    I:=ERASECARD(CARDNO,nil,nil);
    SHOWMESSAGE('Result: ' inttostr(i));
END;

procedure TForm1.BitBtn7Click(Sender: TObject);
begin
     popcard;
end;

procedure TForm1.BitBtn8Click(Sender: TObject);
VAR
   ROOM:STRING;
   CARDNO,I:INTEGER;
begin
     ROOM:=EDIT13.Text;
     IF LENGTH(ROOM)<>6 THEN BEGIN
        EDIT13.SETFOCUS;
        EXIT;
     END;
     TRY
        CARDNO:=STRTOINT(EDIT12.Text);
     EXCEPT
        EDIT12.SETFOCUS;
        EXIT;
     END;
     I:=lostcard(PCHAR(ROOM),CARDNO);
     SHOWMESSAGE('Result: ' inttostr(i));
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   i,TMTYPE:integer;
begin
     TMTYPE:=COMBOBOX4.ItemIndex;
     IF TMTYPE=0 THEN
        TMTYPE:=5;
     i:=setport(software,combobox2.itemindex,COMBOBOX3.ITEMINDEX,TMTYPE);
     showmessage('Result: ' inttostr(i));
end;

procedure TForm1.Button20Click(Sender: TObject);
var
   i:integer;
   pass:array[0..3] of byte;
begin
     for i:=1 to 3 do begin
        try
           pass[i-1]:=strtoint('$' copy(edit20.text,i*2-1,2));
        except
           beep;
           messagebox(handle,'数据错误！','提示信息',16);
           edit20.SetFocus;
           exit;
        end;
     end;
     i:=checksc(@pass[0]);
     showmessage('Result: ' inttostr(i));
end;

procedure TForm1.Button3Click(Sender: TObject);
var
   i,j:integer;
   s:string;
   buff:array[0..31] of byte;
begin
     i:=readic(spinedit1.Value,spinedit2.Value,@buff[0]);
     if i=0 then begin
        s:='';
        for j:=0 to spinedit2.Value-1 do
           s:=s inttohex(buff[j],2);
        edit15.Text:=s;
     end;
     showmessage('Result: ' inttostr(i));
end;

procedure TForm1.Button4Click(Sender: TObject);
var
   i:integer;
   buff:array[0..31] of byte;
begin
     for i:=1 to spinedit2.Value do begin
        try
           buff[i-1]:=strtoint('$' copy(edit16.text,i*2-1,2));
        except
           beep;
           messagebox(handle,'数据错误！','提示信息',16);
           edit16.SetFocus;
           exit;
        end;
     end;
     i:=writeic(spinedit1.Value,spinedit2.Value,@buff[0]);
     showmessage('Result: ' inttostr(i));
end;

procedure TForm1.Button5Click(Sender: TObject);
var
   i:integer;
   buff1,buff2,buff3:array[0..256] of char;
begin
     i:=readmagcard(buff1,buff2,buff3);
     if i=0 then begin
        edit17.Text:=trim(buff1);
        edit18.Text:=trim(buff2);
        edit19.Text:=trim(buff3);
     end;
     showmessage('Result: ' inttostr(i));
end;

procedure TForm1.Button6Click(Sender: TObject);
var
   i:integer;
   buff1,buff2,buff3:string;
begin
     buff1:=trim(edit17.Text);
     buff2:=trim(edit18.Text);
     buff3:=trim(edit19.Text);
     i:=writemagcard(pchar(buff1),pchar(buff2),pchar(buff3));
     showmessage('Result: ' inttostr(i));
end;

procedure TForm1.FormShow(Sender: TObject);
var
   i:integer;
begin
     sound:=11;
     for i:=lock3200 to lock9200t do
        combobox1.Items.Add(softnames[i]);
     combobox1.Items.Add(softnames[adel3200]);
     combobox1.Items.Add(softnames[adel5200]);
     combobox1.Items.Add(softnames[adel9200]);
     combobox1.Items.Add(softnames[a92]);

     combobox1.ItemIndex:=0;

     for i:=0 to 15 do
        combobox6.Items.Add(inttostr(i));
     for i:=0 to 3 do
        combobox7.Items.Add(inttostr(i));
     for i:=1 to 3 do
        combobox8.Items.Add(inttostr(i*16));
     combobox6.ItemIndex:=0;
     combobox7.ItemIndex:=0;
     combobox8.ItemIndex:=0;

     edit3.Text:=formatdatetime('yyyymmdd',date()) '1200'
        formatdatetime('yyyymmdd',date() 1) '1200';

     ComboBox1Change(sender);
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
var
   i:integer;
begin
     for i:=1 to 22 do
        if softnames[i]=combobox1.Text then
           break;
     software:=i;
     panel8.Visible:=software in [adel9200,a92];
     panel7.Visible:=not panel8.Visible;
end;

procedure TForm1.BitBtn9Click(Sender: TObject);
VAR
   I,CARDNO,OVERFLAG:INTEGER;
   ROOM,STIME,GNAME,GID:STRING;
begin
     IF CHECKBOX2.Checked THEN
        OVERFLAG:=1
     ELSE
        OVERFLAG:=0;
     ROOM:=EDIT2.TEXT;
     STIME:=EDIT3.TEXT;
     GNAME:=EDIT10.TEXT;
     GID:=EDIT11.Text;
     IF LENGTH(ROOM)<>6 THEN BEGIN
        EDIT2.SetFocus;
        EXIT;
     END;
     IF LENGTH(STIME)<>24 THEN BEGIN
        EDIT3.SetFocus;
        EXIT;
     END;
     EDIT9.TEXT:='';
     I:=DupKey(PCHAR(ROOM),nil,PCHAR(STIME),PCHAR(GNAME),PCHAR(GID),OVERFLAG,@CARDNO,NIL,NIL);
     EDIT9.TEXT:=INTTOSTR(CARDNO);
     SHOWMESSAGE('Result: ' inttostr(i));
end;

procedure TForm1.Button8Click(Sender: TObject);
var
   s:string;
   i,j,start,len:integer;
   buff:array[0..63] of byte;
begin
     s:='';
     start:=combobox7.ItemIndex or (combobox6.ItemIndex shl 8);
     len:=strtoint(combobox8.Text);
     buff[0]:=combobox5.itemindex;

     for i:=1 to 6 do begin
        try
           buff[i]:=strtoint('$' copy(edit14.Text,i*2-1,2));
        except
           beep;
           messagebox(handle,'数据错误！','提示信息',16);
           edit14.SetFocus;
           exit;
        end;
     end;
     i:=readic(start,len,@buff[0]);
     if i=0 then
        for j:=0 to len-1 do
           s:=s inttohex(buff[j],2);
     edit21.Text:=s;
     SHOWMESSAGE('Result: ' inttostr(i));
end;

procedure TForm1.Button9Click(Sender: TObject);
var
   i,start,len:integer;
   buff:array[0..64] of byte;
begin
     start:=combobox7.ItemIndex or (combobox6.ItemIndex shl 8);
     len:=strtoint(combobox8.Text);

     ZeroMemory(@buff[0],64);
     buff[0]:=combobox5.itemindex;

     for i:=1 to 6 do begin
        try
           buff[i]:=strtoint('$' copy(edit14.Text,i*2-1,2));
        except
           beep;
           messagebox(handle,'数据错误！','提示信息',16);
           edit14.SetFocus;
           exit;
        end;
     end;
     for i:=1 to len do begin
        if copy(edit22.Text,i*2-1,2)='' then
           continue;
        try
           buff[i 6]:=strtoint('$' copy(edit22.Text,i*2-1,2));
        except
           beep;
           messagebox(handle,'数据错误！','提示信息',16);
           edit22.SetFocus;
           exit;
        end;
     end;
     i:=writeic(start,len,@buff[0]);
     SHOWMESSAGE('Result: ' inttostr(i));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
   i,cardno,cardtype,cardst:integer;
   room,user,stime:array[0..63] of char;
begin
     try
        cardno:=strtoint(edit23.Text);
     except
        edit23.SetFocus;
        exit;
     end;
     try
        cardtype:=strtoint(edit24.Text);
     except
        edit24.SetFocus;
        exit;
     end;
     i:=GetCardInfo(cardno,cardtype,@cardst,@room[0],@user[0],@stime[0]);
     if i=0 then begin
        edit25.Text:=inttostr(cardst);
        edit26.Text:=user;
        edit27.Text:=room;
        edit28.Text:=stime;
     end else begin
        edit25.Text:='';
        edit26.Text:='';
        edit27.Text:='';
        edit28.Text:='';
     end;
     showmessage('Result: ' inttostr(i));
end;

procedure TForm1.Button10Click(Sender: TObject);
var
   i:integer;
   cardid:dword;
begin
     edit29.Text:='';
     i:=ReadCardId(@cardid);
     if i=0 then
        edit29.Text:=inttohex(cardid,8);
     showmessage('Result: ' inttostr(i));
end;

procedure TForm1.Button11Click(Sender: TObject);
var
   buff:array[0..127] of byte;
   len,i,cardno,cardtype,cardst:integer;
   room,user,stime:array[0..63] of char;
begin
     len:=(length(edit15.Text)) div 2;
     if len=0 then
        exit;
     for i:=1 to len do begin
        try
           buff[i-1]:=strtoint('$' copy(edit15.text,i*2-1,2));
        except
           beep;
           messagebox(handle,'数据错误！','提示信息',16);
           edit15.SetFocus;
           exit;
        end;
     end;

     i:=GetBuffInfo(@buff[0],len,@cardtype,@cardst,@cardno,@room[0],@user[0],@stime[0]);
     if i=0 then begin
        edit23.Text:=inttostr(cardno);
        edit24.Text:=inttostr(cardtype);
        edit25.Text:=inttostr(cardst);
        edit26.Text:=user;
        edit27.Text:=room;
        edit28.Text:=stime;
     end else begin
        edit23.Text:='';
        edit24.Text:='';
        edit25.Text:='';
        edit26.Text:='';
        edit27.Text:='';
        edit28.Text:='';
     end;
     showmessage('Result: ' inttostr(i));
end;

procedure TForm1.Button12Click(Sender: TObject);
var
   i:integer;
begin
     i:=Reader_Beep(sound);
     if i=0 then begin
        if sound=11 then
           sound:=12
        else if sound=12 then
           sound:=15
        else if sound=15 then
           sound:=16
        else
           sound:=11;
     end;
     showmessage('Result: ' inttostr(i));
end;

procedure TForm1.Button13Click(Sender: TObject);
var
   buff:array[0..127] of char;
   len,i,cardno,cardtype,cardst:integer;
   room,user,stime:array[0..63] of char;
begin
     len:=length(edit19.Text);
     if len=0 then
        exit;

     for i:=1 to len do begin
        try
           strtoint(copy(edit19.text,i,1));
        except
           beep;
           messagebox(handle,'数据错误！','提示信息',16);
           edit19.SetFocus;
           exit;
        end;
     end;

     lstrcpy(buff,pchar(edit19.Text));

     i:=GetMagBuffInfo(@buff[0],@cardtype,@cardst,@cardno,@room[0],@user[0],@stime[0]);
     if i=0 then begin
        edit23.Text:=inttostr(cardno);
        edit24.Text:=inttostr(cardtype);
        edit25.Text:=inttostr(cardst);
        edit26.Text:=user;
        edit27.Text:=room;
        edit28.Text:=stime;
     end else begin
        edit23.Text:='';
        edit24.Text:='';
        edit25.Text:='';
        edit26.Text:='';
        edit27.Text:='';
        edit28.Text:='';
     end;
     showmessage('Result: ' inttostr(i));
end;

end.