serunit.pas

a program written by delphi about middle layer

unit serUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, Sockets;

type
  TForm1 = class(TForm)
    tcpserver: TServerSocket;
    Memo1: TMemo;
    Button3: TButton;
    Edit1: TEdit;
    Button1: TButton;
    lstClients: TListBox;
    Button2: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tcpserverClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure tcpserverAccept(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
    procedure RefreshClientList;
    function frame_checksum(s: string): string;
    function frame_pack(s: string): string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
    tcpserver.Active := true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    tcpserver.Active := false;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    tcpserver.Active := false;
end;

procedure TForm1.tcpserverClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    memo1.Lines.Add(Socket.ReceiveText);
    Socket.SendText(#06);
    Socket.Close;
end;

procedure TForm1.RefreshClientList;
var
  i, iClients: integer;
begin
  iClients := tcpserver.Socket.ActiveConnections;
  lstClients.Items.Clear;
  for i := 0 to iClients-1 do
  begin
    lstClients.Items.Append(tcpserver.Socket.Connections[i].RemoteHost);
  end;
end;

procedure TForm1.tcpserverAccept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    RefreshClientList;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
    s: string;
begin
    s := trim(Edit1.Text);
    s := frame_pack(s) + frame_checksum(s);
    tcpserver.Socket.Connections[0].SendText(s)
end;

function TForm1.frame_pack(s: string): string;
begin
    result := #02 + s + #03;
end;

function TForm1.frame_checksum(s: string): string;
var
    i, j, k: integer;
begin
    j := 0;
    k := 256;
    for i := 1 to length(s) do
        j := j + ord(s[i]);
    j := j mod k;

    result := IntToHex(j, 2);
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
    tcpserver.Socket.Connections[0].SendText(#06);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
    tcpserver.Socket.Connections[0].SendText(#15);
end;

end.