Delphi控件源码

开发平台：
Delphi

SHSocket.pas：源码内容
							{======================================================================}
{       基本的套接字函数库，能满足基本的需求                           }
{        如果需要更具体的需求，就需要自己加代码了                      }
{        }
{        }
{        }
{       本项目完成... }
{======================================================================}
unit SHSocket;
interface
uses
  SysUtils, Windows, Winsock2;
//初始化UDP套接字
function InitUDPSocket(Port: integer = 0): TSocket;
//释放套接字资源
procedure FreeSocket(var Socket: TSocket);
//设置发送和接受缓冲区大小
function SetRecvBufSize(Socket: TSocket; const BufSize: integer): boolean;
function SetSendBufSize(Socket: TSocket; const BufSize: integer): boolean;
//得到发送和接受缓冲区大小
function GetSendBufSize(Socket: TSocket): integer;
function GetRecvBufSize(Socket: TSocket): integer;
function SetBroadCasst(const Socket: TSocket; IsBroadcast: boolean): boolean;
implementation
///////////////////////
function SetBroadCasst(const Socket: TSocket; IsBroadcast: boolean): boolean;
var
  bIsB: Bool;
  iRc: Integer;
begin
  Result:=False;
  bIsB := IsBroadCast;  //重点，否则要出错...
  iRc := setsockopt(
    Socket,
    SOL_SOCKET,
    SO_BROADCAST,
    @bIsB,
    SizeOf(bIsB));
  if iRc<>SOCKET_ERROR then
    Result:=True;
end;
///////////////////////
function SetSendBufSize(Socket: TSocket; const BufSize: integer): boolean;
var
  iRc: integer;
begin
  Result := true;
  iRc := setsockopt(
    Socket,
    SOL_SOCKET,
    SO_SNDBUF,
    @BufSize,
    SizeOf(BufSize));
  if iRc = SOCKET_ERROR then
    Result := false;
end;
///////////////////////
function GetSendBufSize(Socket: TSocket): integer;
var
  iRc, Size: integer;
begin
  Result := -1;
  Size := SizeOf(integer);
  iRc := getsockopt(
    socket,
    SOL_SOCKET,
    SO_SNDBUF,
    @Result,
    Size);
  if iRc = SOCKET_ERROR then
  begin
    Result := -1;
    Exit;
  end;
end;
///////////////////////
function GetRecvBufSize(Socket: TSocket): integer;
var
  IRc, Size: integer;
begin
  Result := -1;
  Size := SizeOf(integer);
  iRc := getsockopt(
    socket,
    SOL_SOCKET,
    SO_RCVBUF,
    @Result,
    Size);
  if iRc = SOCKET_ERROR then
  begin
    Result := -1;
    Exit;
  end;
end;
///////////////////////
function SetRecvBufSize(Socket: TSocket; const BufSize: integer): boolean;
var
  iRc: integer;
begin
  Result := false;
  iRc := setsockopt(
    socket,
    SOL_SOCKET,
    SO_RCVBUF,
    @BufSize,
    SizeOf(BufSize));
  if iRc = SOCKET_ERROR then
  begin
    Exit;
  end;
  Result := true;
end;
///////////////////////
procedure FreeSocket(var Socket: TSocket);
begin
  if Socket <> INVALID_SOCKET then
  begin
    shutdown(Socket, SD_BOTH);
    closesocket(Socket);
    Socket := INVALID_SOCKET;
  end;
end;
///////////////////////
//如果Port=0就是说明是 Client
function InitUDPSocket(Port: integer): TSocket;
var
  AddrIn: TSockAddrIn;
  bReLinten: BOOL;
begin
  Result := WSASocket(AF_INET,
    SOCK_DGRAM,
    0,
    nil,
    0,
    WSA_FLAG_OVERLAPPED);
  if Result = INVALID_SOCKET then
    Exit;
  if Port = 0 then
    Exit;
    
  {
  //设置在TIME_WAIT状态下可以再次在相同的端口上监听
  bReLinten := True;
  if SetSockOpt(
    Result,
    SOL_SOCKET,
    SO_REUSEADDR,
    @bReLinten,
    SizeOf(bReLinten)) <> 0 then
    Exit;
  }
  AddrIn.sin_family := AF_INET;
  AddrIn.sin_port := htons(Port);
  AddrIn.sin_addr.S_addr := INADDR_ANY;
  if bind(Result, @AddrIn, SizeOf(AddrIn)) = SOCKET_ERROR then
  begin
    FreeSocket(Result);
    Raise Exception.Create('Port is Used');
    Exit;
  end;
end;
///////////////////////
procedure InitWsocket;
var
  aWSAData: TWSAData;
begin
  if WSAStartup($202, aWSAData) <> 0 then
  begin
    MessageBox(0, //GetForegroundWindow(),
      '本程序需要WINSOCK2，该机上版本太低，请升级' +
      'WINSOCK到WINSOCK2',
      '错误',
      MB_ICONERROR);
  end;
end;
procedure FreeWsocket;
begin
  if WSACleanup <> 0 then
  begin
    MessageBox(0,
      '清除WS2_32.DLL失败！',
      '错误',
      MB_ICONERROR);
  end;
end;
initialization
  InitWsocket;
finalization
  FreeWsocket;
end.

						