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;

以下是我在Form 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

如果TIdTCPClient.OnConnected成功，则无法触发Connect()，因此必须创建客户端线程。如果Start()没有引发异常，那么该线程将开始运行。

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

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

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;

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

1 个答案: