blcksock.pas

delphi写的mib browser 源码,界面友好!

          begin
            c:=char(RecvByte(timeout));
            if FLastError<>0 then break;
            Fbuffer:=c;
          end
        else
          begin
            setlength(Fbuffer,x);
            r:=Winsock.recv(FSocket,pointer(FBuffer)^,x,0);
            SockCheck(r);
            if r=0 then FLastError:=WSAENOTCONN;
            if FLastError<>0 then break;
          end;
      end;
    x:=pos(#10,Fbuffer);
    if x<=0 then x:=length(Fbuffer);
    s:=s+copy(Fbuffer,1,x-1);
    c:=Fbuffer[x];
    delete(Fbuffer,1,x);
    s:=s+c;
  until c = #10;

  if FLastError=0 then
    begin
      s:=AdjustLineBreaks(s);
      x:=pos(#13+#10,s);
      if x>0 then s:=copy(s,1,x-1);
      result:=s;
    end
  else result:='';
  ExceptCheck;
end;

{TBlockSocket.PeekBuffer}
function TBlockSocket.PeekBuffer(buffer:pointer;length:integer):integer;
begin
  result:=winsock.recv(FSocket,buffer^,length,MSG_PEEK);
  sockcheck(result);
  ExceptCheck;
end;

{TBlockSocket.PeekByte}
function TBlockSocket.PeekByte(timeout:integer):byte;
var
  y:integer;
  data:byte;
begin
  data:=0;
  result:=0;
  if CanRead(timeout) then
    begin
      y:=winsock.recv(FSocket,data,1,MSG_PEEK);
      if y=0 then FLastError:=WSAENOTCONN;
      sockcheck(y);
      result:=data;
    end
    else FLastError:=WSAETIMEDOUT;
  ExceptCheck;
end;

{TBlockSocket.SockCheck}
function TBlockSocket.SockCheck(SockResult:integer):integer;
begin
  if SockResult=SOCKET_ERROR then result:=winsock.WSAGetLastError
    else result:=0;
  FLastError:=result;
end;

{TBlockSocket.ExceptCheck}
procedure TBlockSocket.ExceptCheck;
var
  e:ESynapseError;
  s:string;
begin
  if FRaiseExcept and (LastError<>0) then
    begin
      s:=GetErrorDesc(LastError);
      e:=ESynapseError.CreateFmt('TCP/IP socket error %d: %s',[LastError,s]);
      e.ErrorCode:=LastError;
      e.ErrorMessage:=s;
      raise e;
    end;
end;

{TBlockSocket.WaitingData}
function TBlockSocket.WaitingData:integer;
var
  x:integer;
begin
  winsock.ioctlsocket(FSocket,FIONREAD,x);
  result:=x;
end;

{TBlockSocket.SetLinger}
procedure TBlockSocket.SetLinger(enable:boolean;Linger:integer);
var
  li:TLinger;
begin
  li.l_onoff  := ord(enable);
  li.l_linger := Linger div 1000;
  SockCheck(winsock.SetSockOpt(FSocket, SOL_SOCKET, SO_LINGER, @li, SizeOf(li)));
  ExceptCheck;
end;

{TBlockSocket.LocalName}
function TBlockSocket.LocalName:string;
var
  buf: array[0..255] of char;
  Pbuf:pchar;
  RemoteHost : PHostEnt;
begin
  pbuf:=buf;
  result:='';
  winsock.gethostname(pbuf,255);
  if pbuf<>'' then
    begin
      RemoteHost:=Winsock.GetHostByName(pbuf);
      if remoteHost<>nil then result:=pchar(RemoteHost^.h_name);
    end;
  if result='' then result:='127.0.0.1';
end;


{TBlockSocket.GetLocalSinIP}
function TBlockSocket.GetLocalSinIP:string;
begin
  result:=GetSinIP(FLocalSin);
end;

{TBlockSocket.GetRemoteSinIP}
function TBlockSocket.GetRemoteSinIP:string;
begin
  result:=GetSinIP(FRemoteSin);
end;

{TBlockSocket.GetLocalSinPort}
function TBlockSocket.GetLocalSinPort:integer;
begin
  result:=GetSinPort(FLocalSin);
end;

{TBlockSocket.GetRemoteSinPort}
function TBlockSocket.GetRemoteSinPort:integer;
begin
  result:=GetSinPort(FRemoteSin);
end;

{TBlockSocket.CanRead}
function TBlockSocket.CanRead(Timeout:integer):boolean;
var
  FDSet:TFDSet;
  TimeVal:PTimeVal;
  TimeV:tTimeval;
  x:integer;
begin
  Timev.tv_usec:=(Timeout mod 1000)*1000;
  Timev.tv_sec:=Timeout div 1000;
  TimeVal:=@TimeV;
  if timeout = -1 then Timeval:=nil;
  Winsock.FD_Zero(FDSet);
  Winsock.FD_Set(FSocket,FDSet);
  x:=winsock.Select(0,@FDSet,nil,nil,TimeVal);
  SockCheck(x);
  If FLastError<>0 then x:=0;
  result:=x>0;
  ExceptCheck;
end;

{TBlockSocket.CanWrite}
function TBlockSocket.CanWrite(Timeout:integer):boolean;
var
  FDSet:TFDSet;
  TimeVal:PTimeVal;
  TimeV:tTimeval;
  x:integer;
begin
  Timev.tv_usec:=(Timeout mod 1000)*1000;
  Timev.tv_sec:=Timeout div 1000;
  TimeVal:=@TimeV;
  if timeout = -1 then Timeval:=nil;
  Winsock.FD_Zero(FDSet);
  Winsock.FD_Set(FSocket,FDSet);
  x:=winsock.Select(0,nil,@FDSet,nil,TimeVal);
  SockCheck(x);
  If FLastError<>0 then x:=0;
  result:=x>0;
  ExceptCheck;
end;

{TBlockSocket.SendBufferTo}
function TBlockSocket.SendBufferTo(buffer:pointer;length:integer):integer;
var
  len:integer;
begin
  len:=sizeof(FRemoteSin);
  result:=winsock.sendto(FSocket,buffer^,length,0,FRemoteSin,len);
  sockcheck(result);
  ExceptCheck;
end;

{TBlockSocket.RecvBufferFrom}
function TBlockSocket.RecvBufferFrom(buffer:pointer;length:integer):integer;
var
  len:integer;
begin
  len:=sizeof(FRemoteSin);
  result:=winsock.recvfrom(FSocket,buffer^,length,0,FRemoteSin,len);
  sockcheck(result);
  ExceptCheck;
end;

{TBlockSocket.GetSizeRecvBuffer}
function TBlockSocket.GetSizeRecvBuffer:integer;
var
  l:integer;
begin
  l:=SizeOf(result);
  SockCheck(winsock.getSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @result, l));
  if Flasterror<>0
    then result:=1024;
  ExceptCheck;
end;

{TBlockSocket.SetSizeRecvBuffer}
procedure TBlockSocket.SetSizeRecvBuffer(size:integer);
begin
  SockCheck(winsock.SetSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @size, SizeOf(size)));
  ExceptCheck;
end;

{TBlockSocket.GetSizeSendBuffer}
function TBlockSocket.GetSizeSendBuffer:integer;
var
  l:integer;
begin
  l:=SizeOf(result);
  SockCheck(winsock.getSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @result, l));
  if Flasterror<>0
    then result:=1024;
  ExceptCheck;
end;

{TBlockSocket.SetSizeSendBuffer}
procedure TBlockSocket.SetSizeSendBuffer(size:integer);
begin
  SockCheck(winsock.SetSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @size, SizeOf(size)));
  ExceptCheck;
end;


{======================================================================}

{TUDPBlockSocket.CreateSocket}
Procedure TUDPBlockSocket.CreateSocket;
begin
  FSocket:=winsock.socket(PF_INET,SOCK_DGRAM,IPPROTO_UDP);
  FProtocol:=IPPROTO_UDP;
  inherited createSocket;
end;

{TUDPBlockSocket.EnableBroadcast}
function TUDPBlockSocket.EnableBroadcast(Value:Boolean):Boolean;
var
  Opt:integer;
  Res:integer;
begin
  opt:=Ord(Value);
  Res:=winsock.SetSockOpt(FSocket, SOL_SOCKET, SO_BROADCAST, @opt, SizeOf(opt));
  SockCheck(Res);
  Result:=res=0;
  ExceptCheck;
end;


{======================================================================}

{TTCPBlockSocket.CreateSocket}
Procedure TTCPBlockSocket.CreateSocket;
begin
  FSocket:=winsock.socket(PF_INET,SOCK_STREAM,IPPROTO_TCP);
  FProtocol:=IPPROTO_TCP;
  inherited createSocket;
end;

{TTCPBlockSocket.Listen}
procedure TTCPBlockSocket.Listen;
begin
  SockCheck(winsock.listen(FSocket,SOMAXCONN));
  GetSins;
  ExceptCheck;
end;

{TTCPBlockSocket.Accept}
function TTCPBlockSocket.Accept:TSocket;
var
  len:integer;
begin
  len:=sizeof(FRemoteSin);
{$IFDEF VER090}
  result:=winsock.accept(FSocket,TSockAddr(FRemoteSin),len));
{$ELSE}
  result:=winsock.accept(FSocket,@FRemoteSin,@len);
{$ENDIF}
  SockCheck(result);
  ExceptCheck;
end;


{======================================================================}

{GetErrorDesc}
function GetErrorDesc(ErrorCode:integer): string;
begin
  case ErrorCode of
    0                  : Result:= 'OK';
    WSAEINTR           :{10004} Result:= 'Interrupted system call';
    WSAEBADF           :{10009} Result:= 'Bad file number';
    WSAEACCES          :{10013} Result:= 'Permission denied';
    WSAEFAULT          :{10014} Result:= 'Bad address';
    WSAEINVAL          :{10022} Result:= 'Invalid argument';
    WSAEMFILE          :{10024} Result:= 'Too many open files';
    WSAEWOULDBLOCK     :{10035} Result:= 'Operation would block';
    WSAEINPROGRESS     :{10036} Result:= 'Operation now in progress';
    WSAEALREADY        :{10037} Result:= 'Operation already in progress';
    WSAENOTSOCK        :{10038} Result:= 'Socket operation on nonsocket';
    WSAEDESTADDRREQ    :{10039} Result:= 'Destination address required';
    WSAEMSGSIZE        :{10040} Result:= 'Message too long';
    WSAEPROTOTYPE      :{10041} Result:= 'Protocol wrong type for socket';
    WSAENOPROTOOPT     :{10042} Result:= 'Protocol not available';
    WSAEPROTONOSUPPORT :{10043} Result:= 'Protocol not supported';
    WSAESOCKTNOSUPPORT :{10044} Result:= 'Socket not supported';
    WSAEOPNOTSUPP      :{10045} Result:= 'Operation not supported on socket';
    WSAEPFNOSUPPORT    :{10046} Result:= 'Protocol family not supported';
    WSAEAFNOSUPPORT    :{10047} Result:= 'Address family not supported';
    WSAEADDRINUSE      :{10048} Result:= 'Address already in use';
    WSAEADDRNOTAVAIL   :{10049} Result:= 'Can''t assign requested address';
    WSAENETDOWN        :{10050} Result:= 'Network is down';
    WSAENETUNREACH     :{10051} Result:= 'Network is unreachable';
    WSAENETRESET       :{10052} Result:= 'Network dropped connection on reset';
    WSAECONNABORTED    :{10053} Result:= 'Software caused connection abort';
    WSAECONNRESET      :{10054} Result:= 'Connection reset by peer';
    WSAENOBUFS         :{10055} Result:= 'No buffer space available';
    WSAEISCONN         :{10056} Result:= 'Socket is already connected';
    WSAENOTCONN        :{10057} Result:= 'Socket is not connected';
    WSAESHUTDOWN       :{10058} Result:= 'Can''t send after socket shutdown';
    WSAETOOMANYREFS    :{10059} Result:= 'Too many references:can''t splice';
    WSAETIMEDOUT       :{10060} Result:= 'Connection timed out';
    WSAECONNREFUSED    :{10061} Result:= 'Connection refused';
    WSAELOOP           :{10062} Result:= 'Too many levels of symbolic links';
    WSAENAMETOOLONG    :{10063} Result:= 'File name is too long';
    WSAEHOSTDOWN       :{10064} Result:= 'Host is down';
    WSAEHOSTUNREACH    :{10065} Result:= 'No route to host';
    WSAENOTEMPTY       :{10066} Result:= 'Directory is not empty';
    WSAEPROCLIM        :{10067} Result:= 'Too many processes';
    WSAEUSERS          :{10068} Result:= 'Too many users';
    WSAEDQUOT          :{10069} Result:= 'Disk quota exceeded';
    WSAESTALE          :{10070} Result:= 'Stale NFS file handle';
    WSAEREMOTE         :{10071} Result:= 'Too many levels of remote in path';
    WSASYSNOTREADY     :{10091} Result:= 'Network subsystem is unusable';
    WSAVERNOTSUPPORTED :{10092} Result:= 'Winsock DLL cannot support this application';
    WSANOTINITIALISED  :{10093} Result:= 'Winsock not initialized';
    WSAEDISCON         :{10101} Result:= 'WSAEDISCON-10101';
    WSAHOST_NOT_FOUND  :{11001} Result:= 'Host not found';
    WSATRY_AGAIN       :{11002} Result:= 'Non authoritative - host not found';
    WSANO_RECOVERY     :{11003} Result:= 'Non recoverable error';
    WSANO_DATA         :{11004} Result:= 'Valid name, no data record of requested type'
  else
    Result:= 'Not a Winsock error ('+IntToStr(ErrorCode)+')';
  end;
end;

begin
  exit;
  asm
    db 'Synapse TCP/IP library by Lukas Gebauer',0
  end;
end.