sockfunc.pas

提供串行口存取的 Object Pascal 类 ( 1.2 版

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

function SockGetSockOpt(_SockDesc: tSockDesc; _Level, _OptName: Integer;
                        _OptVal: PChar; var _OptLen: Integer): Longint;
begin
  {$IFDEF WIN32}
    Result := GetSockOpt(_SockDesc, _Level, _OptName, _OptVal, _OptLen);
  {$ENDIF}

  {$IFDEF OS2}
    Result := IBM_GetSockOpt(_SockDesc, _Level, _OptName, _OptVal, _OptLen);
  {$ENDIF}

  {$IFDEF LINUX}
    Result := SetSocketOptions(_SockDesc, _Level, _OptName, _OptVal, _OptLen);
  {$ENDIF}
end; { func. SockGetSockOpt }

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

function SockSetSockOpt(_SockDesc: tSockDesc; _Level: uLong; _OptName: Ulong;
                        _OptVal: pChar; _OptLen: uLong ): Longint;
begin
  {$IFDEF WIN32}
    Result := SetSockOpt(_SockDesc, _Level, _OptName, _OptVal, _OptLen);
  {$ENDIF}

  {$IFDEF OS2}
    Result := IBM_SetSockOpt(_SockDesc, _Level, _OptName, _OptVal, _OptLen);
  {$ENDIF}

  {$IFDEF LINUX}
    Result := SetSocketOptions(_SockDesc, _Level, _OptName, _OptVal, _OptLen);
  {$ENDIF}
end; { func. SockSetSockOpt }

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

function SockDataAvail(_SockDesc: tSockDesc): Boolean;
{$IFDEF LINUX}
  var ReadFDS  : FDSet;
      Temp     : Longint;
{$ENDIF}
begin
   {$IFNDEF LINUX}
     Result := (SockSelect(_SockDesc) > 00);
   {$ELSE}
     fd_Zero(ReadFDS);
     fd_Set(_SockDesc, ReadFDS);

     Temp := Select(_SockDesc + 01, @ReadFDS, nil, nil, 0);
     if (Temp > 0) then
       begin
         SockDataAvail := FD_ISSET(_SockDesc, ReadFDS);
       end { if }
         else SockDataAvail := false;
   {$ENDIF}
(*
  {$IFDEF OS2}
    Arg := 00;
    Result := IBM_IOCTL(_SockDesc, FIONREAD, @Arg, SizeOf(Arg));

    if Arg > 00 then Result := Arg
      else Result := $FFFFFFFF;
  {$ENDIF}

  {$IFDEF WIN32}
    Result := IOCtlSocket(_SockDesc, FIONREAD, Arg);
    if Arg > 00 then Result := Arg
      else Result := $FFFFFFFF;
  {$ENDIF}
*)
end; { func. SockDataAvail }

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

function SockListen(_SockDesc: tSockDesc;
                    _SockQueue:  ULong): Longint;
begin
  {$IFDEF WIN32}
    SockListen := listen(_SockDesc, _SockQueue);
  {$ENDIF}

  {$IFDEF OS2}
    SockListen := ibm_listen(_SockDesc, _SockQueue);
  {$ENDIF}

  {$IFDEF LINUX}
    SockListen := Longint(Listen(_SockDesc, _SockQueue));
  {$ENDIF}
end; { func. SockListen }

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

function SockSelect(_SockDesc: tSockDesc ): Longint;
{$IFDEF OS2}
var SockCopy: ULONG;
{$ENDIF}

{$IFDEF WIN32}
var SockArr : TFDSet;
    Timeout : TTimeVal;
{$ENDIF}

{$IFDEF LINUX}
var ReadFDS  : FDSet;
{$ENDIF}
begin
  {$IFDEF OS2}
    SockCopy := _SockDesc;
    Result := IBM_Select(@SockCopy, 1, 0, 0, 0);
  {$ENDIF}

  {$IFDEF WIN32}
    SockArr.fd_Count := 01;
    SockArr.fd_Array[00] := _SockDesc;
    Timeout.tv_sec := 00;
    Timeout.tv_usec := 00;

    Result := Select(00, @SockArr, NIL, NIL, @Timeout);
  {$ENDIF}

  {$IFDEF LINUX}
    fd_Zero(ReadFDS);
    fd_Set(_SockDesc, ReadFDS);

    SockSelect := Select(_SockDesc + 01, @ReadFDS, nil, nil, 0);
  {$ENDIF}
end; { func. SockSelect }

(*-+-*-+-*-+-*-+-*-+-*-+ -*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

function SockRecv(_SockDesc: tSockDesc;
                  _SockBuffer: pointer;
                  _SockBufLen: ULong;
                  _SockFlags:  ULong): Longint;
var Counter: Longint;
begin
  {$IFDEF WIN32}
    SockRecv := recv(_SockDesc,
                     _SockBuffer,
                     _SockBufLen,
                     _SockFlags);
  {$ENDIF}

  {$IFDEF OS2}
    SockRecv := ibm_recv(_SockDesc,
                         _SockBuffer,
                         _SockBufLen,
                         _SockFlags);
  {$ENDIF}

  {$IFDEF LINUX}
    SockRecv := Recv(_SockDesc,
                     _SockBuffer^,
                     _SockBufLen,
                     _SockFlags);
  {$ENDIF}
end; { func. SockRecv }

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

function SockSend(_SockDesc: tSockDesc;
                  _SockBuffer: pointer;
                  _SockBufLen: ULong;
                  _SockFlags:  ULong): Longint;
begin
  {$IFDEF WIN32}
    SockSend := Send(_SockDesc,
                     _SockBuffer,
                     _SockBufLen,
                     _SockFlags);
  {$ENDIF}

  {$IFDEF OS2}
    SockSend := IBM_Send(_SockDesc,
                         _SockBuffer,
                         _SockBufLen,
                         _SockFlags);
  {$ENDIF}

  {$IFDEF LINUX}
    SockSend := Send(_SockDesc,
                     _SockBuffer^,
                     _SockBufLen,
                     _SockFlags);
  {$ENDIF}
end; { func. SockSend }

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

function SockSocket(_SockFamily:   word;
                    _SockType:     word;
                    _SockProtocol: word): tSockDesc;
begin
  {$IFDEF WIN32}
    SockSocket := Socket(_SockFamily, _SockType, _SockProtocol);
  {$ENDIF}

  {$IFDEF OS2}
    SockSocket := ibm_Socket(_SockFamily, _SockType, _SockProtocol);
  {$ENDIF}

  {$IFDEF LINUX}
    SockSocket :=  Socket(_SockFamily, _SockType, _SockProtocol);
  {$ENDIF}
end; { func. SockSocket }

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

function SockClose(_SockDesc: tSockDesc): Longint;
begin
 {$IFDEF OS2}
    Result := IBM_soclose(_SockDesc);
 {$ENDIF}

 {$IFDEF WIN32}
    Result := Closesocket(_SockDesc);
 {$ENDIF}

 {$IFDEF LINUX}
   Result := Longint(fdClose(_SockDesc));
 {$ENDIF}
end; { func. SockClose }

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

function SockInit: Longint;
{$IFDEF WIN32}
var Data: TWSAData;
{$ENDIF}
begin
  if SockInitted then EXIT;
  SockInitted := true;

  {$IFDEF OS2}
    SockInit := IBM_Sock_Init;
  {$ENDIF}

  {$IFDEF WIN32}
    SockInit := WsaStartup($0101, Data);
  {$ENDIF}

  {$IFDEF LINUX}
    SockInit :=  0;
  {$ENDIF}
end; { func. SockInit }

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

function SockGetHostByName(Hostname: ShortString): phostent;
begin
  HostName := HostName + #00;
  {$IFDEF WIN32}
    Result := GetHostByName(@HostName[01]);
  {$ENDIF}

  {$IFDEF OS2}
    Result := IBM_GetHostByName(@HostName[01]);
  {$ENDIF}

  {$IFDEF LINUX}
    Result := GetHostByName(@HostName[1]);
  {$ENDIF}
end; { func. SockGetHostByName }

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

function SockGetHostAddrByName(_HostName: ShortString): ULong;
var ReturnCode: pHostEnt;
    InAddr    : tIn_Addr;
begin
  ReturnCode := SockGetHostbyName(_HostName);
  if Assigned(ReturnCode) then
    begin
      InAddr := ReturnCode^.H_Addr_List^^;
      Result := InAddr.IpAddr;
    end
      else Result:=$FFFFFFFF;
end; { func. SockGetHostAddrByName }

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

function SockGetHostByAddr(HostAddr:     pIn_Addr;
                           HostAddrLen:  ULong;
                           HostAddrType: ULong): pointer;
begin
  {$IFDEF WIN32}
    SockGetHostByAddr := GetHostbyAddr(HostAddr,
                                       HostAddrLen,
                                       HostAddrType);
  {$ENDIF}

  {$IFDEF OS2}
    SockGetHostByAddr := IBM_GetHostbyAddr(HostAddr,
                                           HostAddrLen,
                                           HostAddrType);
  {$ENDIF}

  {$IFDEF LINUX}
    Result := GetHostByAddr(HostAddr, HostAddrLen, HostAddrtype);
  {$ENDIF}
end; { func. SockGetHostbyAddr }

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

function SockGetHostNameByAddr(_HostAddr: pIn_Addr): ShortString;
var Counter   : Integer;
    ReturnCode: pHostEnt;
    HName     : ShortString;
begin
  ReturnCode := SockGetHostByAddr(_HostAddr,
                                  In_Addr_Len,
                                  AF_INET);

  if (ULong(ReturnCode) <> 00) then
    begin
      HName := '';
      Counter := 00;

      While ReturnCode^.H_Name^[Counter] <> #00 do
        begin
          HName := HName + ReturnCode^.H_Name^[Counter];
          Inc(Counter);
        end; { while }
    end
      else HName := 'Hostname not found';

  SockGetHostNameByAddr := HName;
end; { func. SockGetHostNameByAddr }

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

function SockGetHostname: ShortString;
var Counter   : Longint;
    sResult   : Longint;
    HostName  : ShortString;
    InAddr    : TIn_Addr;
begin
  FillChar(HostName, SizeOf(HostName), #00);

  {$IFDEF WIN32}
    sResult := GetHostName(@HostName[01], SizeOf(HostName));
  {$ENDIF}

  {$IFDEF OS2}
    sResult := IBM_GetHostName(@HostName[01], SizeOf(HostName));
  {$ENDIF}

  {$IFDEF LINUX}
    {!!!!!!!!!!!!!!!!!!!}
    InAddr.ClassA := 127;
    InAddr.ClassB := 0;
    InAddr.ClassC := 0;
    InAddr.ClassD := 1;

    HostName := SockGetHostNameByAddr(@InAddr) + #00;
    sResult := Length(HostName);
  {$ENDIF}

  Counter := 01;
  While (Counter < SizeOf(HostName)) AND (HostName[Counter] <> #00) do
    Inc(Counter);

  if (Counter > 01) then
    SetLength(HostName, Counter)
      else HostName := 'amnesiac';

  SockGetHostname := HostName;
end; { func. SockGetHostName }

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

function SockInetAddr(_s: ShortString): tIn_Addr;
begin
  _s := _s + #00;

  {$IFNDEF LINUX}
    Result.IpAddr := INet_Addr(@_S[01]);
  {$ELSE}
    {$WARNING SockInetAddr function not implemented! }
    Result.IpAddr := INADDR_NONE;
  {$ENDIF}
end; { func. SockInetAddr }

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

function SockClientAlive(_SockDesc: tSockDesc): Boolean;
var TempCH     : Char;
    Returncode : Longint;
    TempError  : Longint;
    TempStr    : String;
begin
  Result := true;

  ReturnCode := SockRecv(_SockDesc, @TempCH, SizeOf(TempCH), MSG_PEEK);
  TempError := SockErrorNo;

  TempStr := SockGetErrStr(TempError);

  if ReturnCode = 0 then Result := false; { was: = 0 }
  if (TempError <> WSAEWOULDBLOCK) AND (TempError <> 00) then
    Result := false;
end; { func. SockClientAlive }

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

initialization
 {!!   SockInit; }

finalization
  {$IFDEF WIN32}
    WsaCleanUp;
  {$ENDIF}
end.  { unit SockFunc }