귀하는 손님 이십니다
로그인
회원가입
  
  델마당 공식 은행계좌
  하나은행 227-910235-83607
  예금주 이상국(운영진)
프로젝트 게시판
투표게시판
델마당소개
기초부터 활용까지! 델파이 교육 - 데브기어
 광고문의 :
吏덈Ц怨 떟蹂 吏덈Ц怨 떟蹂 입니다.
글내용 - 吏덈Ц怨 떟蹂
 [吏덈Ц]Indy9濡 TCP 겢씪씠뼵듃쓽 IP 二쇱냼瑜 뼸뒗 諛⑸쾿
떎씠굹紐
(씠슜踰)
2019-02-11 삤썑 11:45:07
176회 조회


첨부파일 다운로드
IdTCPServerDemo.zip
1. 媛쒕컻/떎뻾 뵆옯뤌 
  (1) OS : Win7, Win10
  (2) 媛쒕컻댋 : Delphi5, Indy 9
  (3) 궗슜 Database : 

2. 媛쒕컻 以묒씤 봽濡쒓렇옩 : 쓽猷뚭린湲 넻떊

3. 吏덈Ц 궡슜 

쓽猷뚭린湲곗뿉꽌 떊샇瑜 諛쏆븘꽌 泥섎━븯뒗 湲곕뒫씠 븘슂빐꽌 Indy瑜 씠슜븳 TCP 넻떊봽濡쒓렇옩쓣 옉꽦븯怨좎옄 빀땲떎留
湲곗큹媛 遺議깊빐꽌 옄猷뚯떎뿉꽌 諛쏆 뜲紐 봽濡쒓렇옩뿉 쓽議댄빐꽌 떆옉븯怨 엳뒿땲떎.
IdTCPDemo씪뒗 봽濡쒓렇옩씤뜲 씠誘 蹂댁떊遺꾨뱾씠 留롮쓣 벏 빀땲떎.

議곌툑 뼇씠 留롮留 꽌踰 蹂몃Ц쓣 븘옒뿉 삷寃⑤낫븯뒿땲떎.(TXT 뙆씪濡쒕룄 泥⑤빀땲떎)
뿬湲곗뿉꽌 겢씪씠뼵듃뿉꽌 삤뒗 DNS(Host 삉뒗 PC紐)쓣 諛쏆쓣 닔 엳뒗뜲
IP二쇱냼(192.168.0.10쓽 삎깭)瑜 諛쏅뒗 湲곕뒫씠 뾾뒿땲떎.(瑗 븘슂븳 궗빆씠씪꽌)
뿬윭媛吏 떆룄빐 蹂댁븯뒗뜲 꽣뱷씠 븞뤌꽌 遺뱷씠 吏덈Ц쓣 뱶由쎈땲떎.
媛씠뱶瑜 二쇱떆硫 媛먯궗븯寃좎뒿땲떎.

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  110641: ServerFrmMainUnit.pas 
{
{   Rev 1.0    25/10/2004 23:14:14  ANeillans    Version: 9.0.17
{ Verified
}
{-----------------------------------------------------------------------------
 Demo Name: ServerFrmMainUnit
 Author:    Helge Jung (helge@eco-logic-software.de)
 Copyright: Indy Pit Crew
 Purpose:
 History: Improvements supplied by: Enver ALTIN
-----------------------------------------------------------------------------
 Notes:

 Demonstration on how to use TIdTCPServer and TIdTCPClient
 with using Threads and WriteBuffer/ReadBuffer

Verified:
  Indy 9:
    D7: 25th Oct 2004 by Andy Neillans
}

unit ServerFrmMainUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, IdTCPServer, IdThreadMgr, IdThreadMgrDefault, IdBaseComponent,
  IdComponent;

type
  PClient   = ^TClient;
  TClient   = record  // Object holding data of client (see events)
                DNS         : String[20];            { Hostname }
                Connected,                           { Time of connect }
                LastAction  : TDateTime;             { Time of last transaction }
                Thread      : Pointer;               { Pointer to thread }
              end;

  TCommBlock = record   // the Communication Block used in both parts (Server+Client)
                 Command,
                 MyUserName,                 // the sender of the message
                 Msg,                        // the message itself
                 ReceiverName: string[100];  // name of receiver
               end;

  TServerFrmMain = class(TForm)
                     Server: TIdTCPServer;
                     CBServerActive: TCheckBox;
                     Protocol: TMemo;
                     IdThreadMgrDefault1: TIdThreadMgrDefault;

                     procedure CBServerActiveClick(Sender: TObject);
                     procedure ServerConnect(AThread: TIdPeerThread);
                     procedure ServerExecute(AThread: TIdPeerThread);
                     procedure ServerDisconnect(AThread: TIdPeerThread);
                     procedure FormCreate(Sender: TObject);
                     procedure FormClose(Sender: TObject; var Action: TCloseAction);

                    private

                    public
                   end;

var
  ServerFrmMain   : TServerFrmMain;
  Clients         : TThreadList;     // Holds the data of all clients

implementation

//uses GlobalUnit;

{$R *.DFM}

procedure TServerFrmMain.CBServerActiveClick(Sender: TObject);
begin
  Server.Active := CBServerActive.Checked;
end;

procedure TServerFrmMain.ServerConnect(AThread: TIdPeerThread);
var
  NewClient: PClient;

begin
  GetMem(NewClient, SizeOf(TClient));

  NewClient.DNS         := AThread.Connection.LocalName;
  NewClient.Connected   := Now;
  NewClient.LastAction  := NewClient.Connected;
  NewClient.Thread      :=AThread;

  AThread.Data:=TObject(NewClient);

  try
    Clients.LockList.Add(NewClient);
  finally
    Clients.UnlockList;
  end;

  Protocol.Lines.Add(TimeToStr(Time)+' Connection from "'+NewClient.DNS+'"');
end;

procedure TServerFrmMain.ServerExecute(AThread: TIdPeerThread);
var
  ActClient, RecClient: PClient;
  CommBlock, NewCommBlock: TCommBlock;
  RecThread: TIdPeerThread;
  i: Integer;

begin
  if not AThread.Terminated and AThread.Connection.Connected then
  begin
    AThread.Connection.ReadBuffer (CommBlock, SizeOf (CommBlock));
    ActClient := PClient(AThread.Data);
    ActClient.LastAction := Now;  // update the time of last action

    if (CommBlock.Command = 'MESSAGE') or (CommBlock.Command = 'DIALOG') then
    begin  // 'MESSAGE': A message was send - forward or broadcast it
           // 'DIALOG':  A dialog-window shall popup on the recipient's screen
           // it's the same code for both commands...

      if CommBlock.ReceiverName = '' then
      begin  // no recipient given - broadcast
        Protocol.Lines.Add (TimeToStr(Time)+' Broadcasting '+CommBlock.Command+': "'+CommBlock.Msg+'"');
        NewCommBlock := CommBlock;  // nothing to change ;-))

        with Clients.LockList do
        try
          for i := 0 to Count-1 do  // iterate through client-list
  begin
            RecClient := Items[i];           // get client-object
            RecThread := RecClient.Thread;     // get client-thread out of it
            RecThread.Connection.WriteBuffer(NewCommBlock, SizeOf(NewCommBlock), True);  // send the stuff
          end;
        finally
          Clients.UnlockList;
        end;
      end
      else
      begin  // receiver given - search him and send it to him
        NewCommBlock := CommBlock; // again: nothing to change ;-))
        Protocol.Lines.Add(TimeToStr(Time)+' Sending '+CommBlock.Command+' to "'+CommBlock.ReceiverName+'": "'+CommBlock.Msg+'"');
        with Clients.LockList do
        try
          for i := 0 to Count-1 do
          begin
            RecClient:=Items[i];
            if RecClient.DNS=CommBlock.ReceiverName then  // we don't have a login function so we have to use the DNS (Hostname)
            begin
              RecThread:=RecClient.Thread;
              RecThread.Connection.WriteBuffer(NewCommBlock, SizeOf(NewCommBlock), True);
            end;
          end;
        finally
          Clients.UnlockList;
        end;
      end;
    end
    else
    begin  // unknown command given
      Protocol.Lines.Add (TimeToStr(Time)+' Unknown command from "'+CommBlock.MyUserName+'": '+CommBlock.Command);
      NewCommBlock.Command := 'DIALOG';       // the message should popup on the client's screen
      NewCommBlock.MyUserName := '[Server]';  // the server's username
      NewCommBlock.Msg := 'I don''t understand your command: "'+CommBlock.Command+'"';  // the message to show
      NewCommBlock.ReceiverName := '[return-to-sender]'; // unnecessary

      AThread.Connection.WriteBuffer (NewCommBlock, SizeOf (NewCommBlock), true);  // and there it goes...
    end;
  end;
end;

procedure TServerFrmMain.ServerDisconnect(AThread: TIdPeerThread);
var
  ActClient: PClient;

begin
  ActClient := PClient(AThread.Data);
  Protocol.Lines.Add (TimeToStr(Time)+' Disconnect from "'+ActClient^.DNS+'"');
  try
    Clients.LockList.Remove(ActClient);
  finally
    Clients.UnlockList;
  end;
  FreeMem(ActClient);
  AThread.Data := nil;
end;

procedure TServerFrmMain.FormCreate(Sender: TObject);
begin
  Clients := TThreadList.Create;
end;

procedure TServerFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Server.Active := False;
  Clients.Free;
end;

end.