Cara Buat Aplikasi chating dengan Delphi

Membuat aplikasi chatingan

gambaran dari aplikasi saya seperti itu...
untuk aplikasinya DELPHI full KEYGEN bisa download di kuya android  DI SINI

aplikasi chat saya tugas dari mata kuliah sister

untuk tampilannya memkai alpha skin, jika anda belum punya cari di google ya :)
klau saya memakai busines BFS untuk mempercantik tampilan from saya DISINI

ok lansung saja

ini tutorialnya

source code untuk server DOWNLOAD

unit agus;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdSocketHandle, IdBaseComponent, IdComponent, IdTCPServer,
  StdCtrls, sLabel, sButton, sSkinManager, IdTCPConnection, IdTCPClient,
  sEdit, sMemo, sGroupBox, ComCtrls ; //komponen yang harus di tamahkan pada uses IdSocketHandle

type
  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    sSkinManager1: TsSkinManager;
    sGroupBox1: TsGroupBox;
    memo: TsMemo;
    pesann: TsEdit;
    kirim: TsButton;
    sButton1: TsButton;
    status: TsLabel;
    portt: TsEdit;
    hostt: TsEdit;
    StatusBar1: TStatusBar;
    sButton2: TsButton;
    procedure FormCreate(Sender: TObject);
    procedure IdTCPServer1Connect(AThread: TIdPeerThread);
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure FormCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
    procedure kirimClick(Sender: TObject);
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//from create
procedure TForm1.FormCreate(Sender: TObject);
begin
end;




        //tcp server on connect
procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
var
  agus,sutrisno:string;
begin
  memo.Lines.Add('Tersambung ke client ' + hostt.Text);
  memo.Lines.Add(pesann.Text);

  agus:=idtcpserver1.LocalName;
  sutrisno:=idtcpserver1.Version;
with athread.Connection do
begin
      writeln('Selamat Datang di ' + agus);
      writeln('Indy versi ' + sutrisno);
      writeln('------------------------');
      AThread.Connection.WriteLn('Connected serveriki');
end;
end;


//server execute

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  pesan:string;
begin
while athread.Connection.Connected do
begin
      pesan:=athread.Connection.ReadLn();
      athread.Connection.WriteLn('mengirim :' + pesan);
      memo.Lines.Add('Data dari client : ' + pesan)
end;
end;

//from gak bisa di drag
procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
Resize:= false;
end;

procedure TForm1.kirimClick(Sender: TObject);
begin

  memo.Lines.Add(pesann.Text);
  pesann.Text:='';

end;
 // SendToAllClients(EditNick.Text + ' [Server]: ' + EditSay.Text);
  //MemoChat.Lines.Add(EditNick.Text +' [Server]: ' + EditSay.Text);

procedure TForm1.sButton1Click(Sender: TObject);
var
bindings : TIdsockethandles ;
begin

StatusBar1.Panels[0].Text := 'Port = '+portt.text;
//statusbar1.Panels[0].Text:=’ Port : ‘ + edit1.Text;
status.Caption:='server connected';
bindings := TIDSockethandles.Create (IDTCPServer1) ;
try
with bindings.Add do
begin
IP  :=hostt.Text;
Port:=StrToInt(portt.Text);
end;
try
idTCPserver1.Bindings:=bindings;
idTCPserver1.Active:=true;
except on E:Exception do
showmessage (E.Message);
end;
finally
bindings.Free;
end;
end;

procedure TForm1.sButton2Click(Sender: TObject);
begin
status.Caption:='disconnect';
idTCPserver1.Active:=false;
end;

end.

source code untuk client DOWNLOAD

unit client;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  StdCtrls, sButton, sMemo, sEdit, sGroupBox, sSkinManager, sSkinProvider;

type
  TForm1 = class(TForm)
    IdTCPClient1: TIdTCPClient;
    sGroupBox1: TsGroupBox;
    hostt: TsEdit;
    pesann: TsEdit;
    sGroupBox2: TsGroupBox;
    memo: TsMemo;
    sSkinManager1: TsSkinManager;
    Label1: TLabel;
    Label2: TLabel;
    sButton1: TsButton;
    sButton2: TsButton;
    close: TsButton;
    sSkinProvider1: TsSkinProvider;
    portt: TsEdit;
    diskonek: TsButton;
    procedure sButton1Click(Sender: TObject);
    procedure IdTCPClient1Connected(Sender: TObject);
    procedure closeClick(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.sButton1Click(Sender: TObject);
begin
with
 IdTCPClient1 do
begin

IdTCPClient1.Host := hostt.text; //Ganti sesuai kebutuhan
IdTCPClient1.Port := strToInt(portt.text); //Ganti sesuai kebutuhan
idTCPClient1.Connect;
idTCPClient1.WriteLn('connect !');

    end;
end;

procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
  memo.Lines.Add('Tersambung ke server ' + hostt.Text);
  memo.Lines.Add(pesann.Text);
end;

procedure TForm1.closeClick(Sender: TObject);
begin
if IdTCPClient1.Connected then IdTCPClient1.Disconnect;
end;

procedure TForm1.sButton2Click(Sender: TObject);
begin
  IdTCPClient1.WriteLn(pesann.Text);
  IdTCPClient1.ReadLn(pesann.Text);
  memo.Lines.Add(pesann.Text);
  pesann.Text:='';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if IdTCPClient1.Connected then IdTCPClient1.Disconnect;
end;

end.

// selesai:) kalau ada yang gak bisa atau error komen ya :)

Author : Unknown

Share this

Related Posts