在多线程中使用UDP

在多线程中使用UDP

来自：painboy, 时间：2004-8-8 11:34:40, ID：2754268

type TUdpThread = class(TThread)  private    FData     : PChar;        //数据区    FBytes    : Integer;      //数据区大小    FFromIP   : string;       //UDP的源地址    FFromPort : Integer;      //UDP的源端口  public    constructor Create(Buffer: PChar; NumberBytes: Integer; FromIP: String; Port: Integer);  protected    procedure Execute; override; end; procedure TForm1.Button1Click(Sender: TObject); var Buffer : array[0..1024] of char; begin  strcopy(buffer,pchar(Edit1.Text));  UdpSend.ReportLevel := Status_Basic;  UdpSend.RemotePort := 4000;  UdpSend.RemoteHost := '127.0.0.1';  UdpSend.Sendbuffer(buffer,256); end; constructor TUdpThread.Create(Buffer: PChar; NumberBytes: Integer; FromIP: String; Port: Integer); begin  inherited Create(True);  FData     := Buffer;  FBytes    := NumberBytes;  FFromIP   := FromIP;  FFromPort := Port;  FreeOnTerminate := True;  Resume; end; procedure TUdpThread.Execute; var Buffer : PChar;    BackTo : array[0..1] of char;    str    : string;    myUDP  : TNMUDP; begin  str := inttostr(GetTickCount)+' : ';  GetMem(Buffer, FBytes+1);  CopyMemory(Buffer, FData, FBytes);  Randomize;                                Sleep(Random(5000));                      Form1.Memo1.Lines.Add(str+Buffer);    //其实以上几句改为你自己的处理代码就是了        FillChar(BackTo, 2, f);  myUDP := TNMUDP.Create(Nil);  myUDP.RemoteHost  := FFromIP;  myUDP.ReportLevel := Status_Basic;  myUDP.LocalPort   := 4000;  myUDP.SendBuffer(BackTo, 2);            //回个响应包给对方  FreeMem(Buffer, FBytes+1);  FreeMem(FData, FBytes); end; procedure TForm1.UdpRecvDataReceived(Sender: TComponent;  NumberBytes: Integer; FromIP: String; Port: Integer); var Buffer : PChar ; begin  GetMem(Buffer, NumberBytes);  UdpRecv.ReadBuffer(Buffer^, NumberBytes);                //接收数据  TUdpThread.Create(Buffer, NumberBytes, FromIP, Port);    //将数据交给子线程处理 end; procedure TForm1.UdpSendDataReceived(Sender: TComponent;  NumberBytes: Integer; FromIP: String; Port: Integer); var Buffer : PChar ; begin  GetMem(Buffer, NumberBytes);  UdpSend.ReadBuffer(Buffer^, NumberBytes);  FreeMem(Buffer, NumberBytes); end;

来自：painboy, 时间：2004-8-8 13:56:05, ID：2754370
SORRY，看错题了。你是说要在线程里收发数据。用API重写了一下，D5下通过了。

type TUdpThread = class(TThread)  private    FSocket : TSocket;  public    constructor Create;  protected    procedure Execute; override;    function CanRead(Socket : TSocket; Timeout: Integer): Boolean; end; constructor TUdpThread.Create; begin  inherited Create(True);  FreeOnTerminate := True;  Resume; end; function TUdpThread.CanRead(Timeout: Integer): Boolean; var  TimeV: TTimeVal;  FDSet: TFDSet;  X    : integer; begin  TimeV.tv_usec := (Timeout mod 1000) * 1000;  TimeV.tv_sec := Timeout div 1000;  FDSet.fd_count := 1;  FDSet.fd_array[0] := FSocket;  X := Select(0, @FDSet, nil, nil, @TimeV);  Result := X>0; end; procedure TUdpThread.Execute; var  wsaD      : WSADATA;  sa        : TSockAddrIn;  nLen,nFrom: Integer;  UdpBuffer : array[0..1023] of Char; begin  WSAStartup(01, wsaD);  FSocket := Socket(AF_INET, SOCK_DGRAM, 0);  if (FSocket <> INVALID_SOCKET) then begin    sa.sin_family:= AF_INET;    sa.sin_port:= htons(4096);    sa.sin_addr.S_addr:= inet_addr('127.0.0.1');    nLen:= SizeOf(sa);    bind(FSocket, sa, nLen);    While not Terminated do      if CanRead(10) then begin                                 //检查是否有数据可接收        FillChar(UdpBuffer, 1024, 0);        nFrom := SizeOf(sa);        RecvFrom(FSocket, UdpBuffer, nLen, 0, sa, nFrom);       //接收数据        Form1.Memo1.Lines.Add(inet_ntoa(sa.sin_addr)+' : '+UdpBuffer);        FillChar(UdpBuffer, 2, f);        nFrom := SizeOf(sa);        SendTo(FSocket, UdpBuffer, 2, 0, sa, nFrom);            //应答      end  else begin        //暂时没有数据来，你可以干点别的事情  ：）      end;    CloseSocket(FSocket);  end;  WSACleanUp; end; ////////////////////////////////////////////////////////////////////////////////////////// //                                                                                      // //        上面的线程是用WINSOCKET API写的，没做差错检查，但你说的功能已经实现           // //                                                                                      // ////////////////////////////////////////////////////////////////////////////////////////// procedure TForm1.Button1Click(Sender: TObject);              //这里 UdpSend是个TNMUDP控件 var Buffer : array[0..1024] of char; begin    strcopy(buffer,'Hello!');    UdpSend.ReportLevel := Status_Basic;    UdpSend.RemotePort := 4096;    UdpSend.RemoteHost := '127.0.0.1';    UdpSend.Sendbuffer(buffer,256); end; procedure TForm1.UdpSendDataReceived(Sender: TComponent;  NumberBytes: Integer; FromIP: String; Port: Integer); var Buffer : PChar ; begin  GetMem(Buffer, NumberBytes);  UdpSend.ReadBuffer(Buffer^, NumberBytes);  FreeMem(Buffer, NumberBytes);  Memo1.Lines.Add(Inttostr(NumberBytes)+ ' Bytes'); end;

来自：乡村月光, 时间：2004-8-8 14:45:58, ID：2754430
我有API的代码，一个转发服务器，一个队列发送器，一个队列接收器，用起来很方便，有人要就贴

来自：乡村月光, 时间：2004-8-9 22:23:59, ID：2756448

unit UDPNet; interface uses Windows, Messages, SysUtils, Variants, Classes, Winsock; // 为了提高效率，本单元所有的地址都使用winsock内部格式，和习惯IP之间用AddrToIP和IPToAdr转换！ const  UDPACKETSIZE = 512; // 最大UDP包大小  UDPXHEADSIZE = 8;   // 数据包头大小  UDPXDATASIZE = UDPACKETSIZE - UDPXHEADSIZE ; // 最大数据包大小  UDPXDATAFLAG = AC5; // 转发数据包头标志  WM_TERMINATE = WM_USER + 100; // 结束线程  WM_SENDDATA  = WM_USER + 101; // 发送数据 type  TSyncSignal = class(TObject) // 线程安全信号  private    FSignal: Boolean;    FCritical: _RTL_CRITICAL_SECTION;    function GetSignal: Boolean;  public    constructor Create(IniState: Boolean);    destructor Destroy; override;    procedure Reset;    property IsSafe: Boolean read GetSignal;  end;  ESocketError = class(Exception);  TSyncUDPSocket = class(TObject) // 封装API  protected    FHandle: TSocket;    FLastError: Integer;    function GetBroadcast: Boolean;    function GetReuseAddr: Boolean;    function GetRecvBufSize: Integer;    function GetSendBufSize: Integer;    procedure SetBroadcast(Value: Boolean);    procedure SetReuseAddr(Value: Boolean);    procedure SetRecvBufSize(Value: Integer);    procedure SetSendBufSize(Value: Integer);  public    constructor Create;    destructor Destroy; override;    function RecvBuffer(var Buffer; Len: Integer): Integer;    function RecvFrom(var Buffer; Len: Integer; var Addr: Integer; var Port: Word): Integer;    function ByteCanRead: Integer;    function SendBuffer(var Buffer; Len: Integer): Integer;    function SendTo(Addr: Integer; Port: Word; var Buffer; Len: Integer): Integer;    function WaitForData(TimeOut: Integer): Boolean;    procedure Bind(Addr: Integer; Port: Word);    procedure Connect(Addr: Integer; Port: Word);    procedure CreateSocket;    procedure GetLocalHost(var IP: string; var Port: Word);    procedure GetRemoteHost(var IP: string; var Port: Word);    property Broadcast: Boolean read GetBroadcast write SetBroadcast;    property Handle: TSocket read FHandle write FHandle;    property LastError: Integer read FLastError;    property ReuseAddr: Boolean read GetReuseAddr write SetReuseAddr;    property SizeRecvBuffer: Integer read GetRecvBufSize write SetRecvBufSize;    property SizeSendBuffer: Integer read GetSendBufSize write SetSendBufSize;  end;  TUDPXDataBuffer = packed record // 转发数据包    Flag: Word;    Port: Word;    Addr: Integer;    Data: array [0..UDPXDATASIZE-1] of Byte;  end;  TUDPXServerThread = class(TThread) // 数据转发服务器  protected    FUDPSock: TSyncUDPSocket;    FUDPort: Word;  public    constructor Create(Port: Word);    destructor Destroy; override;    procedure Execute; override;  end;  TUDPQueData = packed record  // 队列数据    Addr: Integer;    Port: Word;    Len: Word;    Data: array [0..UDPACKETSIZE-1] of Byte;  end;  TUDPQueBuffer = array [0..1] of TUDPQueData;  PUDPQueBuffer = ^TUDPQueBuffer;  TUDPDataQue = record // 队列    Header, Tail, BufSize: Integer;    IsFull: Boolean;    Queue: PUDPQueBuffer;  end;  TUDPReceiver = class;  TUDPDataNotify = procedure(Sender: TUDPReceiver; const Data: TUDPQueData) of object;  TUDPReceiver = class(TThread) // 接收器  protected    FUDPSock: TSyncUDPSocket;    FOnData: TUDPDataNotify;  public    constructor Create(Sock: TSyncUDPSocket);    procedure Execute; override;    property OnData: TUDPDataNotify read FOnData write FOnData;    property UDPSock: TSyncUDPSocket read FUDPSock write FUDPSock;  end;  TUDPQueSender = class(TThread) // 队列发送器，通过消息WM_TERMINATE结束  protected    FUDPSock: TSyncUDPSocket;    FBuffer: TUDPDataQue;    FSync: TSyncSignal;  public    constructor Create(Sock: TSyncUDPSocket; BufSize: Integer);    destructor Destroy; override;    function AddData(Addr: Integer; Port: Word; const Header; HLen: Word;             const Data; DLen: Word): Boolean; // 要发送数据调用本函数    procedure Execute; override;    property Buffer: TUDPDataQue read FBuffer;    property UDPSock: TSyncUDPSocket read FUDPSock write FUDPSock;  end; function AddrToIP(Addr: Integer): string; function IPToAddr(const IP: string): Integer; implementation constructor TSyncSignal.Create(IniState: Boolean); begin  inherited Create;  InitializeCriticalSection(FCritical);  FSignal := IniState; end; destructor TSyncSignal.Destroy; begin  DeleteCriticalSection(FCritical);  inherited Destroy; end; function TSyncSignal.GetSignal: Boolean; begin  EnterCriticalSection(FCritical);  Result := FSignal;  FSignal := False;  LeaveCriticalSection(FCritical); end; procedure TSyncSignal.Reset; begin  FSignal := True; end; constructor TSyncUDPSocket.Create; begin  inherited Create;  FLastError := 0;  FHandle := INVALID_SOCKET; end; destructor TSyncUDPSocket.Destroy; begin  if FHandle <> INVALID_SOCKET then CloseSocket(FHandle);  inherited Destroy; end; function TSyncUDPSocket.GetBroadcast: Boolean; var m, n: Integer; begin  FLastError := 0;  n := Sizeof(Integer);  if GetSockOpt(FHandle, SOL_SOCKET, SO_BROADCAST, @m, n) <> 0 then  begin    FLastError := WSAGetLastError;    Result := False;  end  else Result := m <> 0; end; function TSyncUDPSocket.GetReuseAddr: Boolean; var m, n: Integer; begin  FLastError := 0;  n := Sizeof(Integer);  if GetSockOpt(FHandle, SOL_SOCKET, SO_REUSEADDR, @m, n) <> 0 then  begin    FLastError := WSAGetLastError;    Result := False;  end  else Result := m <> 0; end; function TSyncUDPSocket.GetRecvBufSize: Integer; var n: Integer; begin  n := SizeOf(Result);  FLastError := 0;  if GetSockOpt(FHandle, SOL_SOCKET, SO_RCVBUF, @Result, n) <> 0 then  begin    FLastError := WSAGetLastError;    Result := -1;  end; end; function TSyncUDPSocket.GetSendBufSize: Integer; var n: Integer; begin  n := SizeOf(Result);  FLastError := 0;  if GetSockOpt(FHandle, SOL_SOCKET, SO_SNDBUF, @Result, n) <> 0 then  begin    FLastError := WSAGetLastError;    Result := -1;  end; end; procedure TSyncUDPSocket.SetBroadcast(Value: Boolean); var n: Integer; begin  FLastError := 0;  if Value then n := -1 else n := 0;  if SetSockOpt(FHandle, SOL_SOCKET, SO_BROADCAST, @n, SizeOf(Integer)) <> 0 then    FLastError := WSAGetLastError; end; procedure TSyncUDPSocket.SetReuseAddr(Value: Boolean); var n: Integer; begin  FLastError := 0;  if Value then n := -1 else n := 0;  if SetSockOpt(FHandle, SOL_SOCKET, SO_REUSEADDR, @n, SizeOf(Integer)) <> 0 then    FLastError := WSAGetLastError; end; procedure TSyncUDPSocket.SetRecvBufSize(Value: Integer); begin  FLastError := 0;  if SetSockOpt(FHandle, SOL_SOCKET, SO_RCVBUF, @Value, SizeOf(Integer)) <> 0 then    FLastError := WSAGetLastError; end; procedure TSyncUDPSocket.SetSendBufSize(Value: Integer); begin  FLastError := 0;  if SetSockOpt(FHandle, SOL_SOCKET, SO_SNDBUF, @Value, SizeOf(Integer)) <> 0 then    FLastError := WSAGetLastError; end; function TSyncUDPSocket.ByteCanRead: Integer; var n: Integer; begin  FLastError := 0;  if IoctlSocket(FHandle, FIONREAD, n) = 0 then Result := n  else begin    FLastError := WSAGetLastError;    Result := 0;  end; end; function TSyncUDPSocket.WaitForData(TimeOut: Integer): Boolean; var tv: TTimeVal;    pt: PTimeVal;    n: Integer;    fs: TFDSet; begin  if TimeOut < 0 then pt := nil else  begin    tv.tv_sec := TimeOut div 1000;    tv.tv_usec := (TimeOut mod 1000) * 1000;    pt := @tv;  end;  FD_ZERO(fs);  FD_SET(FHandle, fs);  n := select(0, @fs, nil, nil, pt);  if n = SOCKET_ERROR then  begin    FLastError := WSAGetLastError;    n := 0;  end  else FLastError := 0;  Result := n > 0; end; function TSyncUDPSocket.RecvBuffer(var Buffer; Len: Integer): Integer; begin  FLastError := 0;  Result := WinSock.recv(FHandle, Buffer, Len, 0);  if Result = SOCKET_ERROR then FLastError := WSAGetLastError; end; function TSyncUDPSocket.RecvFrom(var Buffer; Len: Integer; var Addr: Integer; var Port: Word): Integer; var a: TSockAddr;    n: Integer; begin  FLastError := 0;  Result := WinSock.RecvFrom(FHandle, Buffer, Len, 0, a, n);  Port := ntohs(a.sin_port);  Addr := a.sin_addr.s_addr;  if Result = SOCKET_ERROR then FLastError := WSAGetLastError; end; function TSyncUDPSocket.SendBuffer(var Buffer; Len: Integer): Integer; begin  FLastError := 0;  Result := WinSock.send(FHandle, Buffer, Len, 0);  if Result = SOCKET_ERROR then FLastError := WSAGetLastError; end; function TSyncUDPSocket.SendTo(Addr: Integer; Port: Word; var Buffer; Len: Integer): Integer; var a: TSockAddr; begin  FLastError := 0;  a.sin_family := AF_INET;  a.sin_port := htons(Port);  a.sin_addr.s_addr := Addr;  Result := WinSock.SendTo(FHandle, Buffer, Len, 0, a, Sizeof(TSockAddr));  if Result = SOCKET_ERROR then FLastError := WSAGetLastError; end; procedure TSyncUDPSocket.Bind(Addr: Integer; Port: Word); var a: TSockAddr; begin  if FHandle = INVALID_SOCKET then  begin    CreateSocket;    if FLastError <> 0 then Exit;  end;  FLastError := 0;  a.sin_family := AF_INET;  a.sin_port := htons(Port);  a.sin_addr.s_addr := Addr;  if WinSock.Bind(FHandle, a, Sizeof(TSockAddr)) = SOCKET_ERROR then    FLastError := WSAGetLastError; end; procedure TSyncUDPSocket.Connect(Addr: Integer; Port: Word); var a: TSockAddr; begin  if FHandle = INVALID_SOCKET then  begin    CreateSocket;    if FLastError <> 0 then Exit;  end;  FLastError := 0;  a.sin_family := AF_INET;  a.sin_port := htons(Port);  a.sin_addr.s_addr := Addr;  if WinSock.Connect(FHandle, a, Sizeof(TSockAddr)) = SOCKET_ERROR then    FLastError := WSAGetLastError; end; procedure TSyncUDPSocket.CreateSocket; begin  FLastError := 0;  FHandle := Socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP);  if FHandle = INVALID_SOCKET then FLastError := WSAGetLastError; end; procedure TSyncUDPSocket.GetLocalHost(var IP: string; var Port: Word); var addr: TSockAddr;    len: Integer; begin  FillChar(addr, Sizeof(TSockAddr), 0);  len := Sizeof(TSockAddr);  GetSockName(FHandle, addr, len);  IP := inet_ntoa(addr.sin_addr);  Port := ntohs(addr.sin_port); end; procedure TSyncUDPSocket.GetRemoteHost(var IP: string; var Port: Word); var addr: TSockAddr;    len: Integer; begin  FillChar(addr, Sizeof(TSockAddr), 0);  len := Sizeof(TSockAddr);  GetPeerName(FHandle, addr, len);  IP := inet_ntoa(addr.sin_addr);  Port := ntohs(addr.sin_port); end; constructor TUDPXServerThread.Create(Port: Word); begin  inherited Create(True);  FUDPort := Port; end; destructor TUDPXServerThread.Destroy; begin  FUDPSock.Free;  inherited Destroy; end; procedure TUDPXServerThread.Execute; var n, a: Integer;    p: Word;    buf: TUDPXDataBuffer; begin  FUDPSock := TSyncUDPSocket.Create;  FUDPSock.Bind(0, FUDPort);  while not Terminated do  begin    if FUDPSock.WaitForData(100) then    begin      n := FUDPSock.ByteCanRead;      if n > UDPACKETSIZE then n := UDPACKETSIZE;      FUDPSock.RecvFrom(buf, n, a, p);      if (buf.Flag = UDPXDATAFLAG) and (n > UDPXHEADSIZE) then        FUDPSock.SendTo(buf.Addr, buf.Port, buf.Data, n - UDPXHEADSIZE);    end;  end; end; constructor TUDPReceiver.Create(Sock: TSyncUDPSocket); begin  inherited Create(True);  FUDPSock := Sock;  FOnData := nil; end; procedure TUDPReceiver.Execute; var buf: TUDPQueData; begin  while not Terminated do  begin    if FUDPSock.WaitForData(100) then with buf do    begin      Len := FUDPSock.ByteCanRead;      if Len > UDPACKETSIZE then Len := UDPACKETSIZE;      FUDPSock.RecvFrom(Data, Len, Addr, Port);      if (FUDPSock.FLastError = 0) and Assigned(FOnData) then FOnData(Self, buf);    end;  end; end; constructor TUDPQueSender.Create(Sock: TSyncUDPSocket; BufSize: Integer); begin  inherited Create(True);  FUDPSock := Sock;  FBuffer.Header := 0;  FBuffer.Tail := 0;  FBuffer.IsFull := False;  if BufSize < 4 then BufSize := 4;  FBuffer.BufSize := BufSize;  GetMem(FBuffer.Queue, FBuffer.BufSize * Sizeof(TUDPQueData));  FSync := TSyncSignal.Create(True);  FreeOnTerminate := True; end; destructor TUDPQueSender.Destroy; begin  FreeMem(FBuffer.Queue, FBuffer.BufSize * Sizeof(TUDPQueData));  FSync.Free;  inherited Destroy; end; function TUDPQueSender.AddData(Addr: Integer; Port: Word; const Header; HLen: Word;         const Data; DLen: Word): Boolean; var i, n: Integer; begin  while not FSync.IsSafe do Sleep(0);  i := FBuffer.Tail;  Result := not ((i = FBuffer.Header) and FBuffer.IsFull);  if Result and ((HLen > 0) or (DLen > 0)) then  begin    if HLen > UDPACKETSIZE then HLen := UDPACKETSIZE;    n := HLen + DLen;    if n > UDPACKETSIZE then DLen := UDPACKETSIZE - HLen;    FBuffer.Queue.Addr := Addr;    FBuffer.Queue.Port := Port;    FBuffer.Queue.Len := n;    if HLen > 0 then Move(Header, FBuffer.Queue.Data[0], HLen);    if DLen > 0 then Move(Data, FBuffer.Queue.Data[HLen], DLen);    Inc(i);    if i >= FBuffer.BufSize then i := 0;    FBuffer.Tail := i;    FBuffer.IsFull := i = FBuffer.Header;  end;  FSync.Reset;  PostThreadMessage(ThreadID, WM_SENDDATA, 0, 0); end; procedure TUDPQueSender.Execute; var i: Integer;    ms: MSG; begin  while not Terminated do  begin    GetMessage(ms, 0, 0, 0);    case ms.message of      WM_SENDDATA: begin        while (FBuffer.Header <> FBuffer.Tail) or FBuffer.IsFull do        begin          i := FBuffer.Header;          with FBuffer.Queue do          begin            if Len > UDPACKETSIZE then Len := UDPACKETSIZE;            FUDPSock.SendTo(Addr, Port, Data, Len);            Inc(i);            if i >= FBuffer.BufSize then i := 0;            while not FSync.IsSafe do Sleep(0);                        FBuffer.Header := i;            FBuffer.IsFull := False;            FSync.Reset;          end;        end;      end;      WM_TERMINATE: Terminate;    end;  end; end; function AddrToIP(Addr: Integer): string; var a: in_addr absolute Addr; begin  Result := inet_ntoa(a); end; function IPToAddr(const IP: string): Integer; begin  Result := inet_addr(PChar(IP)); end; var  WSAData: TWSAData; procedure Startup; begin  if WSAStartup(01, WSAData) <> 0 then raise ESocketError.Create('WSAStartup'); end; procedure Cleanup; begin  if WSACleanup <> 0 then raise ESocketError.Create('WSACleanup'); end; initialization  Startup; finalization  Cleanup; end.

阅读全文(305) / 评论 / 扔小纸条 / 给kraft留言 / 文件夹: delphi