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. |