www.pudn.com > 1000y.rar > FSSockM.pas, change:2001-10-09,size:27385b


unit FSSockM; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  ScktComp, WinSock, adeftype, barutil, AnsUnit, AUtil32, StdCtrls, NMUDP; 
 
const 
   SERVEREVENT_NONE       = 0; 
   SERVEREVENT_CONNECT    = 1; 
   SERVEREVENT_DISCONNECT = 2; 
   SERVEREVENT_ACCEPT     = 3; 
 
type 
   TServerEvent = function  (ConID, EventID: integer; var awstr: WString): Boolean of object; 
 
   TConnect = class 
     private 
      FConId : integer; 
      FAllowClose: Boolean; 
      boWriteAllow : Boolean; 
 
      RecieveBuffer: TBufferClass; 
      SendBuffer : TBufferClass; 
      WouldBlock : array [0..8192] of byte; 
      WouldBlockSize: integer; 
      cwsocket : TCustomWinSocket; 
     public 
      constructor Create; 
      destructor Destroy; override; 
      procedure  Initial (aSocket: TCustomWinSocket); 
      procedure  Final; 
 
      function   SendData (cnt: integer; pb: pbyte): integer; 
      procedure  RecieveProcess (aSocket: TCustomWinSocket); 
      procedure  SendProcess; 
 
      property   ConID : integer read FConId; 
      property   AllowClose: Boolean read FAllowClose write FAllowClose; 
   end; 
 
   TEventData = record 
      ConId : integer; 
      EventID : integer; 
      bytearr: array [0..64-1] of byte; 
   end; 
   PTEventData = ^TEventData; 
 
   TErrorData = record 
      bytearr: array [0..128-1] of byte; 
   end; 
   PTErrorData = ^TErrorData; 
 
   TUdpData = record 
      ipaddr: array [0..32] of char; 
      bytearr: array [0..256-1] of char; 
   end; 
   PTUdpData = ^TUdpData; 
 
   TFrmSocketM = class(TForm) 
      ServerSocket: TServerSocket; 
      ListBox1: TListBox; 
      BtnSave: TButton; 
      BtnClear: TButton; 
      LbCount: TLabel; 
      procedure FormCreate(Sender: TObject); 
      procedure ServerSocketAccept(Sender: TObject; Socket: TCustomWinSocket); 
      procedure ServerSocketClientDisconnect(Sender: TObject; Socket: TCustomWinSocket); 
      procedure ServerSocketClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); 
      procedure ServerSocketClientRead(Sender: TObject; Socket: TCustomWinSocket); 
      procedure ServerSocketClientWrite(Sender: TObject; Socket: TCustomWinSocket); 
      procedure FormDestroy(Sender: TObject); 
      procedure BtnSaveClick(Sender: TObject); 
      procedure BtnClearClick(Sender: TObject); 
   private 
      DataList : TAnsList; 
      FServerEvent : TServerEvent; 
 
      UdpComList : TComDataList; 
      ErrorList : TComDataList; 
      EventList : TBigComDataList; 
      ConIdIndex : TAnsIndexClass; 
      ConIdArr : array [0..100000-1] of integer; 
 
      NMUDP0: TNMUDP; 
 
      procedure AddEvent (Conid, EventId: integer; var awstr: WString); 
      procedure AddError (str: string); 
      function  ListAllocFunction: pointer; 
      procedure ListFreeFunction (item: pointer); 
      procedure NMUDP0DataReceived(Sender: TComponent; NumberBytes: Integer; FromIP: String; Port : Integer); 
      { Private declarations } 
   public 
      procedure  Update1 (CurTick: integer); 
      procedure  ProcessUdp (apu: PTUdpData); 
      procedure  AddListBox (str: string); 
      function   RecieveData (aConid, cnt: integer; pb: pbyte): integer; 
      function   ViewData (aConid, cnt: integer; pb: pbyte): integer; 
      function   GetDataSize (aConid: integer): integer; 
      function   SendData (aConid, cnt: integer; pb: pbyte): integer; 
      function   CloseConnect (aConId: integer): Boolean; 
      function   GetIpAddress (aConid: integer; pb: pbyte): Boolean; 
      function   AllowSend (aConId: integer): Boolean; 
      function   IsConId (aConId: integer): Boolean; 
      property   OnServerEvent : TServerEvent read FServerEvent write FServerEvent; 
      { Public declarations } 
   end; 
 
   procedure DllSSocketSetVisible (aVisible: Boolean); 
   function  DllSSocketGetConnections: integer; 
   function  DllSSocketUpDate (CurTick: integer): Boolean; 
   function  DllSSocketSetPort (aPort: integer): Boolean; 
   procedure DllSSocketSetActive (aActive: Boolean); 
   procedure DllSSocketSetAllowConnect (aAllowConnect: Boolean); 
   procedure DllSSocketSetOnEvent (aServerEvent: TServerEvent); 
 
   function  DllSSocketIsConId (ConId: integer): Boolean; 
   function  DllSSocketRecieveData (ConId, cnt: integer; pb: pbyte): integer; 
   function  DllSSocketViewData (ConId, cnt: integer; pb: pbyte): integer; 
   function  DllSSocketGetDataSize (ConId: integer): integer; 
   function  DllSSocketAllowSend (ConId: integer): Boolean; 
   function  DllSSocketSendData (ConId, cnt: integer; pb: pbyte): integer; 
   function  DllSSocketCloseConnect (ConId: integer): Boolean; 
   function  DllSSocketGetIpAddress (ConId: integer; pb: pbyte): Boolean; 
 
   procedure DllSSocketSetMaxUnUsedCount (aCount: Integer); 
 
   procedure DllSUdpSetting (aPort: Integer); 
 
{ 
   function  DllUdpAlloc (aPort: integer): integer; 
   procedure DllUdpFree (aHandle: integer); 
   procedure DllUdpAddIp (aHandle: integer; var awip: wstring); 
 
   procedure DllUdpSendData (var wip: wstring; aPort: integer; cnt: integer; pb: pbyte); 
   function  DllUdpGetData (aHandle: integer; var awip: wstring; var code: TComData): Boolean; 
} 
var 
  FrmSocketM: TFrmSocketM; 
 
implementation 
 
{$R *.DFM} 
 
var 
   boAllowConnect : Boolean = TRUE; 
   ProcessCount: integer = 35; 
   CurProcess: integer = 0; 
   WouldBlockCount: integer = 0; 
   ServerSayString : string = ''; 
 
   NMUdpForSend : TNMUDP = nil; 
 
   boFormStarted : Boolean = FALSE; 
 
procedure DllUdpSendData (var wip: wstring; aPort: integer; cnt: integer; pb: pbyte); 
var 
   psd: PTComData; 
   buffer : array[0..WSTRINGSIZE-1] of char; 
begin 
   if NMUdpForSend = nil then exit; 
   psd := @Buffer; 
 
   psd^.cnt := cnt; 
   move (pb^, psd^.data, cnt); 
 
   NMUdpForSend.ReportLevel := Status_Basic; 
   NMUdpForSend.RemoteHost := GetWSString (wip); 
   NMUdpForSend.RemotePort := aPort; 
   try 
      NMUdpForSend.SendBuffer(buffer, cnt+4); 
   except 
      FrmSocketM.AddError ('Udp Send Except'); 
   end; 
end; 
 
function  DllSSocketGetIpAddress (ConId: integer; pb: pbyte): Boolean; 
begin 
   Result := FrmSocketM.GetIpAddress (Conid, pb); 
end; 
 
procedure DllSSocketSetVisible (aVisible: Boolean); 
begin 
   FrmSocketM.Visible := aVisible; 
end; 
 
function  DllSSocketGetConnections: integer; 
begin 
   Result := FrmSocketM.ServerSocket.Socket.ActiveConnections; 
end; 
 
function  DllSSocketIsConId (ConId: integer): Boolean; 
begin 
   Result := FrmSocketM.IsConId (Conid); 
end; 
 
function  DllSSocketRecieveData (ConId, cnt: integer; pb: pbyte): integer; 
begin 
   Result := FrmSocketM.RecieveData (Conid, cnt, pb); 
end; 
 
function  DllSSocketViewData (ConId, cnt: integer; pb: pbyte): integer; 
begin 
   Result := FrmSocketM.ViewData (Conid, cnt, pb); 
end; 
 
function  DllSSocketGetDataSize (ConId: integer): integer; 
begin 
   Result := FrmSocketM.GetDataSize (Conid); 
end; 
 
function  DllSSocketAllowSend (ConId: integer): Boolean; 
begin 
   Result := FrmSocketM.AllowSend (Conid); 
end; 
 
function  DllSSocketSendData (ConId, cnt: integer; pb: pbyte): integer; 
begin 
   Result := FrmSocketM.SendData (Conid, cnt, pb); 
end; 
 
function  DllSSocketCloseConnect (ConId: integer): Boolean; 
begin 
   Result := FrmSocketM.CloseConnect (Conid); 
end; 
 
function  DllSSocketUpDate (CurTick: integer): Boolean; 
begin 
   if boFormStarted then FrmSocketM.Update1 (CurTick); 
   Result := TRUE; 
end; 
 
var 
   StartMaxUnUsedCount : integer = -1; 
    
   StartPort : integer = -1; 
   StartboActive : Boolean = FALSE; 
   StartServerEvent : TServerEvent = nil; 
 
   StartUdpPort : integer = 0; 
 
procedure DllSSocketSetMaxUnUsedCount (aCount: Integer); 
begin 
   if boFormStarted then begin 
      FrmSocketM.DataList.MaxUnUsedCount := aCount; 
   end else begin 
      StartMaxUnUsedCount := aCount; 
   end; 
end; 
 
procedure DllSUdpSetting (aPort: Integer); 
begin 
   StartUdpPort := aPort; 
end; 
 
function  DllSSocketSetPort (aPort: integer): Boolean; 
begin 
   if boFormStarted then begin 
      Result := FALSE; 
      if FrmSocketM.ServerSocket.Active then exit; 
      FrmSocketM.ServerSocket.Port := aPort; 
      Result := TRUE; 
   end else begin 
      Result := FALSE; 
      if StartboActive then exit; 
      StartPort := aPort; 
      Result := TRUE; 
   end; 
end; 
 
procedure DllSSocketSetOnEvent (aServerEvent: TServerEvent); 
begin 
   if boFormStarted then begin 
      FrmSocketM.OnServerEvent := aServerEvent; 
   end else begin 
      StartServerEvent := aServerEvent; 
   end; 
end; 
 
procedure DllSSocketSetActive (aActive: Boolean); 
begin 
   if boFormStarted then begin 
      FrmSocketM.ServerSocket.Active := aActive; 
   end else begin 
      StartboActive := aActive; 
   end; 
end; 
 
procedure DllSSocketSetAllowConnect (aAllowConnect: Boolean); 
begin 
   boAllowConnect := aAllowConnect; 
end; 
 
////////////////////////////////// 
//          Connet 
////////////////////////////////// 
 
constructor TConnect.Create; 
begin 
   boWriteAllow := FALSE; 
   FConId    := -1; 
 
   RecieveBuffer := TBufferClass.Create; 
   SendBuffer := TBufferClass.Create; 
   WouldBlockSize := 0; 
end; 
 
destructor  TConnect.Destroy; 
begin 
   RecieveBuffer.Free; 
   SendBuffer.Free; 
   inherited destroy; 
end; 
 
procedure  TConnect.Initial (aSocket: TCustomWinSocket); 
begin 
   FAllowClose := FALSE; 
   FConId    := aSocket.SocketHandle; 
 
   boWriteAllow := FALSE; 
   cwSocket := aSocket; 
 
   RecieveBuffer.Clear; 
   SendBuffer.Clear; 
   WouldBlockSize := 0; 
end; 
 
procedure  TConnect.Final; 
begin 
   boWriteAllow := FALSE; 
   FConId := -1; 
 
   RecieveBuffer.Clear; 
   SendBuffer.Clear; 
   WouldBlockSize := 0; 
end; 
 
procedure   TConnect.RecieveProcess (aSocket: TCustomWinSocket); 
var 
   cnt : integer; 
   buffer : array [0..8192] of byte; 
begin 
   try 
      cnt := cwSocket.ReceiveLength; 
      if cnt > 8192 then cnt := 8192; 
      cnt := cwSocket.ReceiveBuf (Buffer, cnt); 
      if cnt <> SOCKET_ERROR then begin 
         Buffer[cnt] := 0; 
         RecieveBuffer.Add (cnt, @Buffer); 
      end else begin 
         FrmSocketM.AddError ('Recieve error'); 
      end; 
   except 
      FrmSocketM.AddError ('cwSocket.Recieve Except'); 
   end; 
end; 
 
function    TConnect.SendData (cnt: integer; pb: pbyte): integer; 
begin 
   if SendBuffer.Add (cnt, pb) then Result := cnt 
   else Result := 0; 
end; 
 
procedure   TConnect.SendProcess; 
   function GetSendData (pb: pbyte): integer; 
   begin 
      if Wouldblocksize <> 0 then begin 
         Result := WouldBlockSize; 
         move (Wouldblock, pb^, WouldBlockSize); 
         WouldBlocksize :=0; 
      end else begin 
         Result := SendBuffer.Count; 
         if Result = 0 then exit; 
         if Result > 8192 then Result := 8192; 
         Result := SendBuffer.Get (Result, pb); 
      end; 
   end; 
var 
   buf : array [0..8192] of byte; 
   n, ret : integer; 
begin 
   if boWriteAllow = FALSE then exit; 
   if AllowClose then exit; 
 
   n := GetSendData (@buf); 
   if n = 0 then exit; 
 
   ret := cwSocket.SendBuf (buf, n); 
   if ret <> n then begin 
      Wouldblocksize := n; 
      move (buf, WouldBlock, n); 
      boWriteAllow := FALSE; 
      FrmSocketM.AddError ('WouldBlock'); 
   end; 
end; 
 
/////////////////////// 
// 
/////////////////////// 
 
function  TFrmSocketM.ListAllocFunction: pointer; 
begin 
   Result := TConnect.Create; 
end; 
 
procedure TFrmSocketM.ListFreeFunction (item: pointer); 
begin 
   TConnect(item).Free; 
end; 
 
procedure TFrmSocketM.FormCreate(Sender: TObject); 
begin 
   ConIdIndex := TAnsIndexClass.Create ('Conid', 4, FALSE); 
   FillChar (ConIdArr, sizeof(ConIdArr), 0); 
 
   UdpComList := TComDataList.Create; 
   ErrorList := TComDataList.Create; 
   EventList := TBigComDataList.Create; 
   DataList := TAnsList.Create (5, ListAllocFunction, ListFreeFunction); 
 
   boFormStarted := TRUE; 
 
   if StartPort <> -1 then ServerSocket.Port := StartPort; 
   if assigned (StartServerEvent) then OnServerEvent := StartServerEvent; 
   if StartboActive then ServerSocket.Active := TRUE; 
 
   if StartMaxUnUsedCount <> -1 then DataList.MaxUnUsedCount := StartMaxUnUsedCount; 
 
   if StartUdpPort <> 0 then begin 
      NMUDP0 := TNMUDP.Create (Self); 
      NMUDP0.LocalPort := StartUdpPort; 
      NMUDP0.RemotePort := StartUdpPort; 
      NMUDP0.OnDataReceived := NMUDP0DataReceived; 
   end else NMUDP0 := nil; 
end; 
 
procedure TFrmSocketM.FormDestroy(Sender: TObject); 
begin 
   if NMUDP0 <> nil then NMUDP0.Free; 
 
   if ServerSocket.Active then ServerSocket.Active := FALSE; 
   boFormStarted := FALSE; 
 
   DataList.Free; 
   EventList.Free; 
   ErrorList.Free; 
   UdpComList.Free; 
   ConIdIndex.Free; 
end; 
 
procedure TFrmSocketM.ServerSocketAccept(Sender: TObject; Socket: TCustomWinSocket); 
var 
   n : integer; 
   wstr: WString; 
   bo : Boolean; 
   Connect: TConnect; 
begin 
   if boAllowConnect = FALSE then begin Socket.Close; exit; end; 
 
   if (Socket.SocketHandle > 0) and (Socket.SocketHandle < 100000) then n := ConIdArr[Socket.SocketHandle] 
   else n := ConIdIndex.Select (IntToStr(Socket.SocketHandle)); 
   if (n <> 0) and (n <> -1) then begin AddError ('Aready Handle:'+IntToStr(Socket.SocketHandle)); Socket.Close; exit;  end; 
 
   SetWSString (wstr, Socket.RemoteAddress); 
 
   bo := TRUE; 
   if Assigned (FServerEvent) then bo := FServerEvent (Socket.SocketHandle, SERVEREVENT_ACCEPT, wstr); 
   if bo = FALSE then begin Socket.Close; exit; end;        // 접속거부.. 
 
   Connect := DataList.GetUnUsedPointer; 
   Connect.Initial (Socket); 
   DataList.Add (Connect); 
 
   if (Socket.SocketHandle > 0) and (Socket.SocketHandle < 100000) then ConidArr[Socket.SocketHandle] := Integer (Connect) 
   else ConIdIndex.Insert (Integer(Connect), IntToStr(Socket.SocketHandle)); 
 
   AddEvent (Connect.ConId, SERVEREVENT_CONNECT, wstr); 
end; 
 
procedure TFrmSocketM.ServerSocketClientDisconnect(Sender: TObject; Socket: TCustomWinSocket); 
var 
   n: integer; 
   wstr: WString; 
begin 
   if (Socket.SocketHandle > 0) and (Socket.SocketHandle < 100000) then n := ConIdArr[Socket.SocketHandle] 
   else n := ConIdIndex.Select (IntToStr(Socket.SocketHandle)); 
   if (n = 0) or (n = -1) then begin AddError ('NotFound Handle: disconnect:'+IntToStr(Socket.SocketHandle)); exit; end; 
   TConnect(n).AllowClose := TRUE; 
   SetWSString (wstr, Socket.RemoteAddress); 
   AddEvent (TConnect(n).ConId, SERVEREVENT_DISCONNECT, wstr); 
end; 
 
procedure TFrmSocketM.ServerSocketClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); 
begin 
   ErrorCode := 0; 
   Socket.Close; 
end; 
 
procedure TFrmSocketM.ServerSocketClientRead(Sender: TObject; Socket: TCustomWinSocket); 
var n: integer; 
begin 
   if (Socket.SocketHandle > 0) and (Socket.SocketHandle < 100000) then n := ConIdArr[Socket.SocketHandle] 
   else n := ConIdIndex.Select (IntToStr(Socket.SocketHandle)); 
   if (n = 0) or (n = -1) then begin AddError ('NotFound Handle: Read:'+IntToStr(Socket.SocketHandle)); exit; end; 
   TConnect(n).RecieveProcess (Socket); 
end; 
 
procedure TFrmSocketM.ServerSocketClientWrite(Sender: TObject; Socket: TCustomWinSocket); 
var n: integer; 
begin 
   if (Socket.SocketHandle > 0) and (Socket.SocketHandle < 100000) then n := ConIdArr[Socket.SocketHandle] 
   else n := ConIdIndex.Select (IntToStr(Socket.SocketHandle)); 
   if (n = 0) or (n = -1) then begin AddError ('NotFound Handle:Write:'+IntToStr(Socket.SocketHandle)); exit; end; 
   TConnect(n).boWriteAllow := TRUE; 
end; 
 
function   TFrmSocketM.RecieveData (aConid, cnt: integer; pb: pbyte): integer; 
var n: integer; 
begin 
   Result := 0; 
   if (aConid > 0) and (aConid < 100000) then n := ConIdArr[aConId] 
   else n := ConIdIndex.Select (IntToStr(aConId)); 
   if (n = 0) or (n = -1) then begin AddError ('NotFound Conid: RecieveData:'+IntToStr(aConid)); exit; end; 
   Result := TConnect(n).RecieveBuffer.Get (cnt, pb); 
end; 
 
function   TFrmSocketM.ViewData (aConid, cnt: integer; pb: pbyte): integer; 
var n: integer; 
begin 
   Result := 0; 
   if (aConid > 0) and (aConid < 100000) then n := ConIdArr[aConId] 
   else n := ConIdIndex.Select (IntToStr(aConId)); 
   if (n = 0) or (n = -1) then begin AddError ('NotFound Conid: ViewData:'+IntToStr(aConid)); exit; end; 
   Result := TConnect(n).RecieveBuffer.View (cnt, pb); 
end; 
 
function   TFrmSocketM.GetDataSize (aConid: integer): integer; 
var n: integer; 
begin 
   Result := 0; 
   if (aConid > 0) and (aConid < 100000) then n := ConIdArr[aConId] 
   else n := ConIdIndex.Select (IntToStr(aConId)); 
   if (n = 0) or (n = -1) then begin AddError ('NotFound Conid: GetDatasize:'+IntToStr(aConid)); exit; end; 
   Result := TConnect(n).RecieveBuffer.Count; 
end; 
 
function   TFrmSocketM.IsConId (aConId: integer): Boolean; 
var n: integer; 
begin 
   Result := FALSE; 
   if (aConid > 0) and (aConid < 100000) then n := ConIdArr[aConId] 
   else n := ConIdIndex.Select (IntToStr(aConId)); 
   if (n = 0) or (n = -1) then begin 
      exit; 
   end; 
   Result := TRUE; 
end; 
 
function   TFrmSocketM.AllowSend (aConId: integer): Boolean; 
var n: integer; 
begin 
   Result := FALSE; 
   if (aConid > 0) and (aConid < 100000) then n := ConIdArr[aConId] 
   else n := ConIdIndex.Select (IntToStr(aConId)); 
   if (n = 0) or (n = -1) then begin AddError ('NotFound Conid: AllowSend:'+IntToStr(aConid)); exit; end; 
   Result := TConnect(n).boWriteAllow; 
end; 
 
function   TFrmSocketM.SendData (aConid, cnt: integer; pb: pbyte): integer; 
var n: integer; 
begin 
   Result := 0; 
   if (aConid > 0) and (aConid < 100000) then n := ConIdArr[aConId] 
   else n := ConIdIndex.Select (IntToStr(aConId)); 
   if (n = 0) or (n = -1) then begin AddError ('NotFound Conid: SendData:'+IntToStr(aConid)); exit; end; 
   Result := TConnect(n).SendData (cnt, pb); 
end; 
 
function   TFrmSocketM.GetIpAddress (aConid: integer; pb: pbyte): Boolean; 
var 
   n: integer; 
begin 
   pb^ := 0; 
   Result := FALSE; 
   if (aConid > 0) and (aConid < 100000) then n := ConIdArr[aConId] 
   else n := ConIdIndex.Select (IntToStr(aConId)); 
   if (n = 0) or (n = -1) then begin AddError ('NotFound Conid: GetIpAddress:'+IntToStr(aConid)); exit; end; 
   if TConnect(n).AllowClose then exit; 
   if TConnect(n).cwSocket <> nil then begin 
      StrPCopy (pchar (pb), TConnect(n).cwSocket.RemoteAddress); 
      Result := TRUE 
   end; 
end; 
 
function   TFrmSocketM.CloseConnect (aConId: integer): Boolean; 
var 
   n: integer; 
begin 
   Result := FALSE; 
   if (aConid > 0) and (aConid < 100000) then n := ConIdArr[aConId] 
   else n := ConIdIndex.Select (IntToStr(aConId)); 
   if (n = 0) or (n = -1) then begin 
      AddError ('NotFound Conid: CloseConnect:' + IntToStr(aconid)); 
      exit; 
   end; 
   if not TConnect(n).AllowClose then TConnect(n).cwSocket.Close; 
   Result := TRUE 
end; 
 
procedure TFrmSocketM.AddEvent (Conid, EventId: integer; var awstr: WString); 
var ed : TEventData; 
begin 
   ed.ConId := Conid; 
   ed.EventID := EventId; 
   GetWSpChar (awstr, @ed.bytearr); 
   EventList.AddComData (sizeof(ed), @ed); 
end; 
 
procedure  TFrmSocketM.AddError (str: string); 
var er : TErrorData; 
begin 
   StrPCopy (@er.bytearr, str); 
   ErrorList.AddComData (sizeof(er), @er); 
end; 
 
procedure  TFrmSocketM.AddListBox (str: string); 
begin 
   if Listbox1.Items.Count >= 10000 then ListBox1.items.delete (0); 
   if str = 'WouldBlock' then inc (WouldBlockCount) 
   else ListBox1.items.Add (str); 
   listbox1.ItemIndex := listbox1.items.count -1; 
 
   FrmSocketM.LbCount.Caption := 'WouldBlock : ' + inttostr (WouldBlockCount);    // 전송 실패 
end; 
 
procedure TFrmSocketM.BtnSaveClick(Sender: TObject); 
begin 
   ListBox1.Items.SaveToFile ('DllError.txt'); 
end; 
 
procedure TFrmSocketM.BtnClearClick(Sender: TObject); 
var 
   str: string; 
begin 
   WouldBlockCount := 0; 
   ListBox1.Items.Clear; 
   str := format ('Clear: %s %s',[DateToStr(Date), TimeToStr(Time)]); 
   AddError (str); 
end; 
 
procedure TFrmSocketM.NMUDP0DataReceived(Sender: TComponent; NumberBytes: Integer; FromIP: String; Port : Integer); 
var 
   n : integer; 
   ud : TUdpData; 
begin 
   StrPCopy (ud.ipaddr, FromIp); 
   byte (ud.ipaddr[Length(FromIp)]) := 0; 
 
   if NumberBytes < 255 then begin 
      NMUDP0.ReadBuffer(ud.bytearr,NumberBytes); 
      byte (ud.bytearr[NumberBytes]) := 0; 
      UdpComList.AddComData (sizeof(ud), @ud); 
   end else begin 
      while TRUE do begin 
         n := 255; 
         if NumberBytes > 255 then begin 
            NMUDP0.ReadBuffer(ud.bytearr,n); 
            NumberBytes := NumberBytes - n; 
         end else begin 
            NMUDP0.ReadBuffer(ud.bytearr,NumberBytes); 
            break; 
         end; 
      end; 
   end; 
end; 
 
procedure  TFrmSocketM.ProcessUdp (apu: PTUdpData); 
var 
   cmdstr: string; 
   Buffer : array [0..256-1] of char; 
begin 
   cmdstr := StrPas (apu^.bytearr); 
 
   if cmdstr = 'GETCONNECTCOUNT' then begin 
      NMUDP0.ReportLevel := Status_Basic; 
      NMUDP0.RemoteHost := StrPas (@apu^.ipaddr); 
      StrPCopy (Buffer, 'CONNECTCOUNT:'+IntToStr(DataList.Count)); 
      try 
         NMUDP0.SendBuffer(Buffer, StrLen (Buffer)); 
      finally 
      end; 
   end; 
 
   if cmdstr = 'GETSERVERSAY' then begin 
      NMUDP0.ReportLevel := Status_Basic; 
      NMUDP0.RemoteHost := StrPas (@apu^.ipaddr);; 
      if Length(ServerSayString) < 200 then StrPCopy (Buffer, 'SERVERSAY:'+ServerSayString) 
      else StrPCopy (Buffer, 'SERVERSAY:'); 
      try 
         NMUDP0.SendBuffer(Buffer, StrLen (Buffer)); 
      finally 
      end; 
   end; 
end; 
 
procedure  TFrmSocketM.Update1 (CurTick: integer); 
var 
   i : integer; 
   sd: TComData; 
   Connect : TConnect; 
   pe : PTEventData; 
   pr : PTErrorData; 
   pu : PTUdpData; 
   wstr: WString; 
begin 
   while TRUE do begin 
      if not UdpComList.GetComData (sd) then break; 
      pu := @sd.data; 
      ProcessUdp (pu); 
   end; 
 
   while TRUE do begin 
      if not EventList.GetComData (sd) then break; 
      pe := @sd.data; 
      if Assigned (FServerEvent) then begin 
         SetWSpChar (wstr, @pe^.bytearr); 
         FServerEvent (pe^.Conid, pe^.EventId, wstr); 
      end; 
   end; 
 
   while TRUE do begin 
      if not ErrorList.GetComData (sd) then break; 
      pr := @sd.data; 
      AddListBox (StrPas (@pr^.bytearr)); 
   end; 
 
 
   for i := 0 to ProcessCount -1 do begin 
      if CurProcess >= DataList.Count then CurProcess := 0; 
      if DataList.Count = 0 then break; 
      Connect := DataList[CurProcess]; 
      if Connect.AllowClose then begin 
         if (Connect.Conid > 0) and (Connect.Conid < 100000) then ConIdArr[Connect.Conid] := 0 
         else ConIdIndex.Delete (IntToStr(Connect.Conid)); 
         Connect.Final; 
         DataList.Delete (CurProcess); 
      end else begin 
         Connect.SendProcess; 
         inc (CurProcess); 
      end; 
   end; 
end; 
 
{ 
const 
   udpmaxsize = 16384; 
type 
   TUdpClassData = record 
      rip : string[32]; 
      rwip : wstring; 
      rReceiveBuffer : TBigBufferClass; 
   end; 
   PTUdpClassData = ^TUdpClassData; 
 
   TUdpClass = class 
     private 
      Udp : TNMUDP; 
      IpList : TList; 
      procedure UDPDataReceived(Sender: TComponent; NumberBytes: Integer; FromIP: String); 
     public 
      constructor Create (aPort: integer); 
      destructor Destroy; override; 
      procedure  AddIp (var awip: wstring); 
      function   GetData (var awip : wstring; var code: TComData): Boolean; 
   end; 
 
var 
   UdpClassList : TList; 
 
////////////////////////////// 
//    UdpClass 
////////////////////////////// 
constructor TUdpClass.Create(aPort: integer); 
begin 
   IpList := TList.Create; 
   Udp := TNMUdp.Create (Application); 
   Udp.LocalPort := aPort; 
   Udp.OnDataReceived := UDPDataReceived; 
end; 
 
destructor TUdpClass.Destroy; 
begin 
//   Udp.Free; 
   IpList.Free; 
   inherited destroy; 
end; 
 
procedure TUdpClass.UDPDataReceived(Sender: TComponent; NumberBytes: Integer; FromIP: String); 
var 
   i : integer; 
   buffer : array [0..udpmaxsize-1] of char; 
begin 
   try 
      if NumberBytes > udpmaxsize-1 then NumberBytes := udpmaxsize-1; 
      Udp.ReadBuffer(buffer,NumberBytes); 
      for i := 0 to IpList.Count -1 do begin 
         if PTUdpClassData (IpList[i])^.rip = FromIp then begin 
            PTUdpClassData (IpList[i])^.rReceiveBuffer.Add (NumberBytes, @Buffer); 
            break; 
         end; 
      end; 
   except 
      FrmSocketM.AddError ('Udp Recieve Except'); 
   end; 
end; 
 
procedure TUdpClass.AddIp (var awip : wstring); 
var ucd : PTUdpClassData; 
begin 
   new (ucd); 
   ucd^.rip := GetWSString (awip); 
   MoveWs (awip, ucd^.rwip); 
   ucd^.rReceiveBuffer := TBigBufferClass.Create; 
   IpList.Add (ucd); 
end; 
 
function  TUdpClass.GetData (var awip : wstring; var code: TComData): Boolean; 
var 
   i, cnt : integer; 
   pu : PTUdpClassData; 
begin 
   Result := FALSE; 
 
   for i := 0 to IpList.Count -1 do begin 
      pu := IpList[i]; 
      if CompareWs (pu^.rwip, awip) = 0 then begin 
         if pu^.rReceiveBuffer.Count < 4 then break; 
         pu^.rReceiveBuffer.View (4, @cnt); 
         if pu^.rReceiveBuffer.Count < cnt + 4 then break; 
         code.cnt := cnt; 
         pu^.rReceiveBuffer.Get (code.cnt + 4, @code); 
         Result := TRUE; 
         exit; 
      end; 
   end; 
end; 
 
////////////////////////////// 
//    Udp procedure 
////////////////////////////// 
function  GetUdpClassByHandle (aHandle: integer): TUdpClass; 
var i: integer; 
begin 
   Result := nil; 
   for i := 0 to UdpClassList.Count -1 do begin 
      if aHandle = Integer (UdpClassList[i]) then begin 
         Result := UdpClassList[i]; 
         exit; 
      end; 
   end; 
end; 
 
procedure DllUdpFree (aHandle: integer); 
var i : integer; 
begin 
   for i := 0 to UdpClassList.Count -1 do begin 
      if aHandle = Integer (UdpClassList[i]) then begin 
         TUdpClass (UdpClassList[i]).free; 
         UdpClassList.Delete (i); 
         exit; 
      end; 
   end; 
end; 
 
function  DllUdpAlloc (aPort: integer): integer; 
var uc: TUdpClass; 
begin 
   uc := TUdpClass.Create (aPort); 
   UdpClassList.Add (uc); 
   Result := Integer (uc); 
end; 
 
procedure DllUdpAddIp (aHandle: integer; var awip: wstring); 
var uc: TUdpClass; 
begin 
   uc := GetUdpClassByHandle (aHandle); 
   if uc = nil then exit; 
   uc.AddIp (awip); 
end; 
 
function  DllUdpGetData (aHandle: integer; var awip: wstring; var code: TComData): Boolean; 
var i: integer; 
begin 
   Result := FALSE; 
   for i := 0 to UdpClassList.Count -1 do begin 
      if aHandle = Integer (UdpClassList[i]) then begin 
         Result := TUdpClass (UdpClassList[i]).GetData (awip, code); 
         exit; 
      end; 
   end; 
end; 
 
procedure UdpListClear; 
var i : integer; 
begin 
   for i := 0 to UdpClassList.Count -1 do TUdpClass (UdpClassList[i]).Free; 
   UdpClassList.Clear; 
end; 
 
initialization 
begin 
   UdpClassList := TList.Create; 
   NMUdpForSend := TNMUDP.Create (Application); 
end; 
 
finalization 
begin 
//   NMUdpForSend.Free; 
//   UdpListClear; 
   UdpClassList.Free; 
end; 
} 
end.