unit1.pas

一个RFID上位机软件

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, ActnMenus, ToolWin, ActnMan, ActnCtrls,Registry,
  SPComm, ComCtrls, Grids, ExtCtrls, TeeProcs, TeEngine,
  Chart, Series, StdActns, ImgList, StdCtrls, IdBaseComponent, IdComponent,
  IdUDPBase, IdUDPClient, IdUDPServer, IdSocketHandle;

type
    TMyvalue=Record
      maxdata:Double;
      mindata:Double;
      maxindex:integer;
      minindex:integer;
    end;
    TForm1 = class(TForm)
    Comm1: TComm;
    ActionManager1: TActionManager;
    ActionMainMenuBar1: TActionMainMenuBar;
    Action2: TAction;
    Action3: TAction;
    Action4: TAction;
    Action7: TAction;
    ImageList1: TImageList;
    FileOpen1: TFileOpen;
    FileSaveAs1: TFileSaveAs;
    FilePrintSetup1: TFilePrintSetup;
    FileExit1: TFileExit;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    StringGrid1: TStringGrid;
    StatusBar1: TStatusBar;
    Action1: TAction;
    Action5: TAction;
    Action6: TAction;
    ToolButton3: TToolButton;
    Action8: TAction;
    Action9: TAction;
    ToolButton8: TToolButton;
    UDPClient1: TIdUDPClient;
    UDPServer1: TIdUDPServer;
    procedure FormCreate(Sender: TObject);
    procedure InitReg;
    procedure InitStringGrid;
    procedure Delay(msecs:integer);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure FileSaveAs1Accept(Sender: TObject);
    procedure Action1Execute(Sender: TObject);
    procedure Action2Execute(Sender: TObject);
    procedure Action3Execute(Sender: TObject);
    procedure Action4Execute(Sender: TObject);
    procedure Action5Execute(Sender: TObject);
    procedure Action6Execute(Sender: TObject);
    procedure FileOpen1Accept(Sender: TObject);
    procedure Action7Execute(Sender: TObject);
    procedure Action8Execute(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure Action9Execute(Sender: TObject);
    procedure UDPServer1UDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);


  private
    { Private declarations }
  public
    function CheckConnect:Boolean;
    function ReActive:Boolean;
    function senddata(sbuf:string):Boolean;overload;
    function senddata(sbuf:array of Byte):Boolean;overload;
    { Public declarations }
  end;

var
  Form1: TForm1;
  AckReady,AckReactive:Boolean;
  TagCount:word;
  Packet:Array[1..17] of Byte;

implementation

uses Unit2,Unit3,Unit4;
{$R *.dfm}
//******************************************************
procedure TForm1.FormCreate(Sender: TObject);
var
  MyReg:TRegistry;
begin
  InitReg;
  InitStringGrid;
  MyReg:=TRegistry.Create;
  MyReg.RootKey:=HKEY_LOCAL_MACHINE;
  try
    if MyReg.OpenKey('\SOFTWARE\Reader\',FALSE) then
      begin
         Comm1.CommName:=MyReg.ReadString('COM');
         Comm1.BaudRate:=MyReg.ReadInteger('BaudRate');
      end;
  finally
    MyReg.Free;
  end;
  Comm1.StartComm;

  Packet[1]:=255; Packet[2]:=1;  Packet[3]:=12;  Packet[4]:=65;
  Packet[5]:=48;  Packet[6]:=8;  Packet[7]:=51;  Packet[8]:=178;
  Packet[9]:=221;   Packet[10]:=217; Packet[11]:=1;  Packet[12]:=73;
  Packet[17]:=254;
  //AnimateWindow(Form1.Handle,1000,AW_BLEND);
end;

procedure TForm1.InitReg;        //初始化注册表
var
  MyReg:TRegistry;
begin
  MyReg:=TRegistry.Create;
  MyReg.RootKey:=HKEY_LOCAL_MACHINE;
  try
    if not MyReg.OpenKey('\SOFTWARE\',FALSE) then
      ShowMessage('初始化失败!')
    else
      begin
       MyReg.CreateKey('Reader');
       if not MyReg.OpenKey('\SOFTWARE\Reader',FALSE)then
         begin
           ShowMessage('初始化失败!');
           MyReg.CloseKey;
         end
       else
         begin   //写默认值;
           MyReg.WriteString('COM','COM1');
           MyReg.WriteInteger('BaudRate',9600);
           MyReg.WriteBool('ParityCheck',False);
           MyReg.WriteInteger('Parity',NoParity);
           MyReg.WriteInteger('ByteSize',8);
           MyReg.WriteInteger('StopBits',integer(OneStopBit));
           MyReg.CloseKey;
           StatusBar1.Panels[0].Text:='初始化成功!';
         end;
      end;
  finally
    MyReg.Free;
  end;
end;

procedure TForm1.Delay(msecs:integer);  //延时函数
var
  FirstTickCount:longint;
begin
  FirstTickCount:=integer(GetTickCount);
  repeat
    Application.ProcessMessages;
  until (integer(GetTickCount)-FirstTickCount)>= Longint(msecs);

end;

procedure TForm1.InitStringGrid;
begin
  StringGrid1.Cells[0,0]  :='        序号';
  StringGrid1.Cells[1,0]  :='                          标签ID';
  StringGrid1.Cells[2,0]  :='                   用户信息';
  StringGrid1.Cells[3,0]  :='                  读取时间';
  StringGrid1.ColWidths[0]:=85;
  StringGrid1.ColWidths[1]:=200;
  StringGrid1.ColWidths[2]:=160;
  StringGrid1.ColWidths[3]:=160;
end;

//*****************************************************************
function TForm1.senddata(sbuf:string):Boolean;      //发送字符串
var
  commflg:boolean;
begin
  commflg:=true;
    if not Comm1.Writecommdata(pchar(sbuf),length(sbuf)) then
      begin
        commflg:=false;
        messagedlg('发送失败!',mterror,[mbyes],0);
      end;
  senddata:=commflg;
end;

function TForm1.senddata(sbuf:array of Byte):Boolean;   //发送数组
var
  commflg:boolean;
begin
  commflg:=true;
    if not Comm1.Writecommdata(@sbuf,length(sbuf)) then
      begin
        commflg:=false;
         messagedlg('发送失败!',mterror,[mbyes],0);
      end;
  senddata:=commflg;
end;

procedure TForm1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);                                  // 接收数据
var
  i:integer;
  Viewstring:string;
  rbuf:array[1..16] of char;
  H,M,S,MS:word;
begin
  Viewstring:='';
  move(buffer^,pchar(@rbuf)^,bufferlength);
  if pos('#',uppercase(string(rbuf)))<>0 then
    begin
      TagCount:=TagCount+1;
      if TagCount >= StringGrid1.RowCount then
        StringGrid1.RowCount:=StringGrid1.RowCount+1;
      StringGrid1.Cells[0,TagCount]:='#'+inttostr(TagCount);
      //for i:=2 to bufferlength do
        //viewstring:=viewstring+inttohex(ord(rbuf[i]),2);
      //StringGrid1.Cells[1,TagCount]:=viewstring;
      //StringGrid1.Cells[3,TagCount]:=DateTimeToStr(Now);
      DecodeTime(Now,H,M,S,MS);
      StringGrid1.Cells[3,TagCount]:=IntTOStr(H)+':'+IntToStr(M)+':'+IntTOStr(S)+':'+IntToStr(MS);
      Packet[13]:=byte(rbuf[2]); Packet[14]:=byte(rbuf[3]); Packet[15]:=byte(rbuf[4]); Packet[16]:=byte(rbuf[5]);
      for i:= 5 to length(Packet)-1 do
        viewstring:=viewstring + inttohex(Packet[i],2);
      StringGrid1.Cells[1,TagCount]:=viewstring;
      UDPClient1.SendBuffer(Packet,length(Packet));
      //通过UDPClient发送出去,数据包格式：包头，阅读器ID长度，标签数据长度，阅读器ID，标签数据，包尾
      SendMessage(StringGrid1.Handle,wm_vscroll,sb_linedown,0);
    end
  else if pos('YES',uppercase(string(rbuf)))<>0 then
    AckReady := True
  else if pos('ACK',uppercase(string(rbuf)))<>0 then
    AckReactive := True;
  Form3.memo2.lines.add(rbuf);
end;

//*****************************************************
//该函数用于握手阅读器。发送READY，等待回应YES
function TForm1.CheckConnect:Boolean;
var
  i:integer;
begin
  AckReady:=False;
  StatusBar1.Panels[0].Text:='正在建立连接...';
  if not SendData('READY') then
    begin
      StatusBar1.Panels[0].Text:='发送连接信息时出错！';
      CheckConnect:=False;
      Exit;
    end;
  for i:=1 to 300 do
    begin
      delay(5);
      if AckReady then
        begin
          CheckConnect:= True;
          Exit;                //成功连接
        end;
    end;
    CheckConnect:=False;
end;

//*****************************************************
//该函数用于激活已经灭活的标签。发送REACT，等待回应ACK
function TForm1.ReActive:Boolean;
var
  i:integer;
begin
  AckReactive:=False;
  StatusBar1.Panels[0].Text:='正在重新激活所有标签...';
  if not SendData('REACT') then
    begin
      StatusBar1.Panels[0].Text:='发送激活命令时出错！';
      ReActive:=False;
      Exit;
    end;
  for i:=1 to 300 do
    begin
      delay(5);
      if AckReactive then
        begin
          ReActive:= True;
          Exit;                //成功激活
        end;
    end;
    ReActive:=False;
end;

procedure TForm1.Action1Execute(Sender: TObject);
begin
  StringGrid1.Refresh
end;

procedure TForm1.Action2Execute(Sender: TObject);
begin
  if ToolBar1.Showing then
    ToolBar1.Hide
  else ToolBar1.Show
end;

procedure TForm1.Action3Execute(Sender: TObject);
begin
  if StatusBar1.Showing then
    StatusBar1.Hide
  else StatusBar1.Show
end;

procedure TForm1.Action4Execute(Sender: TObject);
begin
  Form2.Show;
end;

procedure TForm1.Action5Execute(Sender: TObject);
begin
  if CheckConnect then
    StatusBar1.Panels[0].Text:='连接成功！'
  else  StatusBar1.Panels[0].Text:='连接失败，请重试.';
end;

procedure TForm1.Action6Execute(Sender: TObject);
begin
  if ReActive then
    StatusBar1.Panels[0].Text:='已经重新激活所有标签！'
  else  StatusBar1.Panels[0].Text:='激活失败，请重试.';
end;

procedure TForm1.FileOpen1Accept(Sender: TObject);
var
i:integer;
TotalTag:integer;
ReadBufferID:String[8];
ReadBufferTag:String[16];
ReadBufferUsr:String[16];
ReadBufferDate:String[19];
DataRead:TextFile;
begin
  for i:=1 to StringGrid1.RowCount-1 do
    StringGrid1.Rows[i].Clear;
  AssignFile(DataRead,FileOpen1.Dialog.FileName);
  Reset(DataRead);
  ReadLn(DataRead);
  ReadLn(DataRead);
  ReadLn(DataRead,TotalTag);
  if TotalTag> StringGrid1.RowCount then
    StringGrid1.RowCount:=TotalTag;
  for i:=1 to TotalTag do
    begin
      ReadLn(DataRead,ReadBufferID,ReadBufferTag,ReadBufferUsr,ReadBufferDate);
      StringGrid1.Cells[0,i]:=ReadBufferID;
      StringGrid1.Cells[1,i]:=ReadBufferTag;
      StringGrid1.Cells[2,i]:=ReadBufferUsr;
      StringGrid1.Cells[3,i]:=ReadBufferDate;
    end;
  CloseFile(DataRead);
end;

procedure TForm1.FileSaveAs1Accept(Sender: TObject);
var
i:integer;
DataWrite:TextFile;
begin
  AssignFile(DataWrite,FileSaveAs1.Dialog.FileName);
  Rewrite(DataWrite);
  WriteLn(DataWrite,'RFID Reader V1.0');
  WriteLn(DataWrite,DateTimeToStr(Now));
  WriteLn(DataWrite,inttostr(TagCount));
  for i:=1 to TagCount do
    WriteLn(DataWrite,Format('%-8s%-16s%-16s%-19s',['#'+inttostr(i),StringGrid1.Cells[1,i],StringGrid1.Cells[2,i],StringGrid1.Cells[3,i]]));
  CloseFile(DataWrite);
end;

procedure TForm1.Action7Execute(Sender: TObject);
begin
  Form3.Show;
end;

procedure TForm1.Action8Execute(Sender: TObject);
begin
  Form4.Show;
end;

procedure TForm1.ToolButton4Click(Sender: TObject);
begin
  Form1.Close;
end;

procedure TForm1.Action9Execute(Sender: TObject);
var
i,j:integer;
begin
  TagCount:=0;
  StringGrid1.RowCount:=17;
  for i:=0 to 3 do
    for j:=1 to 17 do
      StringGrid1.Cells[i,j]:='';
end;

procedure TForm1.UDPServer1UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
  DataStringStream: TStringStream;
  s: String;
begin
  DataStringStream := TStringStream.Create('');
  try
    DataStringStream.CopyFrom(AData, AData.Size);
    s := 'YES';
    if pos('READY',uppercase(DataStringStream.DataString))<>0   then
      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, s[1], Length(s));
  finally
    DataStringStream.Free;
  end;
end;

end.