kraft @ 2005-05-10 21:20
来自: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.