Сервер зависает после подключения IdTCPClient

Question

У меня есть два приложения, которые обмениваются данными друг с другом с помощью TCPServer и компонентов TCPClient. Сервера запускается в скрытом режиме: Application.ShowMainForm: = false;

Просто значок на SystemTray взаимодействует с user.After запуска сервера, если я запускаю клиент и и подключиться к серверу этой замораживанию, но если я изменить свойство сервера Application.ShowMainForm до true все работает отлично. Это код, я использую:

Клиент приложение: приложение

procedure TFormCliente.FormCreate(Sender: TObject); 
begin 
    try 
    cliente.Connect; 
    except 
    hint1.ActivateHint(FormCliente,'Error.' + #13 + 
    'Verify if server is running','VCall',5000); //hint1 is a Jed component 
    end; 
end; 

Сервер:

[...] 
private 
    FConexoes: TList; 
[...] 


type 
    PClient = ^TClient; 
    TClient = record 
    PeerIP  : string[15];   { Client IP address } 
    HostName : String[40];   { Hostname } 
    Connected,       { Time of connect } 
    LastAction : TDateTime;    { Time of last transaction } 
    AContext  : Pointer;    { Pointer to thread } 
    end; 
[...] 

procedure TfrmServer.FormCreate(Sender: TObject); 
begin 
    FConexoes := TList.Create; 
end; 

procedure TFrmServer.FormDestroy(Sender: TObject); 
begin 
    FConexoes.Free; 
end; 

procedure TFrmServer.IdTCPServer1Connect(AContext: TIdContext); 
var 
    NewClient: PClient; 
begin 
    GetMem(NewClient, SizeOf(TClient)); 
    NewClient.PeerIP  := AContext.Connection.Socket.Binding.PeerIP; 
    NewClient.HostName := GStack.HostByAddress(NewClient.PeerIP); 
    NewClient.Connected := Now; 
    NewClient.LastAction := NewClient.Connected; 
    NewClient.AContext := AContext; 
    AContext.Data   := TObject(NewClient); 
    ListView1.Items.Add.Caption:=NewClient.HostName; 
end; 

Если форма сервер виден, клиент имя хоста добавляется listview, но если форма сервера не видна и запускается клиентом и подключается, сервер зависает, пока я не убью клиентский процесс. Может кто-нибудь мне помочь?

Answer 1

Ваш прямой доступ к TListView в мероприятии OnConnect не является потокобезопасным. Это само по себе может вызвать взаимоблокировки и сбои. Попробуйте это вместо:

type 
    PClient = ^TClient; 
    TClient = record 
    PeerIP  : string;    { Client IP address } 
    HostName : String;    { Hostname } 
    Connected,       { Time of connect } 
    LastAction : TDateTime;    { Time of last transaction } 
    AContext : Pointer;    { Pointer to thread } 
    end; 

procedure TFrmServer.IdTCPServer1Connect(AContext: TIdContext); 
var 
    Client: PClient; 
begin 
    New(Client); 
    try 
    Client.PeerIP  := AContext.Connection.Socket.Binding.PeerIP; 
    Client.HostName := GStack.HostByAddress(Client.PeerIP); 
    Client.Connected := Now; 
    Client.LastAction := Client.Connected; 
    Client.AContext := AContext; 

    TThread.Synchronize(nil, 
     procedure 
     var 
     Item: TListItem; 
     begin 
     Item := ListView1.Items.Add; 
     Item.Data := Client; 
     Item.Caption := Client.HostName; 
     end 
    ); 
    except 
    Dispose(Client); 
    raise; 
    end; 

    AContext.Data := TObject(Client); 
end; 

procedure TFrmServer.IdTCPServer1Disconnect(AContext: TIdContext); 
var 
    Client: PClient; 
begin 
    Client := PClient(AContext.Data); 
    AContext.Data := nil; 

    if Client = nil then Exit; 

    TThread.Synchronize(nil, 
    procedure 
    var 
     Item: TListItem; 
    begin 
     Item := ListView1.FindData(0, Client, True, False); 
     if Item <> nil then 
     Item.Delete; 
    end 
); 

    Dispose(NewClient); 
end;