unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls,ShellApi;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    fh: TLabeledEdit;
    kh: TLabeledEdit;
    Button4: TButton;
    Button5: TButton;
    memo1: TMemo;
    DateTimePicker1: TDateTimePicker;
    CheckBox1: TCheckBox;
    Label1: TLabel;
    DateTimePicker2: TDateTimePicker;
    Memo2: TMemo;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    DateTimePicker3: TDateTimePicker;
    DateTimePicker4: TDateTimePicker;
    Button6: TButton;
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
//    procedure Button6Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Msg(s:string);
    procedure FormCreate(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TBase=class
  public
    procedure done;
  end;

  TDerive=class(TBaSE)
  public
    procedure done;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
type
  TCardInfo=Record
    room:array[0..5] of char;
    cardno:array[0..5] of char;
    sdt:array[0..4] of word;
    edt:array[0..4] of word;
  end;


procedure TBase.done;
begin
  Showmessage('TBase.do');
end;

procedure TDerive.done;
begin
  Showmessage('TDerive.do');
end;

function openport:integer;stdcall;external 'lf.dll';
//function openport(port:integer):integer;stdcall;external 'lf.dll';
function Closeport():integer;stdcall;external 'lf.dll';
function readcard(var cardinfo:TCardInfo):integer;stdcall;external 'lf.dll'  ;

function writecard(s:string):integer;stdcall;external 'lf.dll'  ;
function clearcard():integer;stdcall;  external 'lf.dll'  ;


procedure TForm1.Button3Click(Sender: TObject);
begin
   Closeport();
end;

procedure TForm1.Button2Click(Sender: TObject);

var
  result:integer;
  cardinfo:Tcardinfo;
begin
   result:=readcard(cardinfo);
   if result=0 then begin
     fh.Text:=cardinfo.room;
     kh.Text:=cardinfo.cardno;
   end
   else
   begin
     fh.Text:='';
     kh.Text:='';
   end;
   Msg('ReadCard='+inttostr(result))
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  result:integer;
begin
   result:=clearcard();
   Msg('ClearCard='+inttostr(result))
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  result:integer;
begin
  result:=openport;
//  result:=openport(strtoint(LabeledEdit3.text));
  Msg('opercard='+inttostr(result))
end;



procedure TForm1.Msg(s:string);
begin
  memo1.Lines.Add(s);
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  s:string;
  i:integer;
begin
  if checkbox1.checked then s:='01' else s:='00';
  if length(fh.text) <>6 then begin
    msg('房间必须6位');
    exit;
  end;
  s:=s+fh.text;

  s:=s+formatdatetime('yyyy-mm-dd',DateTimePicker1.date);
  s:=s+formatdatetime('hh:nn',DateTimePicker2.time);
  if length(kh.text) <>6 then begin
    msg('卡号必须6位');
    exit;
  end;
   s:=s+kh.text;
   
  if length(s)<>29 then begin
    msg('长度必须为29') ;
    exit;
  end;
  i:=writecard(s);
  Msg(s);
  Msg('writecard = '+inttostr(i));
//             001100522012-02-2112:00123456
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  s: String;
  asPath: String;   //lf_lock.txt文件路径
  F: TextFile;
  fileList: TStringList;
  result: Integer;
begin
  SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
  DateTimePicker1.datetime:=now;
  DateTimePicker2.datetime:=now;

  asPath := ExtractFilePath(Application.ExeName) + 'lf_lock.txt';
  if not (FileExists(asPath)) then
  begin
     AssignFile(F,asPath);
     Rewrite(F);
     Writeln(F,'制卡失败，无制卡数据!');
     CloseFile(F);
     halt;
  end;
  
  //加个try..catch 发生异常，将以定内容文件中(先请容文件再写入)，然后退出程序，内容为:'制卡失败,程序异常。'
  try
    //1.将程序目录下lf_lock.txt文件中的第一行读取出来赋给s;
    fileList := TStringList.Create;
    fileList.LoadFromFile(asPath);
    s := fileList.Strings[0];
    fileList.Free;
    //ShowMessage(s) ;

    //2.调用openport函数，如果返回值不回0，则值返回值写回lf_lock.txt文件中,写入文件中的内容为(先清空文件再写入)：'打开端口失败，返回:' + inttostr(result)
    result := openport();
    if (FileExists(asPath)) then
    begin
      DeleteFile(asPath);  //删除文件
    end;
    if result <> 0 then begin
      //将内容写入lf_lock.txt(先清空文件再写入),写入的内容是：'打开端口失败，返回:' + inttostr(result)
      AssignFile(F,asPath);
      Rewrite(F);
      Writeln(F,'打开端口失败，返回:' + inttostr(result));
      CloseFile(F);
      halt;
    end;

    //3.调用writecard函数，如果返回值不回0，则值返回值写回lf_lock.txt文件中,写入文件中的内容为(先清空文件再写入)：'打开端口失败，返回:' + inttostr(result)
    result := writecard(s);
    if result <> 0 then begin
      //将内容写入lf_lock.txt(先清空文件再写入),写入的内容是：'打开端口失败，返回:' + inttostr(result)
      AssignFile(F,asPath);
      Rewrite(F);
      Writeln(F,'制卡失败，返回:' + inttostr(result));
      CloseFile(F);
      halt;
    end;

    //4.调用closeport()函数。
    Closeport();

    //5.将‘0’写入lf_lock.txt文件中(先清空文件再写入)。
    AssignFile(F,asPath);
    Rewrite(F);
    Writeln(F,'0');
    CloseFile(F);
  except
     AssignFile(F,asPath);
     Rewrite(F);
     Writeln(F,'制卡失败,程序异常!');
     CloseFile(F);
  end;

	//6.即出程序。
	halt;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
close;
end;

end.
