www.pudn.com > shijiantongbu.zip > WinsockUtil.pas

unit WinsockUtil; 
 
interface 
 
uses Classes, Dialogs, SysUtils, Winsock; 
 
var 
  WSData: WSAData; 
 
function StrToAddr(const s: string): longword; 
procedure QuickSendUDP(const h: string; const port: integer; 
  var Data; const DataLen: integer); 
procedure GetLocalAddresses(const s: TStrings); 
function HaveLocalAddress: boolean; 
 
type 
  TQuickUDPServerThread = class(TThread) 
  private 
    FListenPort: Word; 
    listener: sockaddr_in; 
    arg: integer; 
    ExceptMsg: string; 
    procedure ShowError; 
  protected 
    Sock: TSocket; 
    Remote: sockaddr_in; 
    Req: array[1..1024] of byte; 
    Req_Len: integer; 
    procedure Execute; override; 
    procedure DoRequest; virtual; abstract; 
  public 
    constructor Create(const Suspended: boolean; const ListenPort: Word); 
  end; 
 
implementation 
 
type 
  PLongWord = ^LongWord; 
 
function StrToAddr(const s: string): longword; 
 
var 
  pHE: PHostEnt; 
 
begin 
  result := inet_addr(pchar(s)); 
  if result = longword(INADDR_NONE) then 
    begin 
      pHE := GetHostByName(pchar(s)); 
      if pHE = nil then 
        result := longword(INADDR_NONE) 
      else 
        result := LongWord(PLongWord(pHE^.h_addr_list^)^); 
    end; 
end; 
 
function HaveLocalAddress: boolean; 
 
var 
  sl: TStringList; 
 
begin 
  sl := TStringList.Create; 
  try 
    GetLocalAddresses(sl); 
    result := (sl.Count <> 0) and ((sl.Count > 1) or (sl[0] <> '127.0.0.1')); 
  finally 
    sl.Free; 
  end; 
end; 
 
procedure GetLocalAddresses(const s: TStrings); 
 
type 
  TaPInAddr = array[0..250] of PInAddr; 
  PaPInAddr = ^TaPInAddr; 
 
var 
  i: integer; 
  HostAddr: PHostEnt; 
  PAdrPtr: PaPInAddr; 
  HostName: string; 
 
begin 
  s.Clear; 
  setlength(HostName,255); 
  GetHostName(pchar(HostName),255); 
  setlength(HostName,strlen(pchar(HostName))); 
  HostAddr := GetHostByName(PChar(HostName)); 
  if HostAddr = nil then 
    exit; 
  PAdrPtr := PAPInAddr(HostAddr^.h_addr_list); 
  i := 0; 
  while PAdrPtr^[i] <> nil do 
  begin 
    s.Add(inet_ntoa(PAdrPtr^[I]^)); 
    Inc(I); 
  end; 
end; 
 
 
procedure QuickSendUDP(const h: string; const port: integer; 
  var Data; const DataLen: integer); 
 
var 
  addr: sockaddr_in; 
  sock: TSocket; 
 
begin 
  addr.sin_family := AF_INET; 
  addr.sin_addr.S_addr := StrToAddr(h); 
  addr.sin_port := htons(port); 
  sock := Socket(AF_INET, SOCK_DGRAM, 0); 
  if sock = INVALID_SOCKET then 
    raise exception.create('Could not create socket'); 
  try 
    if sendto(sock,Data,DataLen,0,addr,sizeof(addr)) = SOCKET_ERROR then 
      raise exception.create('Could not send packet'); 
  finally 
    closesocket(sock); 
  end; 
end; 
 
constructor TQuickUDPServerThread.Create(const Suspended: boolean; const ListenPort: Word); 
begin 
  inherited Create(true); 
  FListenPort := ListenPort; 
  if not Suspended then 
    Resume; 
end; 
 
procedure TQuickUDPServerThread.ShowError; 
begin 
  ShowMessage(ExceptMsg); 
end; 
 
procedure TQuickUDPServerThread.Execute; 
begin 
  try 
    FreeOnTerminate := true; 
    sock := Socket(AF_INET, SOCK_DGRAM, 0); 
    if sock = INVALID_SOCKET then 
      raise exception.create('Could not allocate a socket: Winsock error '+inttostr(WSAGetLastError)); 
    arg := 10000; // 10 seconds 
    if setsockopt(sock,SOL_SOCKET,SO_RCVTIMEO,@arg,sizeof(arg)) = SOCKET_ERROR then 
      raise exception.create('Could set socket timeout: Winsock error '+inttostr(WSAGetLastError)); 
    fillchar(listener,sizeof(listener),0); 
    listener.sin_family := AF_INET; 
    listener.sin_addr.S_addr := INADDR_ANY; 
    listener.sin_port := htons(FListenPort); 
    if bind(sock,listener,sizeof(sockaddr_in)) = SOCKET_ERROR then 
      raise exception.create('Cannot bind to address: Winsock error '+inttostr(WSAGetLastError)); 
    while not Terminated do 
      begin 
        arg := sizeof(sockaddr_in); 
        Req_Len := recvfrom(sock,Req,sizeof(Req),0,remote,arg); 
        if Req_Len <> SOCKET_ERROR then 
          DoRequest; 
      end; 
    closesocket(sock); 
  except 
    on e: Exception do 
      begin 
        ExceptMsg := e.Message; 
        Synchronize(ShowError); 
      end; 
  end; 
end; 
 
initialization 
  WSAStartup($0101,WSData); 
finalization 
  WSACleanup; 
end.