rule104.~pas

104规约服务端测试程序

unit Rule104;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  extctrls, scktcomp;

const
  cnDefaultK = 12;		//缺省发送窗口大小
  cnDefaultW = 8;		//缺省接收窗口大小
  cnDefaultPort = 2404;		//缺省侦听端口

  cnDefaultT0 = 30000;		//缺省t0
  cnDefaultT1 = 15000;		//缺省t1
  cnDefaultT2 = 10000;		//缺省t2
  cnDefaultT3 = 18000; //20000;		//缺省t3 改短 2006/01/13
  cnDefaultT4 = 500;		//缺省t4,                       主动上送数据上送最大时延

  BIGLEN = 255;
  cnCallUpTime = 5000;
type
  ClientLink = packed record
    Socket: TCustomWinSocket;
    Buf: array[0..BIGLEN - 1] of Byte;
    Setup: Integer;
    //IptNo: Integer; //接收编号
    Len: Integer; //帧长
    FrameNo: array[0..1] of Byte;
    TESTFR: Boolean; // 网络是否连通
    STARTDT: Boolean; // 是否开始发送数据
    Ploy: Boolean; // 有没有激活连接
    CallUp: Boolean; // 有没有总召唤过
    First: Boolean; //第一次激活
  end;

  PClientLink = ^ClientLink;

  TSocket104 = class
  private
    FClientLinks: TList;
    FTimerTest: TTimer;
    FTimerCallup: TTimer;
    FServerSocket: TServerSocket;
    FActive: Boolean;
    FPort: Integer;
    LCom: Byte; // 高公共地址
    HCom: Byte; // 低公共地址
    procedure OnClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure OnClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure OnClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure OnClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    //周期
    procedure OnTimerTest(Sender: TObject);
    //周期
    procedure OnTimerCallUp(Sender: TObject);
    //连接
    procedure CloseLink(Socket: TCustomWinSocket; No: integer = -1); //关闭连接
    procedure SureFrame(Socket: TCustomWinSocket; FNo: array of Byte); //认可帧编号
    procedure SureTESTFR(Socket: TCustomWinSocket); //确认测试
    procedure SureSTARTDT(Socket: TCustomWinSocket); //确认可以传输数据
    procedure SureSTOPDT(Socket: TCustomWinSocket);
    procedure SetActive(const Value: Boolean);
    procedure SendStart(Socket: TCustomWinSocket);
    procedure SendStop(Socket: TCustomWinSocket);
    procedure CallUp(pcl: PClientLink); //确认总召唤
    procedure SendZero(pcl: PClientLink);
    //处理数据
    procedure DealWith(pcl: PClientLink);
    procedure DealWithYX(pcl: PClientLink); // 遥信
    procedure SetSignalYX(Add: Integer; bPI: Byte);////把遥信状态设置到操作票，add-顺序号，bPI是状态
    procedure DealWithYC(pcl: PClientLink); // 遥测
    procedure DealWithYK(pcl: PClientLink); // 遥控
    procedure DealWithCU(pcl: PClientLink); //召唤相应
          // 五防判断、相应 value = true即可以
    procedure AnswerAsk(pcl: PClientLink; Add: Integer; Value: Boolean);
    //发送
    procedure Send(index:integer; op: byte);

    //辅助
    function IndexOf(Ip: string): integer;
    procedure ClearClientLink(var cl: ClientLink; init: Boolean = False);
    procedure BringBW(pcl: PClientLink ;ftype: Byte; Reason: Word;
      Address: Integer; Info: Byte; SQ: Integer =0);
    function GetLCount(): Integer;
    procedure SaveToFile(const bsign: boolean; var tfs: textFile; const buf: array of byte);
  public
    constructor Create(Post: Integer);
    destructor Destroy(); override;
    procedure AllowControl_104(index:integer; op: byte);
    procedure Sendxyx();
    procedure SureYK(index:integer; op: byte);
    procedure GetState(No: Integer; var Name, State: string);
    property LCount: Integer read GetLCount;
    //procedure Init(Port: Integer; k = 0, w = 0, t0 = 0, t1, t2, t3, t4: Integer);
    //property k: Integer  read Fk write Setk;
    //property w: Integer  read Fw write Setw;
    //property t0: Integer  read Ft0 write Sett0;
    //property t1: Integer  read Ft1 write Sett1;
    //property t2: Integer  read Ft2 write Sett2;
    //property t3: Integer  read Ft3 write Sett3;
    //property t4: Integer  read Ft4 write Sett4;
    //property Port: Integer read FPort write SetPort;
    property Active: Boolean read FActive write SetActive;
    //property Inited: Boolean read FInited write SetInited;
  end;

var
  Socket104: TSocket104;
  LocalPort_104:integer;
  GlobalAdd:integer;//公共地址
  MessageList:TStrings;
procedure InitSocket104Server(active:boolean);
procedure AllowControl(index:integer; op: byte);
procedure Sendxyx_104;

implementation
procedure InitSocket104Server(active:boolean);
begin
  if active then
  begin
    if(not assigned(Socket104)) then
      begin
        if LocalPort_104 > 0 then
          try
            Socket104:= TSocket104.Create(LocalPort_104);
          except
            MessageList.Add('104规约初始化失败');
            FreeAndNil(Socket104);
          end;
      end;
  end
  else
    freeandnil(Socket104);
end;

procedure AllowControl(index:integer; op: byte);
begin
  if Assigned(Socket104) then
    Socket104.AllowControl_104(index, op);
end;
//uses Unit1;

procedure Sendxyx_104;
begin
  if Assigned(Socket104) then
     Socket104.Sendxyx();
end;
{ TSocket104 }

constructor TSocket104.Create(Post: Integer);
begin
  FActive:= False;

  FTimerTest:=TTimer.Create(nil);
  FTimerTest.Interval:= cnDefaultT3;
  FTimerTest.OnTimer:= OnTimerTest;
  FTimerCallup:=TTimer.Create(nil);
  FTimerCallup.Interval:= cnCallUpTime;
  FTimerCallup.OnTimer:= OnTimerCallUp;
  FTimerCallup.Enabled:=true;
  //FInited:= False;
  FClientLinks:=TList.Create;

  LCom:= byte(GlobalAdd); //低公共地址
  HCom:= byte(GlobalAdd shr 8); //高公共地址

  if Post > 0 then
  begin
    FPort:= Post;
    FServerSocket:= TServerSocket.Create(nil);
    FServerSocket.Port:= Post;
    FServerSocket.OnClientConnect:= OnClientConnect;
    FServerSocket.OnClientDisconnect:= OnClientDisconnect;
    FServerSocket.OnClientRead:= OnClientRead;
    FServerSocket.OnClientError:= OnClientError;
    try
      FServerSocket.Open;
    except
      MessageList.Add('端口打开错误');
    end;
      MessageList.Add('端口打开OK');
  end;

  FActive:= True
end;

destructor TSocket104.Destroy;
begin
  FTimerCallup.Enabled:=false;
  FreeAndNil(FTimerTest);
  FreeAndNil(FTimerCallup);
  CloseLink(nil);
  FreeAndNil(FClientLinks);
  FreeAndNil(FServerSocket);
  inherited;
end;

function TSocket104.IndexOf(Ip: string): integer;
var
  i: integer;
begin
  Result:= -1;
  for i:=0 to FClientLinks.Count-1 do
  begin
    if ip=PClientLink(FClientLinks[i])^.Socket.RemoteAddress then
    begin
      Result:=i;
      break;
    end;
  end;
end;

procedure TSocket104.OnTimerTest(Sender: TObject);  //调试　不主动关闭连接
var
  buf: array[0..5] of Byte;
  i: Integer;
begin
  buf[0]:= $68;
  buf[1]:= $04;
  buf[2]:= $43; //01000011
  buf[3]:= $00;
  buf[4]:= $00;
  buf[5]:= $00;

  for i:= 0 to FClientLinks.Count - 1 do
  begin
    if not PClientLink(FClientLinks.Items[i])^.TESTFR then
    begin
//      SaveToFile(false,PClientLink(FClientLinks.Items[i])^.fs,buf);
      PClientLink(FClientLinks.Items[i])^.Socket.SendBuf(buf[0], SizeOf(buf));
    end;
    PClientLink(FClientLinks.Items[i])^.TESTFR:= False;
  end;
end;

procedure TSocket104.SetActive(const Value: Boolean);
begin
  FActive := Value;
end;

procedure TSocket104.SureFrame(Socket: TCustomWinSocket; FNo: array of Byte);
var
  buf: array[0..5] of Byte;
begin
  if Length(FNo) <> 2 then
    Exit;

  buf[0]:= $68;
  buf[1]:= $04;
  buf[2]:= $01; //00000001
  buf[3]:= $00;
  buf[4]:= FNo[0] and $FE;
  buf[5]:= FNo[1];
  Socket.SendBuf(buf[0], Length(buf));
end;

procedure TSocket104.SureSTARTDT(Socket: TCustomWinSocket);
var
  buf: array[0..5] of Byte;
begin
  buf[0]:= $68;
  buf[1]:= $04;
  buf[2]:= $0B; //00001011
  buf[3]:= $00;
  buf[4]:= $00;
  buf[5]:= $00;
  Socket.SendBuf(buf[0], Length(buf));
end;

procedure TSocket104.SureTESTFR(Socket: TCustomWinSocket);
var
  buf: array[0..5] of Byte;
begin
  buf[0]:= $68;
  buf[1]:= $04;
  buf[2]:= $83; //10000011
  buf[3]:= $00;
  buf[4]:= $00;
  buf[5]:= $00;
  Socket.SendBuf(buf[0], Length(buf));
end;

procedure TSocket104.SureSTOPDT(Socket: TCustomWinSocket);
var
  buf: array[0..5] of Byte;
begin
  buf[0]:= $68;
  buf[1]:= $04;
  buf[2]:= $23; //00100011
  buf[3]:= $00;
  buf[4]:= $00;
  buf[5]:= $00;
  Socket.SendBuf(buf[0], Length(buf));
end;

procedure TSocket104.SendStart(Socket: TCustomWinSocket);
var
  buf: array[0..5] of Byte;
begin
  buf[0]:= $68;
  buf[1]:= $04;
  buf[2]:= $07; //000000111
  buf[3]:= $00;
  buf[4]:= $00;
  buf[5]:= $00;
  Socket.SendBuf(buf[0], Length(buf));
end;

procedure TSocket104.SendStop(Socket: TCustomWinSocket);
var
  buf: array[0..5] of Byte;
begin
  buf[0]:= $68;
  buf[1]:= $04;
  buf[2]:= $13; //00010011
  buf[3]:= $00;
  buf[4]:= $00;
  buf[5]:= $00;
  Socket.SendBuf(buf[0], Length(buf));
end;

//SureYK / BringBW(PClientLink(FClientLinks.Items[i]), $2D, $0A, wNo, op);
procedure TSocket104.BringBW(pcl: PClientLink ;ftype: Byte; Reason: Word;
  Address: Integer; Info: Byte; SQ: Integer =0);
var
  buf : array[0..15] of byte;
begin
  if (pcl = nil) or (not pcl^.Ploy) then Exit;

  if SQ = 0 then
  begin
    buf[0]:= $68;
    buf[1]:= $0E; //
    buf[2]:= $00; //I格式　第0帧
    buf[3]:= $00;
    buf[4]:= $00;
    buf[5]:= $00;
    buf[6]:= ftype;
    buf[7]:= $01; // SQ= 0 一个信息体
    buf[8]:= Lo(Reason);
    buf[9]:= Hi(Reason);
    buf[10]:= LCom;
    buf[11]:= HCom;
    address:= address and $FFFFFF;//允许操作设备的顺序号
    buf[12]:= Byte(address);
    buf[13]:= Byte((address shr 8));
    buf[14]:= Byte((address shr 16));
    buf[15]:= Info;//=1允许操作=0禁止操作
//    SaveToFile(false,pcl^.fs,buf);
    pcl^.Socket.SendBuf(buf[0], Length(buf));
  end;
end;

procedure TSocket104.CallUp(pcl: PClientLink);
begin
  {pcl 类型b　原因w, 地址i, 信息b, SQ = 0}
  if pcl = nil then exit;
  BringBW(pcl, $64, $06, $00, $14);
end;

procedure TSocket104.AnswerAsk(pcl: PClientLink; Add: Integer;
  Value: Boolean);
var
  r: Byte;
begin
  {pcl 类型b　原因w, 地址i, 信息b, SQ = 0}
  if pcl = nil then exit;
  r:= $07;
  if not Value then  //
    r:= r or $40;
  BringBW(pcl, $2D, r, Add, $00);
end;

procedure TSocket104.SendZero(pcl: PClientLink);
begin
  {pcl 类型b　原因w, 地址i, 信息b, SQ = 0}
  if pcl = nil then exit;
  BringBW(pcl, $01, $03, $00, $00);
end;

procedure TSocket104.AllowControl_104(index:integer; op: byte);
begin
  Send(index, op);
end;

procedure TSocket104.Send(index:integer; op: byte);
var
  wNo, i: Integer;
begin
  wNo:= index;
  if (wNo < 0) then
    Exit;

  for i:= 0 to FClientLinks.Count - 1 do
  begin
    BringBW(PClientLink(FClientLinks.Items[i]), $2D, $06, wNo, op);
  end;
end;

procedure TSocket104.SureYK(index:integer; op: byte);
var
  wNo, i: Integer;
begin
  wNo:= index;
  if (wNo < 0) then
    Exit;

  for i:= 0 to FClientLinks.Count - 1 do
  begin
    BringBW(PClientLink(FClientLinks.Items[i]), $2D, $0A, wNo, op);
  end;
end;

procedure TSocket104.Sendxyx;
var
  buf: array[0..254] of byte;
  i, j, k: integer;
//  pe: PEquipDesc;
  MStream: TMemoryStream;
  tbuf: array[0..3] of Byte;
  slen: Integer;
  Fno: Integer;
begin
  MStream:= TMemoryStream.Create;
  try
{
    for i := 0 to gcDrawList.Count - 1 do
    begin
      po := TgcDraw(gcDrawList.Objects[i]);
      for j := 0 to po.ObjectCount - 1 do
      begin
        pe := po.Objects[j].data;
        if (pe <> nil) and (pe^.logType in [0, 1]) then
        begin
          k := pe^.iwf;
          if (k >= 0) and (k < 1024) then
          begin
            tbuf[0]:= Byte(pe^.iwf);
            tbuf[1]:= Byte((pe^.iwf shr 8));
            tbuf[2]:= Byte((pe^.iwf shr 16));
            tbuf[3]:= pe^.oldstate; //前面三位表示顺序，后面那位表示状态
            MStream.WriteBuffer(tbuf[0], 4);
          end;
        end;
      end;
    end;
}
    MStream.Position:= 0;
    fillchar(buf[0], Length(buf), 0);

    if MStream.Size = 0 then
      Exit;
    slen:= MStream.Size;
    Fno:= 0;
    while slen > 0 do//可以分批发送
    begin
      Fno:=Fno shl 1;
      buf[0]:= $68;
      buf[1]:= $FD; //帧长 253
      buf[2]:= LO(Fno);
      buf[3]:= HI(Fno);
      buf[4]:= $00;
      buf[5]:= $00;
      buf[6]:= $01; //CON
      buf[7]:= $3C; //SQ  NO:240(60*4) + 12
      buf[8]:= $03; //原因
      buf[9]:= $00;
      buf[10]:= LCom;
      buf[11]:= HCom;
      if MStream.Size - MStream.Position > 240 then
        MStream.ReadBuffer(buf[12], 240);
      if MStream.Size - MStream.Position < 240 then
        MStream.ReadBuffer(buf[12], MStream.Size - MStream.Position);
      for i:= 0 to FClientLinks.Count - 1 do
      begin
        if PClientLink(FClientLinks.Items[i])^.Ploy then
        begin
//          SaveToFile(false,PClientLink(FClientLinks.Items[i])^.fs,buf);
          PClientLink(FClientLinks.Items[i])^.Socket.SendBuf(buf[0], Length(buf));
        end;
      end;
      inc(Fno);
      slen := slen - 240;
      fillchar(buf[0], Length(buf), 0);
    end;
  finally
    freeandnil(MStream);
  end;
end;

procedure TSocket104.OnClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i: Integer;
  Link: PClientLink;
  s: string;
begin
  s:= '';
  try
    i:= IndexOf(Socket.RemoteAddress);
    if i < 0 then
    begin
      GetMem(Link, SizeOf(ClientLink));
      //New(Link);
      ClearClientLink(Link^, True);
      Link^.Socket:= Socket;
      Link^.TESTFR:= True;
      FClientLinks.Add(Link);
//      AssignFile(Link^.fs, 'c:\'+StringReplace(datetimetostr(now()),':','-',[rfReplaceAll])+'.txt');
//      rewrite(Link^.fs);
      try
        MessageList.Add(Socket.RemoteAddress + ': 连接到五防系统')
      except
        s:= s + ': 提示窗口出错';
      end;
    end
    else
    begin
      try
        MessageList.Add('单IP多端口连接');
      except
        s:= s + ': 提示窗口出错';
      end;
      Socket.Close;
    end;
  except
    s:= s + ': 建立连接出错';
  end;

  if s <> '' then
    MessageList.Add(s);
end;

procedure TSocket104.CloseLink(Socket: TCustomWinSocket; No: integer);
var
  i: Integer;
begin
  if (No >= 0) and (Socket <> nil) then
  begin
    //Dispose(PClientLink(FClientLinks.Items[No]));
//    CLOSEFILE(PClientLink(FClientLinks.Items[No])^.fs);
    if(PClientLink(FClientLinks.Items[No])^.Socket.RemotePort=socket.RemotePort)then
    begin
      FreeMem(PClientLink(FClientLinks.Items[No]));
      FClientLinks.Delete(No);
    end;
  end
  else if (No = - 1) then
  begin
    for i:= 0 to FClientLinks.Count - 1 do
    begin
      Dispose(PClientLink(FClientLinks.Items[i]));
      FClientLinks.Delete(i);
    end;
  end;
end;

procedure TSocket104.OnClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i: Integer;
begin
  i:= IndexOf(Socket.RemoteAddress);
  if i < 0 then
    Exit;
  CloseLink(Socket, i);
  MessageList.Add(Socket.RemoteAddress + ': 断开连接');