delphi - TCP连接异常

Question

我的服务器有 4 个 TCP 连接的客户端列表。如果列表已满，下一个客户必须拒绝

//服务器端

unit ServerUnit;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdThreadMgr, IdThreadMgrDefault, IdAntiFreezeBase, IdAntiFreeze,
IdUDPBase, IdUDPServer, IdBaseComponent, IdComponent, IdTCPServer,
StdCtrls, ExtCtrls,IdSocketHandle, ComCtrls, IdUDPClient, Grids,
IdTCPConnection, IdTCPClient;

type
 TForm1 = class(TForm)
 Panel1: TPanel;
 Label3: TLabel;
 Edit3: TEdit;
 Button1: TButton;
 IdTCPServer1: TIdTCPServer;
 IdUDPServer1: TIdUDPServer;
 IdAntiFreeze1: TIdAntiFreeze;
 IdThreadMgrDefault1: TIdThreadMgrDefault;
 StatusBar1: TStatusBar;
 GroupBox2: TGroupBox;
 IncomingText: TMemo;
 GroupBox1: TGroupBox;
 Clients_StringGrid: TStringGrid;
 IdTCPClient1: TIdTCPClient;
 procedure Button1Click(Sender: TObject);
 procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
 procedure ADDTCPConn(AThread: TIdPeerThread;i:Integer);
 procedure DeleteRow1(VGrid: TStringGrid; VRow: integer);
 procedure InsertRow1(VGrid: TStringGrid; Str1:String; Str2:String; Str3:String);
 Procedure Add_To_StringGrid(Grid:TStringGrid; Str1:String; Str2:String; Str3:String; i:Integer);
 procedure FormCreate(Sender: TObject);
 procedure IdTCPServer1Execute(AThread: TIdPeerThread);
 procedure IdTCPServer1Connect(AThread: TIdPeerThread);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
RCount:Integer;
flag:Boolean;
IPList : TStringList;
IPList2 : TStringList;
fl: Boolean;

implementation

uses CommonUnit;
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
 if not IdUDPServer1.Active then
 begin
  IdUDPServer1.DefaultPort:=1717;
  IdUDPServer1.BroadcastEnabled:=True;
  IdUDPServer1.Active:=True;
 end;
 if not IdTCPServer1.Active then
 begin
  IdTCPServer1.DefaultPort:=1717;
  IdTCPServer1.Active:=True;
 end;
end;

procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
 ABinding: TIdSocketHandle);
var
 s : String;
 ip : String;
 dss : TStringStream;
begin
 try
  dss := TStringStream.Create('');
  dss.CopyFrom(AData, AData.Size);
  s := dss.DataString;
  ip:=GetIPAddress();
  IncomingText.Lines.Add('Client Say('+ABinding.PeerIP+'):'+s);
  IncomingText.Lines.Add('------------');
  ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, ip[1], Length(ip));
  dss.Free();
 except
 on E : Exception do
  WriteLogFile(E.message);
 end;
end;

procedure TForm1.ADDTCPConn(AThread: TIdPeerThread;i:Integer);
var
NewClientIP : String;
begin
  NewClientIP := AThread.Connection.Socket.Binding.PeerIP;
 //NewClientHostName := IPAddrToName(NewClientIP);
 //Add_To_StringGrid(Clients_StringGrid,NewClientIP,'ggg','eee',i);
 InsertRow1(Clients_StringGrid,NewClientIP,'ggg','eee');
 IncomingText.Lines.Add(TimeToStr(Time)+' Connection from "' + 'ggg' + '" on ' + NewClientIP);
 IncomingText.Lines.Add('------------');
 StatusBar1.Panels.Items[0].Text := ' Status : TCP Connected';
 flag:=true;
end;

Procedure TForm1.Add_To_StringGrid(Grid:TStringGrid; Str1:String; Str2:String; Str3:String;
 i:Integer);     
Begin
 if i=-1 then
 begin
  if RCount <> 0 then
   Grid.RowCount := Grid.RowCount + 1;
  RCount:=RCount+1;
  Grid.Cells[0,RCount] := Str1;
  Grid.Cells[1,RCount] := Str2;
  Grid.Cells[2,RCount] := Str3;
 end
 else
 begin
  Grid.Cells[0,i] := Str1;
  Grid.Cells[1,i] := Str2;
  Grid.Cells[2,i] := Str3;
 end;
End;

procedure TForm1.InsertRow1(VGrid: TStringGrid; Str1:String; Str2:String; Str3:String);
begin
 if RCount<>0 then
  VGrid.RowCount:= VGrid.RowCount + 1;
 VGrid.Cells[0, VGrid.RowCount - 1]:= Str1;
 VGrid.Cells[1, VGrid.RowCount - 1]:= Str2;
 VGrid.Cells[2, VGrid.RowCount - 1]:= Str3;
 RCount:=RCount+1;
end;


procedure TForm1.DeleteRow1(VGrid: TStringGrid; VRow: integer);
var
I, J: Integer;
begin
if VGrid.RowCount = 2 then
begin
 VGrid.Rows[1].CommaText:= '"","","","",""';
end
else
begin
 for I:= VRow to VGrid.RowCount - 2 do
  for J:=0 to VGrid.ColCount - 1 do
   VGrid.Cells[J,I]:= VGrid.Cells[J, I + 1];
  VGrid.RowCount:= VGrid.RowCount - 1;
end;
RCount:=RCount-1;
if RCount=0 then
 VGrid.RowCount:= 2;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 RCount:=0;
 Clients_StringGrid.Cells[0, 0]:= 'Client IP';
 Clients_StringGrid.Cells[1, 0]:= 'Host Name';
 Clients_StringGrid.Cells[2, 0]:= 'Versa';
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
begin
 if flag then
  AThread.Connection.WriteLn('Reply')
 else
  AThread.Connection.WriteLn('Reject');
end;

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
var
j:Integer;
fl:Boolean;
IP:String;
IPList2 : TStringList;
Count:Integer;
i:Integer;
begin
 try
  Count:=StrToInt(Edit3.Text);
  IP:= AThread.Connection.Socket.Binding.PeerIP;
  if (Clients_StringGrid.Cols[0].IndexOf(IP) = -1) then
  begin
   if RCount < Count then
   begin
    if (Clients_StringGrid.Cols[0].IndexOf(IP) = -1) then
     ADDTCPConn(AThread,-1)
    else
    begin
     StatusBar1.Panels.Items[0].Text := ' Status : TCP Already Connected';
     flag:=True;
    end;
   end
   else
   begin
   IPList:=TStringList.Create;
   IPList2:=TStringList.Create;
   fl:=False;
   IPList.Clear;
   IPList2.Clear;
   For i:=1 To Count Do
   begin
    IdTCPClient1.Host := Clients_StringGrid.Cells[0,i];
    IdTCPClient1.Port := 1112;
    if IdTCPClient1.connected then
     IdTCPClient1.Disconnect;
    try
     IdTCPClient1.Connect();
     IdTCPClient1.Disconnect;
     IPList.Add(Clients_StringGrid.Cells[0,i]);
    except
    on E : Exception do
    begin
     IPList2.Add(Clients_StringGrid.Cells[0,i]);
     fl:=True;
    end;
   end;
 end;
 IncomingText.Lines.Add('Num Act ip:'+IntToStr(IPList.Count));
 For j:=1 To IPList2.Count Do
 begin
  IncomingText.Lines.Add('row Del'+IntToStr(Clients_StringGrid.Cols[0].IndexOf(IPList2[j-1])));
  DeleteRow1(Clients_StringGrid,Clients_StringGrid.Cols[0].IndexOf(IPList2[j-1]));
 end;
 if fl then
 begin
  ADDTCPConn(AThread,-1);
  flag:=True;
 end
 else
  flag:=false;
 IPList.Free;
 IPList2.Free;
end;
end
else
begin
 StatusBar1.Panels.Items[0].Text := ' Status : TCP Already Connected';
 flag:=True;
end;
except
on E : Exception do
 WriteLogFile(E.message);
end;
end;

end.

//客户端

unit ClientUnit;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ExtCtrls, IdAntiFreezeBase, IdAntiFreeze,
 IdTCPConnection, IdTCPClient, IdBaseComponent, IdComponent, IdUDPBase,
 IdUDPClient, ComCtrls, IdUDPServer,IdSocketHandle,IdStack, IdTCPServer,
 IdThreadMgr, IdThreadMgrDefault;

 type
  TForm2 = class(TForm)
  Panel1: TPanel;
  Label3: TLabel;
  Edit3: TEdit;
  Button1: TButton;
  Button2: TButton;
  Button3: TButton;
  StatusBar1: TStatusBar;
  GroupBox2: TGroupBox;
  IncomingText: TMemo;
  IdUDPClient1: TIdUDPClient;
  IdTCPClient1: TIdTCPClient;
  IdAntiFreeze1: TIdAntiFreeze;
  IdTCPServer1: TIdTCPServer;
  IdThreadMgrDefault1: TIdThreadMgrDefault;
  procedure Button1Click(Sender: TObject);
  procedure Button2Click(Sender: TObject);
  procedure Button3Click(Sender: TObject);
  procedure IdTCPServer1Execute(AThread: TIdPeerThread);
 private
  { Private declarations }
 public
  { Public declarations }
end;

var
 Form2: TForm2;
 ServerIP:String;

implementation

uses CommonUnit;
{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
 if not IdUDPClient1.Active then
 begin
  IdUDPClient1.Port:=1717;
  IdUDPClient1.BroadcastEnabled:=True;
  IdUDPClient1.Active:=True;
  IdTCPServer1.Active:=False;
 end;
 Button1.Enabled:=False;
 Button2.Enabled:=True;
end;

procedure TForm2.Button2Click(Sender: TObject);
var
 StrIn : String;
 StrOut : String;
begin
try
 StrOut:='Request';
 IdUDPClient1.Broadcast(StrOut, 1717);
 StrIn := IdUDPClient1.ReceiveString(100);
 if not (StrIn='') then
 begin
  Button3.Enabled:=True;
  Button2.Enabled:=False;
  IncomingText.Lines.Add('UDP Reply');
  StatusBar1.Panels.Items[0].Text := 'Status : UDP Connected';
  ServerIP := StrIn;
 end
 else
  WriteLogFile('UDP Connection Failed');
except
on E : Exception do
 WriteLogFile(E.Message);
end;
end;

procedure TForm2.Button3Click(Sender: TObject);
var
 StrIn : String;
begin
 try
  if ServerIP<>'' then
  begin
   IdTCPClient1.Host := ServerIP ;
   IdTCPClient1.Port := 1717 ;
   IdTCPClient1.Connect;
   StrIn:= IdTCPClient1.ReadLn();
   //IdTCPClient1.Disconnect;
   if StrIn<>'' then
   begin
    IncomingText.Lines.Add(StrIn);
    if StrIn<>'Reply' then
     StatusBar1.Panels.Items[0].Text :='Connected To TCPServer';
    else
    begin
     Button3.Enabled:=False;
     Button1.Enabled:=True;
    end;
   end
   else
    WriteLogFile('TCP Connection Failed');
  end;
  except
  on E : Exception do
   WriteLogFile(E.message);
 end;
end;

procedure TForm2.IdTCPServer1Execute(AThread: TIdPeerThread);
begin
 //check point
end;

end.

//当服务器上的 onconnect 事件想要检查列表中的客户端时，行 IdTCPClient1.Connect() 返回错误 1)Socket Error #10022 Invalid argument。2）连接优雅关闭。

并且永远不要在客户端运行 onexcute 为什么会这样

delphi - TCP连接异常

0 回答 0

Related

Reference