Indy TCP和Activex连接到服务器问题

Question

I am trying to transform my delphi project from VCL to ActiveX. I have issues with a client thread. Here is my client thread type:

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

And here is the implementation:

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.

And here is how I start the client thread with Indy's TCP OnConnected event:

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

And here is how I connect to the server on the Form's OnCreate event:

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;

send commands

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;

I am able to connect to the server, but the client thread cannot be started same as VCL so I am unable to call SendCommands() as I have been disconnected because I cannot use client thread inside ActiveX. I have searched for many days about how to solve, and I cannot find a solution to this problem. I know ActiveX is dead, but this is for education purposes.

Answer 1

It is not possible for TIdTCPClient.OnConnected to not be triggered if Connect() is successful, so the client thread has to be getting created. And if Start() is not raising an exception, then the thread will start running.

However, a major problem with your thread code is that HandleInput() is being run in the context of the main thread via TThread.Synchronize() , which DOES NOT work in a DLL (ActiveX or otherwise) without extra cooperation of the main thread of the hosting EXE. HandleInput() should not be synchronized at all, but then once you fix that, ProcessCommands() is doing things that are not thread-safe (using MessageDlg() , and accessing Panel1 and Memo1 directly), which do need to be synchronized.

So, you need to re-write your thread logic to avoid these pitfalls. Try something more like this:

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.