Thread ile ClientSocket/ServerSocket uygulaması

[gkimirti]

bu uygulama @meteor arkadasın sordugu soruya binaen hazırlanmıstır.
icimi kemmiren kurt bana bu problemi cozme gucunu verdi ve halloldu:)

uygulama Server ve Client parcadan olusmakta

Server kısmı epey basit:

serv.pas

Kod: Tümünü seç

unit serv;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ScktComp, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Enabled:=False;
  try
    ServerSocket1.ServerType := stThreadBlocking;
    ServerSocket1.Active:=True;
    Button2.Enabled:=True;
  except
    Button1.Enabled:=True;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Button2.Enabled:=False;
  ServerSocket1.Active:=False;
  Button1.Enabled:=True;
end;

end.

serv.dfm

Kod: Tümünü seç

object Form1: TForm1
  Left = 156
  Top = 165
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsSingle
  Caption = 'Form1'
  ClientHeight = 69
  ClientWidth = 104
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 16
    Top = 0
    Width = 75
    Height = 25
    Caption = 'Start'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 16
    Top = 32
    Width = 75
    Height = 25
    Caption = 'Stop'
    Enabled = False
    TabOrder = 1
    OnClick = Button2Click
  end
  object ServerSocket1: TServerSocket
    Active = False
    Port = 9999
    ServerType = stThreadBlocking
    Left = 32
    Top = 16
  end
end

Client kısmı thread ile yapıldı.

clnt.pas

Kod: Tümünü seç

unit clnt;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ScktComp;

type
  TClientSockThread = class(TThread)
  private
    fIp: string;
    fClientSocket: TClientSocket;
    procedure ClntConnect(Sender: TObject; Socket: TCustomWinSocket);
  protected
    procedure DoTerminate; override;
    procedure Execute; override;
    property Clnt: TClientSocket read fClientSocket write fClientSocket;
  public
    constructor Create(Ip: string);
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  for i := 1 to 254 do
    TClientSockThread.Create('192.168.0.' + IntToStr(i));
end;

{ TClientSockThread }

procedure TClientSockThread.ClntConnect(Sender: TObject; Socket:
  TCustomWinSocket);
begin
  //formdaki memo yada liste kutusuna baglı olanı ekle
  Form1.Memo1.Lines.Add(Socket.RemoteHost);
end;

constructor TClientSockThread.Create(Ip: string);
begin
  inherited Create(False);
  fIp := Ip;
  //thread kapanırken kendini sonlandırır.
  //bu ozellik bu gibi durumlarda cok ise yaramakta
  FreeOnTerminate := True;
end;

procedure TClientSockThread.DoTerminate;
begin
  //thread sonlanırken clientsocket nesnesi yokedilir.
  fClientSocket.Free;
  inherited DoTerminate;
end;

procedure TClientSockThread.Execute;
begin
  //socket create edilir.
  fClientSocket := TClientSocket.Create(nil);

  with fClientSocket do
  try
    try
      Port := 9999;//herhangi bir portno
      ClientType := ctBlocking;//NonBlocking calısmıyor.
      Address := fIp;
      OnConnect := ClntConnect;//baglantı gerceklesince calısacak
      Active := True;
    finally
      Active := False;
    end;
  except
    //baglı olmayan makinalar icin hata verecek
  end;
end;

end.

clnt.dfm

Kod: Tümünü seç

object Form1: TForm1
  Left = 119
  Top = 217
  Width = 145
  Height = 232
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 8
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Memo1: TMemo
    Left = 0
    Top = 40
    Width = 129
    Height = 153
    TabOrder = 1
  end
end

Calısmalarınızda Basarılar.....

[ferda]

Selamün Aleyküm Dostlar,

Yukarıki clientsocket koduna ilave olarak, OnConnect olayı gibi OnDisconnect ve OnRead olayları oluşturdum. Ama clientsocket bağlantı kurar kurmaz disconnet oluyor. Bunun sebebi ne olabilir? bu sorunu aştığımı varsayarsak,yukarıdaki yapıda, IP numarası xxx.xxx.xxx.xxx olan clientsocket'i disconnect yap nasıl diyebilirim ? Şimdiden teşekkürler, Yukarıdaki kodun değiştirilmiş hali ;

Kod: Tümünü seç

unit clnt;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ScktComp, JvComponentBase, JvThread;

type
TClientSockThread = class(TThread)
procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);

private
fIp: string;
fClientSocket: TClientSocket;
protected
procedure DoTerminate; override;
procedure Execute; override;
property Clnt: TClientSocket read fClientSocket write fClientSocket;
public
constructor Create(Ip: string);
end;


TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
    Button2: TButton;
procedure Button1Click(Sender: TObject);
    procedure JvThread1Execute(Sender: TObject; Params: Pointer);
    procedure Button2Click(Sender: TObject);
private

public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin

TClientSockThread.Create('192.168.7.13');
TClientSockThread.Create('192.168.7.201');

end;
procedure TClientSockThread.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
begin
//formdaki memo yada liste kutusuna baglı olanı ekle
Form1.Memo1.Lines.Add(socket.ReceiveText  );
end;

{ TClientSockThread }

procedure TClientSockThread.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
begin
//formdaki memo yada liste kutusuna baglı olanı ekle
Form1.Memo1.Lines.Add(socket.RemoteAddress  );
socket.SendText('<komut=giris&nick=PC>');
sleep(2000);
socket.SendText('<komut=giris&nick=PC>');
end;
procedure TClientSockThread.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
var
  I: Integer;
begin
for I := 0 to form1.Memo1.Lines.Count    - 1 do
  begin
    if form1.Memo1.Lines.Strings[I]=socket.RemoteAddress     then
    Form1.Memo1.Lines.Delete(I);
  end;
end;
constructor TClientSockThread.Create(Ip: string);
begin
inherited Create(False);
fIp := Ip;
//thread kapanırken kendini sonlandırır.
//bu ozellik bu gibi durumlarda cok ise yaramakta
FreeOnTerminate := True;
end;
procedure TClientSockThread.DoTerminate;
begin
//thread sonlanırken clientsocket nesnesi yokedilir.
fClientSocket.Free;
inherited DoTerminate;
end;
procedure TClientSockThread.Execute;
begin
//socket create edilir.
fClientSocket := TClientSocket.Create(nil);
with fClientSocket do
try
try
Port := 9050;//herhangi bir portno
ClientType := ctBlocking;//NonBlocking calısmıyor.
Address := fIp;
OnConnect := ClientSocket1Connect;//baglantı gerceklesince calısacak
OnDisConnect := Clientsocket1DisConnect;
onread:= ClientSocket1Read;
Active := True;
finally
Active := False;
end;
except
//baglı olmayan makinalar icin hata verecek
end;
end;
end.