ts.pas

tcp测试程序

unit ts;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ScktComp, ComCtrls, Spin, ExtCtrls;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    sendstr: TEdit;
    ss1: TServerSocket;
    cs1: TClientSocket;
    cip: TEdit;
    cport: TEdit;
    ccon: TBitBtn;
    sndb2: TBitBtn;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Label4: TLabel;
    sport: TEdit;
    start: TBitBtn;
    Label5: TLabel;
    GroupBox1: TGroupBox;
    m22: TMemo;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Label6: TLabel;
    BitBtn1: TBitBtn;
    GroupBox2: TGroupBox;
    Label7: TLabel;
    m11: TMemo;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    m12: TMemo;
    m21: TMemo;
    StatusBar1: TStatusBar;
    se1: TSpinEdit;
    TabSheet3: TTabSheet;
    ls1: TListView;
    Label8: TLabel;
    c1: TComboBox;
    Label9: TLabel;
    c2: TSpinEdit;
    c3: TEdit;
    lsb: TBitBtn;
    Panel1: TPanel;
    BitBtn6: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn7: TBitBtn;
    BitBtn5: TBitBtn;
    TabSheet4: TTabSheet;
    GroupBox3: TGroupBox;
    lv2: TListView;
    procedure cconClick(Sender: TObject);
    procedure cs1Connect(Sender: TObject; Socket: TCustomWinSocket);
    procedure sndb2Click(Sender: TObject);
    procedure cs1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure startClick(Sender: TObject);
    procedure ss1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure RadioButton3Click(Sender: TObject);
    procedure RadioButton4Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure sendstrKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ss1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ss1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure BitBtn6Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure lsbClick(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn7Click(Sender: TObject);
    procedure lv2DblClick(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  procedure buff2memo_H(m:Tmemo;buf:array of char;size:integer);
  procedure buff2memo_S(m:Tmemo;buf:array of char;size:integer);
  function listview2buf(ls:Tlistview;var buf:array of char):integer;
//  function listview2buf(ls:Tlistview;var buf:pchar):integer;
  function array2pchar(str:array of char ):Pchar;
implementation

{$R *.DFM}
function array2pchar(str:array of char ):Pchar;
begin
           result:='0';
end;

procedure buff2memo_H(m:Tmemo;buf:array of char;size:integer);
var     i,j:integer;
        str,tmps,tmp2:string;
begin
        j:=0;
        while (j<size) do
        begin
//                str:='12345678h:';
                FmtStr(str,'%08xh:',[j]); tmp2:='    ';
                for i:=1 to 16 do
                begin
                        FmtStr(tmps,'%02x',[ord(buf[j])]);
                        str:=str+tmps+' ';
                        if ((buf[j]<#32)or(buf[j]>#126))
                        then tmp2:=tmp2+'.'
                        else tmp2:=tmp2+buf[j];
                        j:=j+1;
                end;
                m.Lines.Add(str+tmp2);
        end;
end;

procedure buff2memo_S(m:Tmemo;buf:array of char;size:integer);
var     j:integer;
        str:string;
begin
        j:=0; str:='';
        while (j<size) do
        begin
                if ((buf[j]<#32)and(buf[j]<>#10)and(buf[j]<>#13))
                then str:=str+'.'
                else str:=str+buf[j];
                j:=j+1;
        end;
        m.Lines.Add(str);
end;
{
function listview2buf(ls:Tlistview;var buf:pchar):integer;
var     i,j,k:integer;
        p:pointer;
begin
        k:=0;
        for i:=0 to ls.Items.Count-1 do
        begin
                p:=@buf;
                strplcopy(buf+k,(ls.Items.Item[i].SubItems.strings[1]),strtoint(ls.Items.Item[i].SubItems.strings[0]));
                k:=k+strtoint(ls.Items.Item[i].SubItems.strings[0]);
        end;
        result:=k;
end;
}
function listview2buf(ls:Tlistview;var buf:array of char):integer;
var
     i,k,l:integer;
     p:pointer;
     qqq:pointer;
     str,str2:string;
     i2:integer;
begin
        k:=0;
        for i:=0 to ls.Items.Count-1 do
        begin
                p:=@(buf[k]);
                l:=strtoint(ls.Items.Item[i].SubItems.strings[0]);
                if (ls.Items.Item[i].SubItems.strings[1]='字符') then
                begin
                        str:=ls.Items.Item[i].Caption;
                        strplcopy(p,str,l);
                end
                else if (ls.Items.Item[i].SubItems.strings[1]='整型') then
                begin
                        str2:=ls.Items.Item[i].Caption;
                        i2:=strtoint(str2);
                        qqq:=@i2;
                        CopyMemory(p,qqq,l);
                end;
                k:=k+l;
        end;
        result:=k;
end;

procedure TForm1.cconClick(Sender: TObject);
begin
     if ccon.Caption = '联接' then
     begin
         cS1.Address:=cip.Text;
         cS1.Port:=StrToInt(cport.Text);
         cS1.Open;
    end
    else
    begin
         cs1.Active := false ;
         ccon.Kind:=bkRetry;
         ccon.Caption := '联接';
        sndb2.Enabled:=false;
    end;

end;

procedure TForm1.cs1Connect(Sender: TObject; Socket: TCustomWinSocket);
begin
      if cs1.Active = true then
      begin
        ccon.Kind:=bkAbort;
        ccon.Caption:= '断开';
        sndb2.Enabled:=true;
      end;
end;

procedure TForm1.sndb2Click(Sender: TObject);
begin
        cs1.Socket.SendText(sendstr.Text);
        m21.lines.Add('S:'+sendstr.Text);
end;

procedure TForm1.cs1Read(Sender: TObject; Socket: TCustomWinSocket);
var
    i  :integer;
    ctr:array[1..1024] of char;
begin
     fillchar(ctr,1024,0);
     i:=socket.ReceiveLength;
     Socket.ReceiveBuf(ctr,i);
     ctr[i+1]:=#0;
     label6.Caption:='数据块长度：'+inttostr(i);
     buff2memo_H(m22,ctr,i);
     m21.lines.Add('R:');
     buff2memo_S(m21,ctr,i);
end;


procedure TForm1.startClick(Sender: TObject);
begin
     if start.Caption='启动' then
     begin
          ss1.Port := strtoint(sport.Text);
          ss1.Active:= true;
          start.Kind:=bkno;
          start.Caption:= '停止';
     end
     else
     begin
          ss1.Active := false ;
          start.Kind:=bkAll;
          start.Caption:='启动';
          se1.Value:=0;
     end;

end;

procedure TForm1.ss1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
    i  :integer;
//    bufsun:pointer;
//    recvpoint : ^char ;
    ctr:array[1..1024] of char;

begin
{     i:=socket.ReceiveLength;
     GetMem(bufsun, i);
     fillchar(bufsun^,i,0);
     Socket.ReceiveBuf(bufsun^,i);
     recvpoint :=bufsun ;
     str:='OK';
     socket.SendBuf(bufsun^,i);
     recvmemo.Lines.Add('S:'+ str +';');
     for j:= 1 to i do
     begin
        ctr:=recvpoint^;
        str:=str+ctr;
     end;
     recvmemo.Lines.Add('~~'+ str +';');
}
     fillchar(ctr,1024,0);
     i:=socket.ReceiveLength;
     Socket.ReceiveBuf(ctr,i);
     ctr[i+1]:=#0;
     label7.Caption:='数据块长度：'+inttostr(i);
     buff2memo_H(m12,ctr,i);
     buff2memo_S(m11,ctr,i);
     socket.SendBuf(ctr,i);
//     socket.SendText('ok!');
end;

procedure TForm1.RadioButton3Click(Sender: TObject);
begin
        m11.BringToFront;
end;

procedure TForm1.RadioButton4Click(Sender: TObject);
begin
        m12.BringToFront;
end;

procedure TForm1.RadioButton1Click(Sender: TObject);
begin
        m21.BringToFront;
end;

procedure TForm1.RadioButton2Click(Sender: TObject);
begin
        m22.BringToFront;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
        m11.Clear;      m12.Clear;
        edit1.Clear;
        m12.Lines.Add('address  :00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F');
        label7.Caption:='数据块长度：0';
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
        m21.Clear;      m22.Clear;
        m22.Lines.Add('address  :00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F');
        label6.Caption:='数据块长度：0';
end;
procedure TForm1.sendstrKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
        if (key=13) then sendstr.Clear;
end;

procedure TForm1.ss1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
        se1.Value:= se1.Value + 1;
end;

procedure TForm1.ss1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
        se1.Value:= se1.Value - 1;
end;

procedure TForm1.BitBtn6Click(Sender: TObject);
begin
        ls1.items.clear;
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
var
        lvitem:TListItem;
begin
        lvitem:=ls1.Items.Add;
        lvitem.Caption:=c3.Text;
        lvitem.SubItems.Add(inttostr(c2.Value));
        lvitem.SubItems.Add(c1.Text);
end;

procedure TForm1.lsbClick(Sender: TObject);
var
        buf:array[0..512] of char;
//        buf:pchar;
        i:integer;
begin
        i:=listview2buf(ls1,buf);
        cs1.Socket.SendBuf(buf,i);
//        cs1.Socket.SendText(sendstr.Text);
        m21.lines.Add('S:'+sendstr.Text);
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var
        lvitem:TListItem;
begin
        lvitem:=ls1.Items.Insert(ls1.Selected.Index+1);
        lvitem.Caption:=c3.Text;
        lvitem.SubItems.Add(inttostr(c2.Value));
        lvitem.SubItems.Add(c1.Text);

end;

procedure TForm1.BitBtn7Click(Sender: TObject);
begin
        ls1.Items.Delete(ls1.Selected.Index);
end;

procedure TForm1.lv2DblClick(Sender: TObject);
begin
        sendstr.Text:=lv2.Selected.SubItems.Strings[0];
end;

end.