Newsgroups : Borland : borland.public.delphi.internet.winsock : 2006 Dec : TIDTCPCmdServer

www.cryer.info
Managed Newsgroup Archive

TIDTCPCmdServer

Subject:TIDTCPCmdServer
Posted by:"Roberto Colpani" (roberto.colpa..@vetrariafratellicolpani.it)
Date:Mon, 4 Dec 2006 18:03:07

I have a program that use the obsolete component TClientSocket and
TServerSochet with many problems. Now I want to update my program with the
new TIdCmdTCPServer and TIDTCPClient components.
I have  15 user connected anytime and when a user want to do some particular
operation, it may informs the other users that  they give their
autorization. It will be done with the two components.
Now I have done a small program to text my intention a there is something
that go wrong: I connect to the server, and when I click on the transfer
button the client side is freezy until I don't stop the server side.
This is the code:
ServerSide:
  TMainForm = class(TForm)
    TrayIcon1: TTrayIcon;
    PopupMenu1: TPopupMenu;
    Exit1: TMenuItem;
    ServerTango: TIdCmdTCPServer;
    Showconnecteduser1: TMenuItem;
    procedure Exit1Click(Sender: TObject);
    procedure ServerTangoCommandHandlers0Command(ASender: TIdCommand);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ServerTangoCommandHandlers1Command(ASender: TIdCommand);
    procedure Showconnecteduser1Click(Sender: TObject);
    procedure ServerTangoCommandHandlers2Command(ASender: TIdCommand);
    procedure ServerTangoDisconnect(AContext: TIdContext);
  private
    { Private declarations }
    UserList: TThreadList;
    TmpID: String;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses TngConnectedUser;

{$R *.dfm}

procedure TMainForm.Exit1Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  UserList := TThreadList.Create;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
Var
  AList: TList;
  AUser: TConnectedUser;
  Counter: Integer;
begin
  AList := UserList.LockList;
  for Counter := 0 to AList.Count - 1 do
   begin
    AUser := TConnectedUser(AList[Counter]);
    AUser.Free;
   end;
  AList.Clear;
  UserList.UnlockList;
  UserList.Free;
end;

procedure TMainForm.ServerTangoCommandHandlers0Command(ASender: TIdCommand);
Var
  AUser: TConnectedUser;
begin
{ Command: 'RegisterUser;UserName ComputerName'}
  if ASender.Params.Count > 0 then
   begin
    AUser  := TConnectedUser.Create(ASender.Params[0], ASender.Params[1],
ASender.Context.Connection.Socket.Binding.PeerIP);
    UserList.Add(AUser);
   end;
end;

procedure TMainForm.ServerTangoCommandHandlers1Command(ASender: TIdCommand);
Var
  I: Integer;
  AUser: TConnectedUser;
  AList: TList;
begin
{ Command: 'UnRegisterUser;UserName ComputerName'}
  AList := UserList.LockList;
  for I := 0 to AList.Count - 1 do
   begin
    AUser := TConnectedUser(AList[I]);
    if (AUser.UserName = ASender.Params[0]) and (AUser.ComputerName =
ASender.Params[1]) then
     begin
      AList.Delete(I);
      AUser.Free;
      Break;
     end;
   end;
  UserList.UnlockList;
end;

procedure TMainForm.ServerTangoCommandHandlers2Command(ASender: TIdCommand);
Var
  AList, AServerList: TList;
  AUser: TConnectedUser;
  I, Index: Integer;
  Text: String;
  ASenderName, ASenderComputerName: String;
  ASenderKindOfTransfer: Integer;
begin
  { Command: 'RequestTranfer; UserName ComputerName KindOfTranfer}
  ASenderName := ASender.Params[0];
  ASenderComputerName := ASender.Params[1];
  ASenderKindOfTransfer := StrToInt(ASender.Params[2]);
  AList := UserList.LockList;
  try
   {Check if someone is doing a tranfer}
   for I  := 0 to AList.Count - 1 do
    begin
     AUser := TConnectedUser(AList[I]);
     if AUser.DoingTransfer then
        Break;
     end;
    if AUser.DoingTransfer then
      begin
      // There is someone thai is doing a tranfer, so it reject the request;
      end
    else
      begin
      // Nobody is doing a tranfer so I accept;
      for I := 0 to AList.Count - 1 do
        begin
       AUser := TConnectedUser(AList[I]);
      if (AUser.UserName = ASender.Params[0]) and (AUser.ComputerName =
ASender.Params[1]) then
          begin
          AUser.DoingTransfer := True;
          case StrToInt(ASender.Params[2]) of
            0: AUser.TransferKind := tkAllAnag;
            1: AUser.TransferKind := tkAnag;
            2: AUser.TransferKind := tkAllArt;
            3: AUser.TransferKind := tkArt;
            4: AUser.TransferKind := tkAllMov;
            5: AUser.TransferKind := tkMov;
            6: AUser.TransferKind := tkRiBa;
            7: AUser.TransferKind := tkOrd;
          end;
          Break;
          end;
        end;
      case AUser.TransferKind of
      tkAllAnag: Text := '100;' + AUser.UserName + ' da ' +
AUser.ComputerName + 'richiede trasferimento di tutti i clienti e
fornitori.';
      tkAnag: Text := '100;' + AUser.UserName + ' da ' + AUser.ComputerName
+ 'richiede trasferimento di clienti e fornitori modificati.';
      tkAllArt: Text := '100;' + AUser.UserName + ' da ' +
AUser.ComputerName + 'richiede trasferimento di tutti gli articoli.';
      tkArt: Text := '100;' + AUser.UserName + ' da ' + AUser.ComputerName +
'richiede trasferimento di articoli modificati.';
      tkAllMov: Text := '100;' + AUser.UserName + ' da ' +
AUser.ComputerName + 'richiede trasferimento dei movimenti di magazzino.';
      tkMov: Text := '100;' + AUser.UserName + ' da ' + AUser.ComputerName +
'richiede trasferimento dei movimenti di magazzino di un mese.';
      tkRiBa: Text := '100;' + AUser.UserName + ' da ' + AUser.ComputerName
+ 'richiede trasferimento del file delle Ri.Ba.';
      tkOrd: Text := '100;' + AUser.UserName + ' da ' + AUser.ComputerName +
'richiede trasferimento di ordini.';
      end;
      AServerList := ServerTango.Contexts.LockList;
      try
        for I := 0 to AServerList.Count - 1 do
          begin
          if ASender.Context <> TIdContext(AServerList[I]) then
            TIdContext(AServerList[I]).Connection.IOHandler.WriteLn(Text);
          end;
      finally
       ServerTango.Contexts.UnlockList;
      end;
      end;
  finally
   UserList.UnlockList;
  end;
end;

procedure TMainForm.ServerTangoDisconnect(AContext: TIdContext);
Var
  MyIP: String;
  AServerList, AUserList: TList;
  AUser: TConnectedUser;
  I: Integer;
begin
  AServerList := ServerTango.Contexts.LockList;
  try
  for I := 0 to AServerList.Count - 1 do
    begin
    if AContext = TIDContext(AServerList[I]) then
      begin
      AUserList := UserList.LockList;
      try
        AUser := AUserList[I];
        AUserList.Delete(I);
        AUser.Free;
        Break;
      finally
        UserList.UnlockList;
      end;
      end;
    end;
  finally
    ServerTango.Contexts.UnlockList;
  end;
end;

Client side:
unit TextForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
StdCtrls,
  Buttons, tngListener;

type
  TfrmText = class(TForm)
    btnConnect: TButton;
    TangoClient: TIdTCPClient;
    btnDisconnect: TButton;
    lblUserName: TLabel;
    lblComputerName: TLabel;
    sbChangeUserName: TSpeedButton;
    btnTransfer: TButton;
    procedure btnConnectClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure sbChangeUserNameClick(Sender: TObject);
    procedure btnDisconnectClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btnTransferClick(Sender: TObject);
  private
    { Private declarations }
    UserName: String;
    ComputerName: String;
    AListener: TextTangoListener;
  public
    { Public declarations }
  end;

var
  frmText: TfrmText;

implementation

{$R *.dfm}

procedure TfrmText.btnConnectClick(Sender: TObject);
begin
  TangoClient.Connect;
  TangoClient.GetResponse(200);
  TangoClient.SendCmd('RegisterUser;' + UserName + ' ' + ComputerName);
  AListener := TextTangoListener.Create(False);
end;

procedure TfrmText.btnDisconnectClick(Sender: TObject);
begin
  AListener.Terminate;
  TangoClient.Disconnect;
end;

procedure TfrmText.btnTransferClick(Sender: TObject);
begin

  TangoClient.SendCmd('RequestTransfer;' + UserName + ' ' + ComputerName + '
7');
  showmessage(TangoClient.LastCmdResult.Text.Text);
end;

procedure TfrmText.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if TangoClient.Connected then
    begin
    MessageDlg('Disconnettersi da TangoServer', mtWarning, [mbOk], 0);
    CanClose := False;
    end;
end;

procedure TfrmText.FormCreate(Sender: TObject);
Var
  P, S: PChar;
  Len: Cardinal;
begin
  Len := 15;
  GetMem(P, Len);
  GetUserName(P, Len);
  UserName := P;
  FreeMem(P);
  Len := MAX_COMPUTERNAME_LENGTH + 1;
  GetMem(S, Len);
  GetComputerName(S, Len);
  ComputerName := S;
  FreeMem(S);
  lblUserName.Caption := UserName;
  lblComputerName.Caption := ComputerName;
end;

procedure TfrmText.sbChangeUserNameClick(Sender: TObject);
begin
  UserName := InputBox(Application.Name, 'Digitare il nome dell''utente.',
UserName);
end;

end.
The client listener Thread:
unit TngListener;

interface

uses
  Classes;

type
  TextTangoListener = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;

implementation

uses TextForm, Dialogs;

{ Important: Methods and properties of objects in visual components can only
be
  used in a method called using Synchronize, for example,

      Synchronize(UpdateCaption);

  and UpdateCaption could look like,

    procedure TextTangoListener.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }

{ TextTangoListener }

procedure TextTangoListener.Execute;
Var
  AText: String;
begin
  while frmText.TangoClient.Connected do
    begin
    AText := frmText.TangoClient.IOHandler.ReadLn;
    showmessage(AText);
    end;

end;

end.
What I'm do wrong?
Thanks;

Replies:

www.cryer.info
Managed Newsgroup Archive