Delphi TCP服务端监听端口获取客户端RFID网络读卡器上传的刷卡数据

本示例使用设备介绍：液显WIFI无线网络HTTP协议RFID云读卡器可编程实时可控开关TTS语-淘宝网 (taobao.com) 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ScktComp, StdCtrls, ScktComp7, ExtCtrls,Clipbrd;

type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    ListBox1: TListBox;
    ListBox2: TListBox;
    Button3: TButton;
    CheckBox1: TCheckBox;
    Panel1: TPanel;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    Label6: TLabel;
    Label2: TLabel;
    Edit3: TEdit;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    RichEdit10: TRichEdit;
    UpDown7: TUpDown;
    ComboBox1: TComboBox;
    ComboBox3: TComboBox;
    RichEdit1: TRichEdit;
    UpDown1: TUpDown;
    RichEdit2: TRichEdit;
    UpDown2: TUpDown;
    Label3: TLabel;
    Label5: TLabel;
    Label7: TLabel;
    RadioButton5: TRadioButton;
    RadioButton6: TRadioButton;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    CheckBox2: TCheckBox;
    Label4: TLabel;
    Button8: TButton;
    Button9: TButton;
    procedure ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;Socket: TCustomWinSocket);
    procedure ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure CheckBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    procedure Responsedata();
    procedure GetSenddata(respcode:integer);
    procedure ButtonSend(sendcode:integer);
  public
    { Public declarations }

    ResponseBuff:Array of Byte;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;  Socket: TCustomWinSocket);
begin
  Button3.Click();
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;  Socket: TCustomWinSocket);
begin
   Button3.Click();
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  RemotAddPort,DispStr,HexStr:String;
  i,GetDataLen:integer;
  GetBuff:Array of Byte;
  SendBuff:Array of Byte;
  respcode:integer;
begin
  try
      RemotAddPort:=Socket.RemoteAddress+':'+inttostr(Socket.RemotePort);
      GetDataLen:= Socket.ReceiveLength;
      SetLength(GetBuff, GetDataLen);
      Socket.ReceiveBuf(GetBuff[0],GetDataLen);   //Socket.ReceiveText;
      DispStr:='';
      for i:=0 to GetDataLen-1 do
      begin
         DispStr:=DispStr+inttohex(GetBuff[i],2)+' ';
      end;
      if ListBox2.Count >100 then ListBox2.Clear();
      ListBox2.Items.Add('Get Data From  '+RemotAddPort+' : '+DispStr);

      case GetBuff[0] of
           $C1,$CF:
           begin
                if GetBuff[0]= $C1 then
                    DispStr:='数据解析：IC读卡器上传卡号，'
                else
                    DispStr:='数据解析：IC卡离开读卡器，';

                DispStr := DispStr+'设备IP['+IntToStr(GetBuff[1]) + '.' + IntToStr(GetBuff[2]) + '.' + IntToStr(GetBuff[3]) + '.' + IntToStr(GetBuff[4])+']，';
                DispStr := DispStr+'机号['+IntToStr(GetBuff[5] + GetBuff[6]*256)+']，';
                DispStr := DispStr+'数据包号['+IntToStr(GetBuff[7] + GetBuff[8]*256)+']，';
                DispStr := DispStr+'卡号长度['+IntToStr(GetBuff[9])+']，';
                HexStr:='';
                for i:=10 to 10+GetBuff[9]-1 do
                    HexStr:=HexStr+inttohex(GetBuff[i],2);
                DispStr := DispStr+'16进制卡号['+HexStr+']，';

                HexStr:='';
                for i:=10+GetBuff[9] to GetDataLen-1 do
                    HexStr:=HexStr+inttohex(GetBuff[i],2);
                DispStr := DispStr+'唯一硬件序号['+HexStr+']';

                ListBox2.Items.Add(DispStr);
                ListBox2.Items.Add('');
                listbox2.ItemIndex :=listbox2.Items.Count-1;

                if CheckBox1.Checked then
                begin
                    Responsedata() ;
                    Socket.SendBuf(ResponseBuff[0],Length(ResponseBuff));
                    DispStr:='Send Data To  '+RemotAddPort+' : ';
                    for i:=0 to Length(ResponseBuff)-1 do
                        DispStr:=DispStr+inttohex(ResponseBuff[i],2)+' ';
                    ListBox2.Items.Add(DispStr);
                    ListBox2.Items.Add('');
                    listbox2.ItemIndex :=listbox2.Items.Count-1;
                end;
           end;

           $D1,$DF:
           begin
                if GetBuff[0]= $D1 then
                    DispStr:='数据解析：ID读卡器上传卡号，'
                else
                    DispStr:='数据解析：ID卡离开读卡器，';

                DispStr := DispStr+'设备IP['+IntToStr(GetBuff[1]) + '.' + IntToStr(GetBuff[2]) + '.' + IntToStr(GetBuff[3]) + '.' + IntToStr(GetBuff[4])+']，';
                DispStr := DispStr+'机号['+IntToStr(GetBuff[5] + GetBuff[6]*256)+']，';
                DispStr := DispStr+'数据包号['+IntToStr(GetBuff[7] + GetBuff[8]*256)+']，';
                HexStr:='';
                for i:=9 to 13 do
                    HexStr:=HexStr+inttohex(GetBuff[i],2);
                DispStr := DispStr+'16进制卡号['+HexStr+']，';

                HexStr:='';
                for i:=14 to GetDataLen-1 do
                    HexStr:=HexStr+inttohex(GetBuff[i],2);
                DispStr := DispStr+'唯一硬件序号['+HexStr+']';

                ListBox2.Items.Add(DispStr);
                ListBox2.Items.Add('');
                listbox2.ItemIndex :=listbox2.Items.Count-1;

                if CheckBox1.Checked then
                begin
                    Responsedata() ;
                    Socket.SendBuf(ResponseBuff[0],Length(ResponseBuff));
                    DispStr:='Send Data To  '+RemotAddPort+' : ';
                    for i:=0 to Length(ResponseBuff)-1 do
                        DispStr:=DispStr+inttohex(ResponseBuff[i],2)+' ';
                    ListBox2.Items.Add(DispStr);
                    ListBox2.Items.Add('');
                    listbox2.ItemIndex :=listbox2.Items.Count-1;
                end;
           end;

           $F3:
           begin
                DispStr:='数据解析：读卡器心跳包，';
                DispStr := DispStr+'设备IP['+IntToStr(GetBuff[1]) + '.' + IntToStr(GetBuff[2]) + '.' + IntToStr(GetBuff[3]) + '.' + IntToStr(GetBuff[4])+']，';
                DispStr := DispStr+'机号['+IntToStr(GetBuff[5] + GetBuff[6]*256)+']，';
                DispStr := DispStr+'数据包号['+IntToStr(GetBuff[7] + GetBuff[8]*256)+']，';
                DispStr := DispStr+'心跳包标识['+inttohex(GetBuff[9],2)+']，';
                DispStr := DispStr+'长度['+IntToStr(GetBuff[10])+']，';
                DispStr := DispStr+'继电器状态['+inttohex(GetBuff[11],2)+']，';
                DispStr := DispStr+'输入口状态['+inttohex(GetBuff[12],2)+']，';
                DispStr := DispStr+'随机校验码['+inttohex(GetBuff[13],2)+inttohex(GetBuff[14],2)+inttohex(GetBuff[15],2)+inttohex(GetBuff[16],2)+']，';
                HexStr:='';
                HexStr:='';
                for i:=17 to GetDataLen-1 do
                    HexStr:=HexStr+inttohex(GetBuff[i],2);
                DispStr := DispStr+'唯一硬件序号['+HexStr+']';

                ListBox2.Items.Add(DispStr);
                ListBox2.Items.Add('');
                listbox2.ItemIndex :=listbox2.Items.Count-1;  
           end;
      end;
   except

   end;
end;

procedure TForm1.Responsedata();           //根据选择的回应方式生成回应数据缓冲
begin
  if RadioButton1.Checked then
       GetSenddata(0)
  else
      if RadioButton2.Checked then
          GetSenddata(1)
      else
          if RadioButton3.Checked then
                GetSenddata(2)
          else
                GetSenddata(3);
end;

procedure TForm1.GetSenddata(respcode:integer);         //根据发送方式生成发送数据缓冲
var
delaytime,i,voicelen,displen:integer;
strls,voicestr:string;
begin
  case respcode of
      0:
      begin
           SetLength(ResponseBuff, 39);
           ResponseBuff[0]:=$5A;   //命令字：驱动显示文字+蜂鸣器响声
           ResponseBuff[1]:=$00;   //机号低
           ResponseBuff[2]:=$00;   //机号高，0000表示任意机号
           if(CheckBox2.Checked) then
           begin
               ResponseBuff[3]:=ComboBox1.ItemIndex;   //蜂鸣器响声代码
               if RadioButton6.Checked then  ResponseBuff[3]:=ResponseBuff[3] xor 128; //背光灯状态不改变
           end
           else
           begin
               ResponseBuff[3]:=$ff;          //不响声
               if RadioButton6.Checked then  ResponseBuff[3]:=ResponseBuff[3] xor 127; //背光灯状态不改变
           end;
           delaytime:=StrToInt(RichEdit10.Lines[0]);
           ResponseBuff[4] := delaytime mod 256;    //显示时长
           strls := Edit1.Text + '                                        ';
           for i := 1 to 34 do
               ResponseBuff[4+i] := Byte(strls[i]);
      end;

      1:
      begin
           voicestr:='[v'+ trim(RichEdit2.Lines[0])+']';   //本次播报TTS语音的音量大小，取值范围v0 到 v16
           voicestr:= voicestr+trim(edit3.Text);
           voicelen:=length(voicestr); //语音长度

           displen:=34;             //满屏显示长度

           SetLength(ResponseBuff, 11+displen+voicelen+4);
           ResponseBuff[0]:=$5C;   //命令字：驱动显示文字+蜂鸣器响声+开启继电器+播报TTS语音
           ResponseBuff[1]:=$00;   //机号低
           ResponseBuff[2]:=$00;   //机号高，0000表示任意机号
           if(CheckBox2.Checked) then
           begin
               ResponseBuff[3]:=ComboBox1.ItemIndex;   //蜂鸣器响声代码
               if RadioButton6.Checked then  ResponseBuff[3]:=ResponseBuff[3] xor 128; //背光灯状态不改变
           end
           else
           begin
               ResponseBuff[3]:=$ff;          //不响声
               if RadioButton6.Checked then  ResponseBuff[3]:=ResponseBuff[3] xor 127; //背光灯状态不改变
           end;

           case ComboBox3.ItemIndex of       //开启的继电器号
                 1: ResponseBuff[4]:=$f1;
                 2: ResponseBuff[4]:=$f2;
                 3: ResponseBuff[4]:=$f3;
                 4: ResponseBuff[4]:=$f4;
                 5: ResponseBuff[4]:=$f5;
                 6: ResponseBuff[4]:=$f6;
                 7: ResponseBuff[4]:=$f7;
                 8: ResponseBuff[4]:=$f8;
                 else ResponseBuff[4]:=$f0;
           end;
           delaytime:=StrToInt(RichEdit1.Lines[0]);
           ResponseBuff[5] := delaytime mod 256;
           ResponseBuff[6] := (delaytime div 256) mod 256;

           delaytime:=StrToInt(RichEdit10.Lines[0]);
           ResponseBuff[7] := delaytime mod 256;    //显示时长
           ResponseBuff[8] :=0;
           ResponseBuff[9] :=displen;
           ResponseBuff[10] :=voicelen;

           strls := Edit1.Text + '                                        ';
           for i := 1 to displen do
               ResponseBuff[10+i] := Byte(strls[i]);

           for i := 1 to voicelen do
               ResponseBuff[10+displen+i] := Byte(voicestr[i]);

           ResponseBuff[10+displen+voicelen+1]:=$55; //防干扰固定后缀
           ResponseBuff[10+displen+voicelen+2]:=$aa;
           ResponseBuff[10+displen+voicelen+3]:=$66;
           ResponseBuff[10+displen+voicelen+4]:=$99;
      end;

      2:
      begin
            SetLength(ResponseBuff, 4);
            ResponseBuff[0]:=$96;   //命令字：驱动蜂鸣器响
            ResponseBuff[1]:=$00;   //机号低
            ResponseBuff[2]:=$00;   //机号高，0000表示任意机号
            ResponseBuff[3]:=ComboBox1.ItemIndex;   //蜂鸣器响声代码
      end;

      3:
      begin
            SetLength(ResponseBuff, 6);
            ResponseBuff[0]:=$78;   //命令字：驱动开启继电器
            ResponseBuff[1]:=$00;   //机号低
            ResponseBuff[2]:=$00;   //机号高，0000表示任意机号
            case ComboBox3.ItemIndex of       //开启的继电器号
                 1: ResponseBuff[3]:=$f1;
                 2: ResponseBuff[3]:=$f2;
                 3: ResponseBuff[3]:=$f3;
                 4: ResponseBuff[3]:=$f4;
                 5: ResponseBuff[3]:=$f5;
                 6: ResponseBuff[3]:=$f6;
                 7: ResponseBuff[3]:=$f7;
                 8: ResponseBuff[3]:=$f8;
                 else ResponseBuff[3]:=$f0;
            end;
            delaytime:=StrToInt(RichEdit1.Lines[0]);
            ResponseBuff[4] := delaytime mod 256;
            ResponseBuff[5] := (delaytime div 256) mod 256;
      end;
      4:
      begin
            SetLength(ResponseBuff, 6);
            ResponseBuff[0]:=$78;   //命令字：驱动关闭已开启继电器
            ResponseBuff[1]:=$00;   //机号低
            ResponseBuff[2]:=$00;   //机号高，0000表示任意机号
            case ComboBox3.ItemIndex of       //继电器号
                 1: ResponseBuff[3]:=$e1;
                 2: ResponseBuff[3]:=$e2;
                 3: ResponseBuff[3]:=$e3;
                 4: ResponseBuff[3]:=$e4;
                 5: ResponseBuff[3]:=$e5;
                 6: ResponseBuff[3]:=$e6;
                 7: ResponseBuff[3]:=$e7;
                 8: ResponseBuff[3]:=$e8;
                 else ResponseBuff[3]:=$e0;
            end;
            delaytime:=StrToInt(RichEdit1.Lines[0]);
            ResponseBuff[4] := delaytime mod 256;
            ResponseBuff[5] := (delaytime div 256) mod 256;
      end;
  end;
end;

procedure TForm1.ButtonSend(sendcode:integer);
var
i:integer;
RemotAddPort,DispStr:string;
begin
   if ServerSocket1.Active then
   begin
      i:=ListBox1.ItemIndex ;
      if i>=0 then
      begin
          try
              GetSenddata(sendcode);
              ServerSocket1.Socket.Connections[i].SendBuf(ResponseBuff[0],Length(ResponseBuff));
              RemotAddPort:= ServerSocket1.Socket.Connections[i].RemoteAddress+':'+inttostr(ServerSocket1.Socket.Connections[i].RemotePort);
              DispStr:='Send Data To  '+RemotAddPort+' : ';
              for i:=0 to Length(ResponseBuff)-1 do
                  DispStr:=DispStr+inttohex(ResponseBuff[i],2)+' ';
              ListBox2.Items.Add(DispStr);
              ListBox2.Items.Add('');
              listbox2.ItemIndex :=listbox2.Items.Count-1;
          except
          end;
      end
      else
          Application.MessageBox('请先选择要向其发送指令的在线客户端！', '警告', MB_OK+MB_ICONSTOP);
   end
   else
          Application.MessageBox('请先启动TCP服务监听！', '警告', MB_OK+MB_ICONSTOP);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ButtonSend(0);
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
if ServerSocket1.Active then
  begin
    Button2.Caption := '停止';
  end
else
  begin
    Button2.Click();
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if not ServerSocket1.Active then
  begin
    try
        ServerSocket1.Port := StrToInt(Edit2.Text);
        ServerSocket1.Active := True;
        Button2.Caption := '停止';
        Edit2.Enabled := False;
     except
         Application.MessageBox('启动TCP服务监听失败！可能端口已被其他应用占用。', '警告', MB_OK+MB_ICONSTOP);
     end;
  end
  else
  begin
    ServerSocket1.Active := False;
    Button2.Caption := '启动TCP服务监听';
    Edit2.Enabled := True;
    ListBox1.Items.Clear();
    ListBox2.Items.Clear();
  end;

end;

procedure TForm1.Button3Click(Sender: TObject);
var
  i,links:integer;
begin
  ListBox1.Items.Clear();
  links:=ServerSocket1.Socket.ActiveConnections;
  for i:=0 to links-1 do
  begin
    ListBox1.Items.Add(inttostr(i)+'|'+ServerSocket1.Socket.Connections[i].RemoteAddress+':'+inttostr(ServerSocket1.Socket.Connections[i].RemotePort));
  end;
end;

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

procedure TForm1.Button5Click(Sender: TObject);
begin
  ButtonSend(2);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  ButtonSend(1);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ServerSocket1.Active  then ServerSocket1.Active := False;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  ButtonSend(4);
end;

procedure TForm1.Button8Click(Sender: TObject);
var
 liststr:string;
 i:integer;
begin
  if listbox2.Count <1 then exit;

  liststr:='';
  for i:=0 to ListBox2.Count-1 do
  begin
      ListBox2.ItemIndex:=i;
      liststr:=liststr+ListBox2.Items.Strings[ListBox2.ItemIndex]+#13#10;
  end;
  Clipboard.SetTextBuf(PChar(liststr));
  Application.MessageBox('TCP通讯报文日志已拷贝！', '提示', MB_OK+MB_ICONASTERISK );
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
  ListBox2.Clear();
end;

procedure TForm1.CheckBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if checkbox1.Checked then Panel1.Visible :=true else Panel1.Visible :=false;
end;

end.