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

news/2024/5/17 16:46:10 标签: Delphi, TCP, Server, 端口侦听, RFID

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

Delphi">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.

 


http://www.niftyadmin.cn/n/5168335.html

相关文章

react 修改less文件后保存，内存溢出，项目崩溃问题解决

react 修改less文件后保存，内存溢出，项目崩溃问题解决

一、完整报错 一个很老的react项目&#xff0c;因为没有package-lock.json版本锁&#xff0c;导致拉下来的时候&#xff0c;安装的依赖版本冲突&#xff0c;好不容易启动起来&#xff0c;修改less文件后只要一保存&#xff0c;项目就会崩溃&#xff0c;需要重启&#xff0c;报…
阅读更多...
【ATTCK】MITRE Caldera 朴素贝叶斯规划器

【ATTCK】MITRE Caldera 朴素贝叶斯规划器

CALDERA是一个由python语言编写的红蓝对抗工具&#xff08;攻击模拟工具&#xff09;。它是MITRE公司发起的一个研究项目&#xff0c;该工具的攻击流程是建立在ATT&CK攻击行为模型和知识库之上的&#xff0c;能够较真实地APT攻击行为模式。 通过CALDERA工具&#xff0c;安全…
阅读更多...
常见产品结构四大类型 优劣势比较

常见产品结构四大类型 优劣势比较

一般&#xff0c;我们通过产品架构来构建用户体验&#xff0c;这样可以提供更清晰的导航和组织、优化用户流程和交互、增强产品的可扩展性和可维护性&#xff0c;提升用户的满意度和忠诚度。如果没有明确的产品结构&#xff0c;可能会导致功能冗余或功能缺失、交互流程混乱等问…
阅读更多...
2011年06月30日 Go生态洞察：Go中的一等函数

2011年06月30日 Go生态洞察：Go中的一等函数

&#x1f337;&#x1f341; 博主猫头虎&#xff08;&#x1f405;&#x1f43e;&#xff09;带您 Go to New World✨&#x1f341; &#x1f984; 博客首页——&#x1f405;&#x1f43e;猫头虎的博客&#x1f390; &#x1f433; 《面试题大全专栏》 &#x1f995; 文章图文…
阅读更多...
变分自编码器 / 概率分布的重新理解 感觉悟了很多

变分自编码器 / 概率分布的重新理解 感觉悟了很多

概率分布的深刻含义 概率论当时其实学过&#xff0c;就是参数估计的内容&#xff0c;但后边有些遗忘且在代码实现上没有灵活运用&#xff0c;建模一个概率分布&#xff0c;现在个人看来就是创建一种“某种特定规律的可能性集合”&#xff08;自己的理解不一定对&#xff09;&am…
阅读更多...
C语言求解：有n个人围成一圈，顺序排号。从第一个人开始报数（从1到3报数），凡报到3的人退出圈子，问最后留下的是原来第几号的那位（约瑟夫问题）

C语言求解：有n个人围成一圈，顺序排号。从第一个人开始报数（从1到3报数），凡报到3的人退出圈子，问最后留下的是原来第几号的那位（约瑟夫问题）

完整代码&#xff1a; /* 有n个人围成一圈&#xff0c;顺序排号。从第一个人开始报数&#xff08;从1到3报数&#xff09;&#xff0c;凡报到3的人 退出圈子&#xff0c;问最后留下的是原来第几号的那位*/ #include<stdio.h>//约瑟夫问题 //递推关系f(n)(f(n-1)2)\mod n…
阅读更多...
前端训练营：1v1私教，帮你拿到满意的offer

前端训练营：1v1私教，帮你拿到满意的offer

Hello&#xff0c;大家好&#xff0c;我是 Sunday。 熟悉我的小伙伴都知道&#xff0c;我最近这几年一直在做前端教育相关的工作。因为这类工作的原因&#xff0c;让我深刻的感受到这几年整个互联网行业的变化。 大量的公司裁员&#xff0c;导致找工作的人急速增加&#xff0…
阅读更多...
LCD婴儿电子秤pcba/芯片方案设计

LCD婴儿电子秤pcba/芯片方案设计

一、LCD婴儿秤方案技术规格 1&#xff0e;额定量程&#xff1a;20Kg 2&#xff0e;分度值&#xff1a;D10g、0.02LB 3&#xff0e;最小秤量&#xff1a;20G. 4&#xff0e;单位&#xff1a;KG/LB/LB&#xff1a;OZ 5&#xff0e;归零范围&#xff1a;满量程 6&#xff0e;低压侦…
阅读更多...
最新文章

Copyright @ 2022~2023