WONG BODOH NGAKU PINTER: bikin applikasi chatting dengan client server delphi

oke disini aku akan berikan cara mudah bikin applikasi chatting server client yang menurut saya cukup mudah .. gak susah2 amat ..!! silakan lihat screenshot sederhana dibawah :

unit U_Server;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, XPMan, StdCtrls, ComCtrls, winsock, ExtCtrls;

type
  TForm1 = class(TForm)
    Button2: TButton;
    Memo2: TMemo;
    XPManifest1: TXPManifest;
    ServerSocket1: TServerSocket;
    Memo1: TRichEdit;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    procedure Button2Click(Sender: TObject);
    procedure ServerSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  user_klient : string;
implementation

{$R *.dfm}

function GetIPFromHost
(var HostName, IPaddr, WSAErr: string): Boolean; 
type 
  Name = array[0..100] of Char; 
  PName = ^Name; 
var 
  HEnt: pHostEnt; 
  HName: PName; 
  WSAData: TWSAData; 
  i: Integer; 
begin 
  Result := False;     
  if WSAStartup($0101, WSAData) <> 0 then begin 
    WSAErr := 'Winsock is not responding."'; 
    Exit; 
  end; 
  IPaddr := ''; 
  New(HName); 
  if GetHostName(HName^, SizeOf(Name)) = 0 then
  begin 
    HostName := StrPas(HName^); 
    HEnt := GetHostByName(HName^); 
    for i := 0 to HEnt^.h_length - 1 do 
     IPaddr :=
      Concat(IPaddr,
      IntToStr(Ord(HEnt^.h_addr_list^[i])) + '.'); 
    SetLength(IPaddr, Length(IPaddr) - 1); 
    Result := True; 
  end
  else begin 
   case WSAGetLastError of
    WSANOTINITIALISED:WSAErr:='WSANotInitialised'; 
    WSAENETDOWN      :WSAErr:='WSAENetDown'; 
    WSAEINPROGRESS   :WSAErr:='WSAEInProgress'; 
   end; 
  end; 
  Dispose(HName); 
  WSACleanup; 
end;


procedure TForm1.Button2Click(Sender: TObject);
var jumlah_koneksi,klient : integer;
begin
Memo1.Lines.Add('<Server> : '+Memo2.Text);
jumlah_koneksi:=ServerSocket1.Socket.ActiveConnections;
if jumlah_koneksi >= 1 then
begin
  for klient := 0 to jumlah_koneksi-1 do
  begin
  ServerSocket1.Socket.Connections[klient].SendText('<Server> : '+Memo2.Text);
  end;
end;
Memo2.Clear;
end;

procedure TForm1.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
memo1.Lines.Add('<Error dari> '+IntToStr(ErrorCode));
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
memo1.Lines.Add(Socket.ReceiveText);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Port:=25;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
ServerSocket1.Open;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var Host, IP, Err: string;
begin
if GetIPFromHost(Host, IP, Err) then begin
    StatusBar1.Panels[0].Text:='Computer Name : '+Host+' / Computer IP : '+IP;
  end
  else
    MessageDlg(Err, mtError, [mbOk], 0);
    Timer1.Enabled:=false;
end;


end.

unit U_Client;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo2: TMemo;
    XPManifest1: TXPManifest;
    ClientSocket1: TClientSocket;
    Edit1: TEdit;
    Button3: TButton;
    memo1: TRichEdit;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
     private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Math;

{$R *.dfm}



procedure TForm1.Button1Click(Sender: TObject);
begin
ClientSocket1.Host:=Edit1.Text;
ClientSocket1.Port:=25;
ClientSocket1.Open;
//ClientSocket1.Active:=true;
Memo1.Clear;
Timer1.Enabled:=true;
//ClientSocket1.Socket.SendText(ClientSocket1.Host);

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
memo1.Lines.Add('<'+Edit2.Text+'>   : '+Memo2.Text);
if (ClientSocket1.Socket.Connected) then
  begin
  ClientSocket1.Socket.SendText('<'+Edit2.Text+'>   : '+Memo2.Text);
  memo2.Clear;
   Button1.Visible:=false;
   //Button3.Caption:='Connected with [ '+ClientSocket1.Host+' ]';
   Button3.Visible:=true;
  end;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
if Socket.RemoteHost <> '' then begin
memo1.Lines.Add('connected with '+Socket.RemoteHost+' success');
end else ShowMessage('koneksi gagal');


end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
memo1.Lines.Add('<'+Edit2.Text+'> error '+IntToStr(ErrorCode));
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
begin
Memo1.Lines.Add(Socket.ReceiveText);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
//if ClientSocket1.Socket.Connected then begin
 ClientSocket1.Close;
 //ClientSocket1.Active:=false;
 Button3.Visible:=false;
 Button1.Visible:=true;
 //end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   Button1.Visible:=false;
   Button3.Caption:='Disconnect';
   Button3.Visible:=true;
   StatusBar1.Panels[0].Text:='connected With Server [ '+ClientSocket1.Host+' ]';
   StatusBar1.Panels[1].Text:='Status : Connected';
   Timer1.Enabled:=False;

end;

procedure TForm1.FormActivate(Sender: TObject);
begin
StatusBar1.Panels[0].Text:='Not Connected With Server ';
StatusBar1.Panels[1].Text:='Status : Disconnected';
end;

end.

mohon maaf dikarenakan saya agak malas mengulas lebih rinci ..jadi disini saya share juga file source code nya silakan didownload dan di utak atik sendiri ..!! ^,^

source code

WONG BODOH NGAKU PINTER

Selasa, 10 Juli 2012

bikin applikasi chatting dengan client server delphi

Tidak ada komentar:

Posting Komentar