indy TCP 和 activex 连接到服务器问题

Question

我正在尝试将我的 delphi 项目从 VCL 转换为 ActiveX。我有一个客户端线程的问题。这是我的客户端线程类型：

type
  TClientThread = class(TThread)
  private
    Command: string;
    procedure HandleInput;
  protected
    procedure Execute; override;
  end;

这里是实现：

procedure TClientThread.HandleInput;
begin
  activext.ProcessCommands(Command);
  Command := '';
end;

procedure Tactivextest.ProcessCommands(Command: string);
var
  Params: array [1 .. 10] of String;
  ParamsCount, P: Integer;
  PackedParams: TPackedParams;
  PStr: String;
  IdBytes: TIdBytes;
  Ms: TMemoryStream;
  ReceiveParams, ReceiveStream: Boolean;
  Size: Int64;
begin
  Ms := TMemoryStream.Create;
  ReceiveParams := False;
  ReceiveStream := False;

  if Command[1] = '1' then // command with params
  begin
    Command := Copy(Command, 2, Length(Command));
    ReceiveParams := True;
  end
  else if Command[1] = '2' then // command + memorystream
  begin
    Command := Copy(Command, 2, Length(Command));
    ReceiveStream := True;
    Ms.Position := 0;
  end
  else if Command[1] = '3' then // command with params + memorystream
  begin
    Command := Copy(Command, 2, Length(Command));
    ReceiveParams := True;
    ReceiveStream := True;
  end;

  if ReceiveParams then // params incomming
  begin
    TCPClient.Socket.ReadBytes(IdBytes, SizeOf(PackedParams), False);
    BytesToRaw(IdBytes, PackedParams, SizeOf(PackedParams));
    ParamsCount := 0;
    repeat
      Inc(ParamsCount);
      P := Pos(Sep, String(PackedParams.Params));
      Params[ParamsCount] := Copy(String(PackedParams.Params), 1, P - 1);
      Delete(PackedParams.Params, 1, P + 4);
    until PackedParams.Params = '';
  end;
  if ReceiveStream then // stream incomming
  begin
    Size := TCPClient.Socket.ReadInt64;
    TCPClient.Socket.ReadStream(Ms, Size, False);
    Ms.Position := 0;
  end;

  if Command = 'SIMPLEMESSAGE' then
  begin
    MessageDlg(Params[1], mtInformation, [mbOk], 0);
  end;
  if Command = 'INVALIDPASSWORD' then
  begin
    TCPClient.Disconnect;
    MessageDlg('Invalid password!', mtError, [mbOk], 0);
  end;
  if Command = 'SENDYOURINFO' then // succesfully loged in
  begin
    UniqueID := StrToInt(Params[1]);
    Panel1.Caption := 'connect ' + namewithicon + ')';
    PStr := namewithicon + Sep;
    SendCommandWithParams(TCPClient, 'TAKEMYINFO', PStr);
  end;
  if Command = 'DISCONNECTED' then
  begin
    if TCPClient.Connected then
    TCPClient.Disconnect;
  end;
  if Command = 'TEXTMESSAGE' then
  begin
    memo1.Lines.Add(Params[1] + ' : ' + Params[2] )
  end;
end;

procedure TClientThread.Execute;
begin
  inherited;
  while not Terminated do
  begin
    if not activext.TCPClient.Connected then
      Terminate
    else
    begin
      if activext.TCPClient.Connected then
        Command := activext.TCPClient.Socket.ReadLn('', 5);
      if Command <> '' then
        Synchronize(HandleInput);
    end;
  end;
end;

initialization
  TActiveFormFactory.Create(
    ComServer,
    TActiveFormControl,
    Tactivextest,
    Class_activextest,
    0,
    '',
    OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
    tmApartment);
end.

下面是我如何使用 Indy 的 TCP OnConnected 事件启动客户端线程：

procedure Tactivextest.TCPClientConnected(Sender: TObject);
begin
  ClientThread := TClientThread.Create(True);
  ClientThread.Start;
  SendCommandWithParams(TCPClient, 'LOGIN', namewithicon + Sep);
end;

这是我在表单的 OnCreate 事件中连接到服务器的方式：

begin
  if not TCPClient.Connected then
  begin
    TCPClient.Host := 'localhost';
    TCPClient.Port := 31000;
    try
      TCPClient.Connect;
    except
      on E: Exception do
      begin
        MessageDlg('Cannot connect to server!', mtInformation, [mbOk], 0);
        Application.Terminate;
      end;
    end;
  end
  else
  begin
    SendCommand(TCPClient, 'DISCONNECTED');
    if TCPClient.Connected then
      TCPClient.Disconnect;
  end;
end;

发送指令

procedure Tactivextest.SendBuffer(TCPClient: TIdTCPClient; Buffer: TIdBytes;
  BufferSize: Cardinal);
begin
  if not TCPClient.Connected then
    Exit;
  TCPClient.Socket.WriteLn('AUDIO');
  TCPClient.Socket.Write(BufferSize);
  TCPClient.Socket.Write(Buffer, BufferSize);
end;

procedure Tactivextest.SendCommand(TCPClient: TIdTCPClient; Command: string);
begin
  if not TCPClient.Connected then
    Exit;
  TCPClient.Socket.WriteLn(Command);
end;

procedure Tactivextest.SendCommandWithParams(TCPClient: TIdTCPClient;
  Command, Params: String);
var
  PackedParams: TPackedParams;
begin
  if not TCPClient.Connected then
    Exit;
  TCPClient.Socket.WriteLn('1' + Command);
  PackedParams.Params := ShortString(Params);
  TCPClient.Socket.Write(RawToBytes(PackedParams, SizeOf(PackedParams)));
end;

procedure Tactivextest.SendStream(TCPClient: TIdTCPClient; Ms: TMemoryStream);
begin
  if not TCPClient.Connected then
    Exit;
  Ms.Position := 0;
  with TCPClient.Socket do
  begin
    Write(Ms.Size);
    WriteBufferOpen;
    Write(Ms, 0);
    WriteBufferClose;
  end;
end;

procedure Tactivextest.SendCommandAndStream(TCPClient: TIdTCPClient; Command: String;
  Ms: TMemoryStream);
begin
  if not TCPClient.Connected then
    Exit;
  TCPClient.Socket.WriteLn('2' + Command);
  Ms.Position := 0;
  with TCPClient.Socket do
  begin
    Write(Ms.Size);
    WriteBufferOpen;
    Write(Ms, 0);
    WriteBufferClose;
  end;
end;

procedure Tactivextest.SendCommandWithParamsAndStream(TCPClient: TIdTCPClient;
  Command, Params: String; Ms: TMemoryStream);
var
  PackedParams: TPackedParams;
begin
  if not TCPClient.Connected then
    Exit;
  SendCommand(TCPClient, '3' + Command);
  PackedParams.Params := ShortString(Params);
  TCPClient.Socket.Write(RawToBytes(PackedParams, SizeOf(PackedParams)));
  Ms.Position := 0;
  with TCPClient.Socket do
  begin
    Write(Ms.Size);
    WriteBufferOpen;
    Write(Ms, 0);
    WriteBufferClose;
  end;
end;

我可以连接到服务器，但是客户端线程无法像 VCL 一样启动，所以我无法调用 SendCommands()，因为我已经断开连接，因为我无法在 ActiveX 中使用客户端线程。我已经搜索了很多天有关如何解决的问题，但找不到解决此问题的方法。我知道 ActiveX 已死，但这是出于教育目的。

Answer 1

如果Connect()成功，TIdTCPClient.OnConnected不可能不被触发，所以必须创建客户端线程。如果 Start() 没有引发异常，则线程将启动运行ning。

但是，线程代码的一个主要问题是 HandleInput() 通过 TThread.Synchronize() 在主线程的上下文中运行，而不会在 DLL（ActiveX 或其他）中工作，无需宿主 EXE 主线程的额外合作。 HandleInput() 根本不应该同步，但是一旦你解决了这个问题，ProcessCommands() 就会做一些线程不安全的事情（使用 MessageDlg()，并访问 Panel1 和 Memo1直接），这确实需要同步。

因此，您需要重新编写线程逻辑以避免这些陷阱。试试像这样的东西：

type
  TClientThread = class(TThread)
  protected
    procedure Execute; override;
  end;

procedure TClientThread.Execute;
begin
  activext.SendCommandWithParams(activext.TCPClient, 'LOGIN', activext.namewithicon + activext.Sep);

  while (not Terminated) and activext.TCPClient.Connected do
  begin
    Command := activext.TCPClient.Socket.ReadLn('', 5);
    if Command <> '' then
      activext.ProcessCommands(Command);
  end;
end;

type
  Tactivextest = class(TActiveForm)
    TCPClient: TIdTCPClient;
    ...
  private
    ...
    LineToAdd: string;
    procedure UpdatePanel;
    procedure AddLineToMemo;
    ...
  end;

procedure Tactivextest.FormCreate(Sender: TObject);
begin
  TCPClient.Host := 'localhost';
  TCPClient.Port := 31000;
  try
    TCPClient.Connect;
  except
    on E: Exception do
    begin
      MessageBox(0, 'Cannot connect to server!', 'Error', MB_OK);
      raise;
    end;
  end;
end;

// TTimer OnTimer event handler
procedure Tactivextest.Timer1Timer(Sender: TObject);
begin
  // needed for TThread.Synchronize() to work in a DLL...
  CheckSynchronize;
end;

procedure Tactivextest.TCPClientConnected(Sender: TObject);
begin
  ClientThread := TClientThread.Create(False);
end;

procedure Tactivextest.UpdatePanel;
begin
  Panel1.Caption := 'connect ' + namewithicon + ')';
end;

procedure Tactivextest.AddLineToMemo;
begin
  Memo1.Lines.Add(LineToAdd);
end;

procedure Tactivextest.ProcessCommands(Command: string);
var
  Params: array [1 .. 10] of String;
  ParamsCount, P: Integer;
  PackedParams: TPackedParams;
  IdBytes: TIdBytes;
  Ms: TMemoryStream;
  ReceiveParams, ReceiveStream: Boolean;
  Size: Int64;
begin
  ReceiveParams := False;
  ReceiveStream := False;

  Ms := TMemoryStream.Create;
  try            
    case Command[1] of
      '1': // command with params
      begin 
        Command := Copy(Command, 2, MaxInt);
        ReceiveParams := True;
      end;
      '2': // command + stream
      begin
        Command := Copy(Command, 2, MaxInt);
        ReceiveStream := True;
      end;
      '3': // command with params + stream
      begin
        Command := Copy(Command, 2, MaxInt);
        ReceiveParams := True;
        ReceiveStream := True;
      end;
    end;

    if ReceiveParams then // params incoming
    begin
      TCPClient.Socket.ReadBytes(IdBytes, SizeOf(PackedParams), False);
      BytesToRaw(IdBytes, PackedParams, SizeOf(PackedParams));
      ParamsCount := 0;
      repeat
        Inc(ParamsCount);
        P := Pos(Sep, String(PackedParams.Params));
        Params[ParamsCount] := Copy(String(PackedParams.Params), 1, P - 1);
        Delete(PackedParams.Params, 1, P + 4);
      until (PackedParams.Params = '') or (ParamsCount = 10);
    end;

    if ReceiveStream then // stream incoming
    begin
      Size := TCPClient.Socket.ReadInt64;
      if Size > 0 then
      begin
        TCPClient.Socket.ReadStream(Ms, Size, False);
        Ms.Position := 0;
      end;
    end;

    if Command = 'SIMPLEMESSAGE' then
    begin
      MessageBox(0, PChar(Params[1]), 'Message', MB_OK);
    end
    else if Command = 'INVALIDPASSWORD' then
    begin
      TCPClient.Disconnect;
      MessageBox(0, 'Invalid password!', 'Error', MB_OK);
    end
    else if Command = 'SENDYOURINFO' then // successfully logged in
    begin
      UniqueID := StrToInt(Params[1]);
      TThread.Synchronize(nil, UpdatePanel);
      SendCommandWithParams(TCPClient, 'TAKEMYINFO', namewithicon + Sep);
    end
    else if Command = 'DISCONNECTED' then
    begin
      TCPClient.Disconnect;
    end
    else if Command = 'TEXTMESSAGE' then
    begin
      LineToAdd := Params[1] + ' : ' + Params[2];
      TThread.Synchronize(nil, AddLineToMemo);
    end;
  finally
    Ms.Free;
  end;
end;

initialization
  TActiveFormFactory.Create(
    ComServer,
    TActiveFormControl,
    Tactivextest,
    Class_activextest,
    0,
    '',
    OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
    tmApartment);
end.

indy TCP 和 activex 连接到服务器问题

indy TCP and activex connect to server issues

delphi

indy

indy10