Od kilku dni próbuję napisać proste aplikacje Klienta i Server na starszych Indy.
Doszedłem do momentu w którym potrzebuję rozłączyć użytkownika z serwerem - ale polecenie musi zostać wysłane od strony serwera. Wpadłem na pomysł, że jak na formie serwera, naciśnie się przycisk to Server wysyła pakiet "Paka" o zawartości nazwy hosta i wartości kick = 1.
Aplikacja Kliencka sprawdza czy odebrana paka zawiera jej host i czy wartość kick jest równa 1. Jeżeli tak - rozłącza.
Problem pojawił się przy aplikacji serwerowej, kiedy naciskam przycisk po prostu dostaje systemowy ERROR.
Domyślam się, że błąd tkwi w oprogramowaniu tego przycisku (ostatnie linie kodu) z racji, że przy kompilacji dostaje Warning
Variable 'AThreada' might not have been initialized
unit komunikator_serwer;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdThreadMgr, IdThreadMgrDefault, IdBaseComponent, IdComponent,
IdTCPServer, StdCtrls, Spin, Grids, Menus, ExtCtrls;
type
WConnection = ^TConnection;
TConnection = record
Host : String[20];
Thread : Pointer;
end;
TPackage = record
UserNick,
Txt : string[255];
Zsm : integer;
end;
TPackag = record
UsrName : string[255];
kick : integer;
end;
TForm1 = class(TForm)
polacz: TButton;
IdTCPServer1: TIdTCPServer;
IdThreadMgrDefault1: TIdThreadMgrDefault;
akcje: TMemo;
Button1: TButton;
Edit1: TEdit;
Bevel1: TBevel;
Label1: TGroupBox;
Button2: TButton;
Edit2: TEdit;
Label2: TLabel;
Label3: TLabel;
Button3: TButton;
Edit3: TEdit;
Label4: TLabel;
Label5: TLabel;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
About1: TMenuItem;
ArenaSite1: TMenuItem;
Votemap1: TMenuItem;
Votekick1: TMenuItem;
Enlargemaptime1: TMenuItem;
ListBox1: TListBox;
Label6: TLabel;
Edit4: TEdit;
procedure polaczClick(Sender: TObject);
procedure IdTCPServer1Connect(AThread: TIdPeerThread);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
ConnectionLst: TThreadList;
implementation
{$R *.dfm}
procedure TForm1.polaczClick(Sender: TObject);
begin
IdTCPServer1.DefaultPort := 2880;
IdTCPServer1.Active := True;
Akcje.Lines.Add('Server ON');
Label1.Caption := 'Server ON';
end;
procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
var
NewConnection: WConnection;
begin
GetMem(NewConnection, SizeOf(TConnection));
NewConnection.Host :=AThread.Connection.LocalName;
NewConnection.Thread :=AThread;
AThread.Data:=TObject(NewConnection);
try
ConnectionLst.LockList.Add(NewConnection);
finally
ConnectionLst.UnlockList;
end;
akcje.Lines.Add(NewConnection.Host+ ' connected > ' +TimeToStr(Time));
Listbox1.items.Add(NewConnection.Host);
end;
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
DestThread: TIdPeerThread;
i: Integer;
DestConnection: WConnection;
Package, NewPackage: TPackage;
begin
begin
AThread.Connection.ReadBuffer (Package, SizeOf (Package));
akcje.Lines.Add (TimeToStr(Time)+ ' - ' + Package.UserNick+ ' : '+Package.Txt);
akcje.Lines.Add(IntToStr(Package.Zsm));
NewPackage := Package;
with ConnectionLst.LockList do
try
for i := 0 to Count-1 do
begin
DestConnection := Items[i];
DestThread := DestConnection.Thread;
DestThread.Connection.WriteBuffer(NewPackage, SizeOf(NewPackage), True);
end;
finally
ConnectionLst.UnlockList;
end;
end;
end;
procedure TForm1.IdTCPServer1Disconnect(AThread: TIdPeerThread);
var
ActiveConnection: WConnection;
i : integer;
begin
ActiveConnection := WConnection(AThread.Data);
try
ConnectionLst.LockList.Remove(ActiveConnection);
finally
ConnectionLst.UnlockList;
end;
FreeMem(ActiveConnection);
AThread.Data := nil;
akcje.Lines.Add(ActiveConnection.Host+ ' leaved > ' +TimeToStr(Time));
for i := 0 to Listbox1.items.count - 1 do
if Pos(ActiveConnection.Host, Listbox1.items[i]) <> 0 then
Listbox1.items.Delete(i);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ConnectionLst := TThreadList.Create;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IdTCPServer1.Active := False;
ConnectionLst.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
IdTCPServer1.Active := False;
Akcje.Lines.Add('Server OFF');
Label1.Caption := 'Server OFF';
end;
procedure TForm1.Button4Click(Sender: TObject);
var
AThreada: TIdPeerThread;
Paka: TPackag;
begin
Paka.UsrName := 'piter';
Paka.kick := 1;
AThreada.Connection.WriteBuffer(Paka, SizeOf(Paka));
end;
end.