indy Activex Thread issues

[mia]

omg i really thank you but , activex is showing blank ,did you get the thread work with activex ? can you tell me how you get Thread works with activex if iam not so rude can you get this project work in active x with same coding ?the source you have created is awesome but i really need my project can be work in activex here is my current project :

https://www.mediafire.com/?5gbea4ob4x6ad2s

if you get it work in activex i will not believe my self i spend about 6 month to know how i hope you got the equation

[mrmarman]

Hi.

- if ActiveX sample form is blank, this is becaue of the ActiveX.OCX file has not been registered yet.

- ActiveX works. You must register OCX file first you know..

Kod: Tümünü seç

REGSVR32 ClientConnect_ActiveX.ocx

command will enough for this...

- First try and say your opinion later.

[mrmarman]

Hi again..

- I forgotten NickName Check block in remarks { } brackets... in activex OCX source. Please remove these brackets to work SignUp process... ( unit ActiveFormImpl )

- I placed for testing issues. I forgot them.

This block is right, there is no error... It's my bad.

Kod: Tümünü seç

    if Pos( '<NickResult>', strMsg ) > 0 then
    begin
      if ParseXML(strMsg, 'Result') = 'OK'
        then begin
          Memo1.Lines.Add( 'Yes, your selected NickName "'+ ParseXML(strMsg, 'Nick')+ '" is availavle');
          Label10.Caption := 'Yes, nickname "'+ ParseXML(strMsg, 'Nick')+ '" is available';
          BitBtn3.Enabled := True;
        end
        else begin
          Memo1.Lines.Add( 'Sorry, your selected NickName "'+ ParseXML(strMsg, 'Nick')+ '" is NOT availavle');
          Label10.Caption := 'No, nickname "'+ ParseXML(strMsg, 'Nick')+ '" is not available';
          BitBtn3.Enabled := False;
        end;
    end;

EDIT : Link updated on original message above...

This is all ActiveX form operations..
All users signed up with activex, sent messages with activex ext.

Client Example


Server

[mia]

i tested it mrmarman its work i registered the ocx , now iam confused how you get the Thread works in activex ? can you please make my project work with activex too ?

[mrmarman]

Hi.

You can do it by yourself. It is more helpful to realize how to do, am I right ? I explain you the details blow. If you don't satisfy this, I will do it for you, no problem.

We support education as a priority in this forum.

The most important side of this projet was how to communicate thread with main activeform.
I was lucky that, by the first try I succeed. My method is below.

// Connection

Kod: Tümünü seç

procedure TActiveFormX.BitBtn1Click(Sender: TObject);
begin
  if NOT IdTCPClient1.Connected
  then begin
    IdTCPClient1.Host           := '127.0.0.1';
    IdTCPClient1.Port           := 1555;
    IdTCPClient1.ConnectTimeout := 10000;
    Try
      IdTCPClient1.Connect;
      IdTCPClient1.Socket.WriteLn( 'Connection Info' );
    Except;
      MessageDlg('Cannot reach to server..., please try later...', mtError, [mbOk], 0);
    End;
  end
  else begin
    IdTCPClient1.Disconnect;
    if IdTCPClient1.IOHandler <> nil
      then IdTCPClient1.IOHandler.InputBuffer.Clear;
  end;
end;

// Incoming Messages here
// The most important thing TMemo must be triggered by thread...

Kod: Tümünü seç

procedure TActiveFormX.Memo2Change(Sender: TObject);
Var
  strMsg : String;
begin
  strMsg := TMemo(Sender).Text;
  if Pos('<~>', strMsg) > 0 then
  begin
    // Synchronized / Incoming Message Event is Here...
  end;
end;
 

// ActiveX side Thread will create with this. Please be attention, second parameter is Memo2.Lines this is which will be feeding TCP messages.

Kod: Tümünü seç

Var
  ListeningThread : TReadingThread = nil;

procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
  ListeningThread := TReadingThread.Create( IdTCPClient1, Memo2.Lines );
  Memo1.Lines.Add('Connected to server...');
end;

procedure TForm1.IdTCPClient1Disconnected(Sender: TObject);
begin
  if ListeningThread <> nil then
  begin
    ListeningThread.Terminate;
    ListeningThread.WaitFor;
    FreeAndNil(ListeningThread);
  end;
end;

// I produce the thread like below. This TStrings ties the TMemo.Lines by itself. That was the trick shot. Because when I put some value to FLogResult it triggers de TMemo.OnChange event automatically.

Kod: Tümünü seç

type
  TReadingThread = class(TThread)
  protected
    FConnection  : TIdTCPConnection;
    FLogResult   : TStrings;
    procedure Execute; override;
  public
    constructor Create(AConn: TIdTCPConnection; ALogResult: TStrings); reintroduce;
  end;

// FLogResult.Add( strData ); thing goes througt to the Memo2.Lines and that will trigger OnChange event. Thats it...

Kod: Tümünü seç

procedure TReadingThread.Execute;
Var
  strData : String;
begin
  while not Terminated do
  begin
    try
      strData := FConnection.IOHandler.ReadLn;
      if strData <> '' then
      begin
        FLogResult.Add( strData );
      end;
    except
      on E: Exception do
      begin
        FConnection.Disconnect(False);
        if FConnection.IOHandler <> nil
          then FConnection.IOHandler.InputBuffer.Clear;
        Break;
      end;
    end;
    Sleep(1);
  end; // While
end;

[mia]

what i dont understand is the tthread part it will be more helpful if you get my project work with activex with same commands i will understand better ,, i cannot describe how much you give me details to learn and how much helpful guy you are . BIg thanks realy thank you mrmarman .

[mrmarman]

This is your project that I updated to work with thread.

- I made some change on Server Unit.
- There must be separator for knowing that transaction ended for WriteLn routines.
- In this RAR package, you will find whole your project. I produce new (2) projects that ActiveX and ActiveX user projects.

UPDATED LINK BELOW
this is download link.


This is the source

Kod: Tümünü seç

// -------------------------------------------------------------------------- //
// Listening / Reading Thread
// -------------------------------------------------------------------------- //
type
  TReadingThread = class(TThread)
  protected
    FConnection  : TIdTCPConnection;
    FLogResult   : TStrings;
    procedure Execute; override;
  public
    constructor Create(AConn: TIdTCPConnection; ALogResult: TStrings); reintroduce;
  end;

// -------------------------------------------------------------------------- //
// Listening / Reading Thread
// -------------------------------------------------------------------------- //
{ TReadingThread }

constructor TReadingThread.Create(AConn: TIdTCPConnection; ALogResult: TStrings);
begin
  FConnection := AConn;
  FLogResult  := ALogResult;
  inherited Create(False);
end;

procedure TReadingThread.Execute;
Var
  strData : String;
begin
  while not Terminated do
  begin
    try
      strData := FConnection.IOHandler.ReadLn;
      if strData <> '' then
      begin
        FLogResult.Add( strData );
      end;
    except
      on E: Exception do
      begin
        FConnection.Disconnect(False);
        if FConnection.IOHandler <> nil
          then FConnection.IOHandler.InputBuffer.Clear;
        Break;
      end;
    end;
    Sleep(1);
  end; // While
end;

// -------------------------------------------------------------------------- //
Var
  ListeningThread : TReadingThread = nil;
  showip          : Boolean;
  UniqueID        : DWord;

// -------------------------------------------------------------------------- //
// Connect Button
// -------------------------------------------------------------------------- //
procedure TARMANChatClient.bConnectClick(Sender: TObject);
begin
  (Sender as TButton).Enabled := False;
  if not TCPClient.Connected then
  begin
    TCPClient.Host := edHost.Text;
    TCPClient.Port := spPort.Value;
    try
      TCPClient.Connect;
    except
      on e: exception do
      begin
        MessageDlg('Cannot connect to server!', mtInformation, [mbOk], 0);
        (Sender as TButton).Enabled := True;
      end;
    end;
  end
  else
  begin
    SendCommand(TCPClient, 'DISCONNECTED');
    if TCPClient.Connected then
      TCPClient.Disconnect;
  end;
end;

procedure TARMANChatClient.TCPClientConnected(Sender: TObject);
begin
  ListeningThread := TReadingThread.Create( TCPClient, Memo1.Lines );
  SendCommandWithParams(TCPClient, 'LOGIN', edPass.Text  + Sep);
end;

procedure TARMANChatClient.TCPClientDisconnected(Sender: TObject);
begin
  if ListeningThread <> nil then
  begin
    ListeningThread.Terminate;
    ListeningThread.WaitFor;
    FreeAndNil(ListeningThread);
  end;
  bConnect.Enabled := true;
  bConnect.Caption := 'Connect';
  Label5.Caption := 'Client';
  self.Height      := 175;
  self.Width       := 408;
end;

procedure TARMANChatClient.Memo1Change(Sender: TObject);
begin
  // '~' means EndOfTransAction for transaction. I decided it myself, not a common thing.
  if Pos('~', Memo1.Lines.Text ) > 0 then
  begin
    // Synchronized / Incoming Message Event is Here...
    ProcessCommands( Memo1.Lines.Text );
    Memo1.Lines.Clear;
  end;
end;

// -------------------------------------------------------------------------- //
// User Things...
// -------------------------------------------------------------------------- //
procedure TARMANChatClient.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;
  SL: TStringList;
  I: Integer;
begin
  mMessage.Text := Command;
  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;

  Command := Trim(StringReplace( Command, '~', '', [rfReplaceAll]));
  mMessage.Lines.Add( Command );
  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]);
    Label5.Caption := 'Client - connected to server(ID = ' +  IntToStr(UniqueID) + ')';
    //I will only send the username, but you can send any user specific data
    PStr := edUser.Text + Sep;
    SendCommandWithParams(TCPClient, 'TAKEMYINFO', PStr);
    bConnect.Enabled := True;
    bConnect.Caption := 'Disconnect';
    self.Height      := 530;
    self.Width       := 780;
  end;
  if Command = 'DISCONNECTED' then
  begin
    if TCPClient.Connected then
      TCPClient.Disconnect;
    bConnect.Enabled := true;
    bConnect.Caption := 'Connect';
    Label5.Caption   := 'Client';
    self.Height      := 175;
    self.Width       := 408;
  end;
  if Command = 'TEXTMESSAGE' then
  begin
     if showip = True then
      begin
     mMessage.Lines.Add('<' + Params[1] + '>' + Params[2] + Params[3]);
      end else
      begin
      mMessage.Lines.Add('<' + Params[1] + '>' + Params[2]);
      end;
  end;
  if Command = 'GETLIST' then
  begin
    if Assigned(MS) then
    begin
      SL := TStringList.Create;
      try
        SL.LoadFromStream(MS);
        for I := 0 to SL.Count -1  do
        begin
          P := Pos(Sep, Sl.Strings[I]);
          if P <> 0 then
          begin
            with ListView1.Items.Add do
            begin
              Caption := Copy(SL.Strings[I], 1, P - 1);
              Subitems.Add(Copy(SL.Strings[I], P + Length(Sep), Length(SL.Strings[I])));
            end;
          end;
        end;
      finally
        SL.Free;
      end;
      MS.Free;
    end;
  end;
end;


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

procedure TARMANChatClient.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( IdGlobal.RawToBytes(PackedParams, SizeOf(PackedParams)));
end;

procedure TARMANChatClient.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 TARMANChatClient.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 TARMANChatClient.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;

procedure TARMANChatClient.bGetListClick(Sender: TObject);
begin
  ListView1.Items.Clear;
  SendCommand(TCPClient, 'GETLIST');
  showip := True;
end;

procedure TARMANChatClient.bSendClick(Sender: TObject);
begin
  if edMessage.Text <> '' then
  begin
    mMessage.Lines.Add('<' + edUser.Text + '>' + edMessage.Text);
    SendCommandWithParams(TCPClient, 'TEXTMESSAGE', edMessage.Text + Sep);
  end;
end;

// -------------------------------------------------------------------------- //
// -------------------------------------------------------------------------- //

[mia]

it does not connect to the server mrmarman on client.exe is connected , but activex client is not connected

[mrmarman]

That's my bad, I packed old server project.

You can download and use the server project that attached this message.

In this Server project, ActiveX projects will connect successfully, but old Client project not.

Old Client will not connect until you update code by according the ActiveXClient project..
I have no free time to handle whole projects.

EDIT : I also updated the download link with new one above.

[mia]

omg you are awesomeeeeeeeeeeeeeeeeeeee thank youuuuuuuuuuu very very muchhhhhhhhhhhhh

[mia]

you are awesome man you are great man , for education propose can you tell me what was the problem what is the indecent with server ?

[mrmarman]

Message send/receive operations may be multiline, or may be longer than packet buffer. In this case we need to know that the message packet totally gathered.

I added "~" to the message packet ends.
Client collects the message packets until see this character.
If don't what happens. Client never knows the packet totally gathered. So on...

[mia]

thank you mrmarman , other question why when i send message i got command name in tmemo like

1TEXTMESSAGE
<test>ihi

also i removed this ~ is this will effect the process ?

also can i synchronize processcommand in diffrent way ? like before because on change memo looks buggy also its always clear the messages

[mrmarman]

You're welcome.
I tried to be faithful your code mostly. Of course it has side affects. Because this is your code, I cannot fully understand what you did. I have no time to understand this code.

So, this is not final shot. You will make a restoration in this code.

- You need a TMemo which use OnChange event. It must be always clear after transaction. Because each transaction will go to the ProcessCommands procedure.

- Now you can put a new TMemo and use that memo's OnChange event.
- I need to remember you that, please change the line below with new TMemo. For example if it named Memo2 then you write

Kod: Tümünü seç

  ListeningThread := TReadingThread.Create( TCPClient, Memo2.Lines );

This is important thing that not to skip.

- I highly recommend that, please look at my code (remember that animation gif thing), too. That code will tell you more things.


- by the way, I found a little improve the opportunity for my rusty English Sorry for the deficient senteces. I usually good at read but hard to explain something.

[mia]

i try to see animated gif its not animated i cant see the process