ServerSocket只收到一次

时间:2018-07-18 22:12:32

标签: delphi record serversocket

我正在尝试通过clientsocket发送记录并在serversocket上接收,一切正常,但只有在第一次,发送一次后,我需要断开clientsocket,再次连接以再次发送。

如果有人可以帮助我。

这是我如何接收信息的服务器端代码:

procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  LBuffer: TBytes;
  LMessageBuffer: TBytes;
  LDataSize: Integer;
  LProtocol: TProtocol;
begin
  LDataSize := Socket.ReceiveLength;

if LDataSize >= szProtocol then begin
    try
      Socket.ReceiveBuf(LBuffer, SizeOf(LBuffer));
      LProtocol := BytesToProtocol(LBuffer);

  // check client command and act accordingly
  case LProtocol.Command of
    cmdConnect: begin
      Memo1.Lines.Add(Format('[%s][%s][%s]', ['Connect', LProtocol.Sender.UserName, TimeToStr(LProtocol.Sender.ID)]));
    end; // cmdConnect: begin
    cmdDisconnect: begin
      Memo1.Lines.Add(Format('[%s][%s][%s]', ['Disconnect', LProtocol.Sender.UserName, TimeToStr(LProtocol.Sender.ID)]));
    end; // cmdDisconnect: begin
  end;
finally
  ClearBuffer(LBuffer);
end;
  end;
end;

这里是客户端:

var
  LBuffer: TBytes;
  LProtocol: TProtocol;
  x : Integer;
begin
  InitProtocol(LProtocol);
  LProtocol.Command := cmdConnect;
  ClientData.UserName := Edit1.Text;
  ClientData.ID := Now;
  LProtocol.Sender := ClientData;
  LBuffer := ProtocolToBytes(LProtocol);
  try
    ClientSocket1.Socket.SendBuf(LBuffer, Length(LBuffer));
  finally
    ClearBuffer(LBuffer);
  end;

记录声明:

type
  TCommand = (
    cmdConnect,
    cmdDisconnect,
    cmdMessageBroadcast,
    cmdMessagePrivate,
    cmdScreenShotGet,
    cmdScreenShotData);

// client information structure, you can extend this based on your needs
type
  TClient = record
    UserName: string[50];
    ID: TDateTime;
  end; // TClient = record

// size of the client information structure
const
  szClient = SizeOf(TClient);

谢谢:)

1 个答案:

答案 0 :(得分:4)

TBytes是动态数组,但是您将其视为静态数组。

在客户代码中,您没有正确发送LBuffer。作为LBuffer的动态数组,它只是指向存储在内存中其他位置的数据的指针。因此,您需要取消引用LBuffer才能将正确的内存地址传递给SendBuf()

在服务器代码中,在读取字节之前甚至根本没有为LBuffer分配任何内存。而且,就像在客户端中一样,在将LBuffer传递给ReceiveBuf()时,需要取消引用。告诉ReceiveBuf()要读取多少字节(SizeOf(TBytes)是错误的值)时,您还需要使用正确的字节大小。

最后,您需要注意SendBuf()ReceiveBuf()的返回值,因为它们 CAN 返回的字节数少于请求的字节数!因此,您应该循环调用SendBuf()ReceiveBuf()

尝试一下:

var
  LBuffer: TBytes;
  LProtocol: TProtocol;
  LBufferPtr: PByte;
  LBufferLen: Integer;
  LNumSent: Integer;
begin
  InitProtocol(LProtocol);
  LProtocol.Command := cmdConnect;
  ClientData.UserName := Edit1.Text;
  ClientData.ID := Now;
  LProtocol.Sender := ClientData;
  LBuffer := ProtocolToBytes(LProtocol);
  LBufferPtr := PByte(LBuffer);
  LBufferLen := Length(LBuffer);
  repeat
    LNumSent := ClientSocket1.Socket.SendBuf(LBufferPtr^, LBufferLen);
    if LNumSent = -1 then
    begin
      // if ClientSocket1.ClientType is set to ctNonBlocking,
      // uncomment this check ...
      {
      if WSAGetLastError() = WSAEWOULDBLOCK then
      begin
        // optionally call the Winsock select() function to wait
        // until the socket can accept more data before calling
        // SendBuf() again...
        Continue;
      end;
      }
      // ERROR!
      ClientSocket1.Close;
      Break;
    end; 
    Inc(LBufferPtr, LNumSent);
    Dec(LBufferLen, LNumSent);
  until LBufferLen = 0;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  LBuffer: TBytes;
  LDataSize: Integer;
  LProtocol: TProtocol;
  LBufferPtr: PByte;
  LBufferLen: Integer;
  LNumRecvd: Integer;
begin
  LDataSize := Socket.ReceiveLength;
  if LDataSize < szProtocol then Exit;

  SetLength(LBuffer, szProtocol);

  repeat
    // since you are validating ReceiveLength beforehand, ReceiveBuf()
    // *should not* return fewer bytes than requested, but it doesn't
    // hurt to be careful...
    LBufferPtr := PByte(LBuffer);
    LBufferLen := szProtocol;
    repeat
      LNumRecvd := Socket.ReceiveBuf(LBufferPtr^, LBufferLen);
      if LNumRecvd <= 0 then Exit;
      Inc(LBufferPtr, LNumRecvd);
      Dec(LBufferLen, LNumRecvd);
      Dec(LDataSize, LNumRecvd);
    until LBufferLen = 0;

    LProtocol := BytesToProtocol(LBuffer);

    // check client command and act accordingly
    case LProtocol.Command of
      cmdConnect: begin
        Memo1.Lines.Add(Format('[%s][%s][%s]', ['Connect', LProtocol.Sender.UserName, TimeToStr(LProtocol.Sender.ID)]));
      end;
      cmdDisconnect: begin
        Memo1.Lines.Add(Format('[%s][%s][%s]', ['Disconnect', LProtocol.Sender.UserName, TimeToStr(LProtocol.Sender.ID)]));
      end;
    end;
  until LDataSize < szProtocol;
end;

话虽这么说,TClientSocketTServerSocket已过时很久了。它们甚至在默认情况下都不再安装(但如果您需要安装它们仍然可用)。您应该真正考虑切换到另一个为您处理此类详细信息的套接字库,例如Indy的TIdTCPClientTIdTCPServer(Indy已预先安装在Delphi中),例如:

type
  PTIdBytes = ^TIdBytes;
var
  LBuffer: TBytes;
  LProtocol: TProtocol;
begin
  InitProtocol(LProtocol);
  LProtocol.Command := cmdConnect;
  ClientData.UserName := Edit1.Text;
  ClientData.ID := Now;
  LProtocol.Sender := ClientData;
  LBuffer := ProtocolToBytes(LProtocol);
  // TBytes and TIdBytes are technically the same thing under the hood,
  // but they are still distinct types and not assignment-compatible,
  // so using a dirty hack to pass a TBytes as a TIdBytes without having
  // to make a copy of the bytes...
  IdTCPClient1.IOHandler.Write(PTIdBytes(@LBuffer)^);
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
type
  PTBytes = ^TBytes;
var
  LBuffer: TIdBytes;
  LProtocol: TProtocol;

  // note: TIdTCPServer is a multi-threaded component, so you must
  // sync with the main thread when accessing the UI...
  procedure AddToMemo(const AStr: string);
  begin
    TThread.Synchronize(nil,
      procedure
      begin
        Memo1.Lines.Add(AStr);
      end
    );
  end;

begin
  // ReadBytes() can allocate the buffer for you...
  AContext.Connection.IOHandler.ReadBytes(LBuffer, szProtocol);

  // using a similar dirty hack to pass a TIdBytes as a TBytes
  // without making a copy of the bytes ...
  LProtocol := BytesToProtocol(PTBytes(@LBuffer)^);

  // check client command and act accordingly
  case LProtocol.Command of
    cmdConnect: begin
      AddToMemo(Format('[%s][%s][%s]', ['Connect', LProtocol.Sender.UserName, TimeToStr(LProtocol.Sender.ID)]));
    end;
    cmdDisconnect: begin
      AddToMemo(Format('[%s][%s][%s]', ['Disconnect', LProtocol.Sender.UserName, TimeToStr(LProtocol.Sender.ID)]));
    end;
  end;
end;