Newsgroups : Borland : borland.public.delphi.internet.winsock : 2006 Dec : 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;