Indy - TCPServer WriteBuffer

0

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.
0
procedure TForm1.Button4Click(Sender: TObject);
var
  AThreada: TIdPeerThread; //<-to jest lokalna zmienna
  Paka: TPackag;
begin
  Paka.UsrName := 'piter';
  Paka.kick := 1;

  AThreada.Connection.WriteBuffer(Paka, SizeOf(Paka)); //<- i nigdzie nie jest zainicjowana, tutaj dostajesz AV bo odwołujesz się do niezainicjowanego obiektu
end;
0

No dobra poradziłem sobie :) ale pojawił się kolejny problem.
Użytkowników rozpoznaje po Localname(hostname) i jak sprawdzić klientem jaki ma localname/hostname?

Chce wysłać do wszystkich pakiet o zawartości (teoretyczny kod)

name := PanNumer1;
ZablokujMuPrzyciskDisconnect := 1;

Pakiet wysłać umiem, ale problem jest taki, że aplikacja kliencka nie wie do kogo to zostało wysłane - wiec chciałbym odczytać LocalName i porównać na zasadzie:

if Pakiet.name = MojLocalName then begin
 if ZablokujMuPrzyciskDisconnect = 1 then begin
PrzyciskDisconnect.enabled := false;
Edit1.text := 'zablokowano';

end;
end;

Jak odczytać ze strony klienta, jego (jego własny) LocalName?

0

Example:

var
MojLocalName : string;
begin
MojLocalName := Form1.IdTCPClient1.LocalName;
...

1 użytkowników online, w tym zalogowanych: 0, gości: 1