sockfunc.pas

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

unit SockFunc;
(*
**
** SOCKFUNC routines
**
** Copyright (c) 1998 by Thomas W. Mueller
** Linux additions (c)1999 by Maarten Bekers
**
** Created : 24-Oct-1998
** Last update : 24-Oct-1998
**
**
*)

(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
 INTERFACE
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-
** Copyright (c) 1982, 1985, 1986 Regents of the University of California.
** All rights reserved.
**
** Redistribution and use in source and binary forms are permitted
** provided that this notice is preserved and that due credit is given
** to the University of California at Berkeley. The name of the University
** may not be used to endorse or promote products derived from this
** software without specific prior written permission. This software
** is provided ``as is'' without express or implied warranty.
s**
**      @(#)socket.h    7.2 (Berkeley) 12/30/87
-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)

uses
{$IFDEF OS2}
  OS2Def,
  IBMSO32,
  IBMTCP32,
{$ENDIF}

{$IFDEF WIN32}
  windows,
  W32Sock,
{$ENDIF}

{$IFDEF LINUX}
  linux,
  Linsock,
{$ENDIF}

  Sysutils,
  SockDef;

Const SockInitted : Boolean = false;

function  SockErrorNo: Longint;
function  SockGetErrStr(_ErrNo: integer): ShortString;
procedure SockRaiseError(const _prefix: String; _ErrNo: integer);
procedure SockRaiseLastError(const _prefix: String);

function  SockAccept(_SockDesc: tSockDesc; _SockAddr: pSockAddr;
                    var _SockAddrLen: Longint): tSockDesc;
function  SockBind(_SockDesc: tSockDesc; var _SockAddr: tSockAddr): Longint;
function  SockCancel(_SockDesc: tSockDesc): Longint;
function  SockConnect(_SockDesc: tSockDesc; var _SockAddr: tSockAddr): Longint;
function  SockGetHostByName(Hostname: ShortString): phostent;
function  SockShutdown(_SockDesc: tSockDesc; _how: ULong): Longint;
function  SockGetSockAddr(_SockDesc: tSockDesc; var _SockAddr: tSockAddr): Longint;
function  SockGetSockOpt(_SockDesc: tSockDesc; _Level, _OptName: Integer;
                         _OptVal: PChar; var _OptLen: Integer): Longint;
function  SockSetSockOpt(_SockDesc: tSockDesc; _Level: uLong; _OptName: Ulong;
                         _OptVal: pChar; _OptLen: uLong ): Longint;
function  SockSetBlockingIO(_SockDesc: tSockDesc; _BlockingIO: boolean): Longint;
function  SockIoCtlSocket(_SockDesc: tSockDesc; Func: Longint): Longint;
function  SockListen(_SockDesc: tSockDesc; _SockQueue:  ULong): Longint;
function  SockRecv(_SockDesc: tSockDesc; _SockBuffer: pointer;
                   _SockBufLen: ULong; _SockFlags:  ULong): Longint;
function  SockSend(_SockDesc: tSockDesc; _SockBuffer: pointer;
                   _SockBufLen: ULong; _SockFlags:  ULong ): Longint;
function  SockSocket(_SockFamily: word; _SockType: word;
                     _SockProtocol: word ): tSockDesc;
function  SockClose(_SockDesc: tSockDesc): Longint;
function  SockInit: Longint;
function  SockClientAlive(_SockDesc: tSockDesc): Boolean;

function  SockGetHostAddrByName(_HostName: ShortString): ULONG;
function  SockGetHostNameByAddr(_HostAddr: pIn_Addr): ShortString;
function  SockGetHostname: ShortString;

function  SockGetServByName(_Name, _Proto: ShortString): pServEnt;
function  SockGetServPortByName(_Name, _Proto: ShortString): Longint;

function  SockHtonl(_Input: LongInt): longint;
function  SockHtons(_Input: SmallWord): SmallWord;

function  SockNtohl(_Input: LongInt): longint;
function  SockNtohs(_Input: SmallWord): longint;
function  SockDataAvail(_SockDesc: tSockDesc): Boolean;
function  SockSelect(_SockDesc: tSockDesc): Longint;
function  SockInetAddr(_s: ShortString):tIn_Addr;

{$IFNDEF LINUX}
 {$IFNDEF FPC}
  {$R SOCKFUNC.RES}
 {$ENDIF}
{$ENDIF}

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

Const
  Version    = '1.00';
  UseString:  ShortString = '@(#)socket interface unit for IBM TCP/IP and WinSock'#0;
  CopyRight1: ShortString = '@(#)socket Version '+Version+' - 26.08.1998'#0;
  CopyRight2: ShortString = '@(#}(C) Thomas Mueller 1998'#0;
  CopyRight3: ShortString = '@(#)(C) Chr.Hohmann BfS ST2.2 1996'#0;

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


function SockErrorNo: Longint;
begin
 {$IFDEF OS2}
   Result := IBM_sock_errno;
 {$ENDIF}

 {$IFDEF WIN32}
   Result := WsaGetLastError;
 {$ENDIF}

 {$IFDEF LINUX}
   Result := SocketError;
 {$ENDIF}
end; { func. SockErrorNo }

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

function SockGetErrStr(_ErrNo: integer): ShortString;
begin
  Result:=LoadStr(_ErrNo);
end; { func. SockGetErrStr }

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

procedure SockRaiseError(const _prefix: String; _ErrNo: integer);
begin
  raise eSocketErr.CreateFmt('%s: %s (%d)',
                             [_prefix, SockGetErrStr(_ErrNo), _ErrNo]);
end; { proc. SockRaiseError }

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

procedure SockRaiseLastError(const _prefix: String);
begin
  SockRaiseError(_Prefix, SockErrorNo);
end; { proc. SockRaiseLastError }

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


function SockGetServByName(_Name, _Proto: ShortString): pServEnt;
begin
  _Name  := _Name + #00;
  _Proto := _Proto + #00;

  {$IFDEF WIN32}
    Result := getservbyname(@_Name[01], @_Proto[01]);
  {$ENDIF}

  {$IFDEF OS2}
    Result := ibm_getservbyname(@_Name[01], @_Proto[01]);
  {$ENDIF}

  {$IFDEF LINUX}
    Result := getservbyname(@_Name[1], @_Proto[01]);
  {$ENDIF}
end; { func. SockGetServByName }

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

function SockGetServPortByName(_Name, _Proto: ShortString): longint;
var ServEnt: pServEnt;
begin
  ServEnt := SockGetServByName(_Name, _Proto);

  if Assigned(ServEnt) then
    Result := ServEnt^.s_Port
      else Result := -01;
end; { func. SockGetServPortByName }

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

function SockHtonl( _Input: longint): longint;
type SwapLong = packed record
                 case integer of
                   0: (SLong:  longint);
                   1: (SArray: packed array[1..4] of byte);
                end;
var Inp,
    Tmp: SwapLong;
begin
  Inp.SLong     := _Input;
  Tmp.SArray[1] := Inp.SArray[4];
  Tmp.SArray[2] := Inp.SArray[3];
  Tmp.SArray[3] := Inp.SArray[2];
  Tmp.SArray[4] := Inp.SArray[1];
  result := Tmp.SLong;
end;

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

function SockHtons( _Input: SmallWord): SmallWord;
type SwapWord = packed record
                 case integer of
                   0: (SWord:  SmallWord);
                   1: (SArray: packed array[1..2] of byte);
               end;
var Inp,Tmp: SwapWord;
begin
  Inp.SWord     := _Input;
  Tmp.SArray[1] := Inp.SArray[2];
  Tmp.SArray[2] := Inp.SArray[1];
  Result        := Tmp.SWord;
end; { func. SockhToNl }

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

function SockNtohl( _Input: longint): longint;
begin
  {$IFNDEF LINUX}
     Result:=ntohl(_Input);
  {$ELSE}
     {!!!!!!!!!!!!!!!!!!!!!!!}
     Result :=  _Input;
  {$ENDIF}
end; { func. sockNToHl }

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

function SockNtohs( _Input: SmallWord): longint;
begin
  {$IFDEF WIN32}
    Result := ntohs( _input);
  {$ENDIF}

  {$IFDEF OS2}
{!!!!!    Result := ntohs( _input);}
    Result := Lo(_Input) * 256 + Hi(_Input);
  {$ENDIF}

  {$IFDEF LINUX}
    Result := ntohs(_input);
  {$ENDIF}
end; { func. SockNToHs }

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

function SockAccept(_SockDesc: tSockDesc;
                    _SockAddr: pSockAddr;
                    var _SockAddrLen: Longint): longint;
begin
  {$IFDEF WIN32}
    Result := Accept(_SockDesc, _SockAddr, @_SockAddrLen);
  {$ENDIF}

  {$IFDEF OS2}
    Result := IBM_Accept(_SockDesc, _SockAddr, @_SockAddrLen);
  {$ENDIF}

  {$IFDEF LINUX}
    Result := Accept(_SockDesc, _SockAddr^, _SockAddrLen);
  {$ENDIF}
end; { func. SockAccept }

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

function SockBind(_SockDesc:  tSockDesc;
                  var _SockAddr: tSockAddr ): Longint;
begin
  {$IFDEF WIN32}
    SockBind := Bind(_SockDesc, @_SockAddr, SockAddr_Len);
  {$ENDIF}

  {$IFDEF OS2}
    SockBind := IBM_Bind(_SockDesc, @_SockAddr, SockAddr_Len);
  {$ENDIF}

  {$IFDEF LINUX}
    SockBind := Longint(Bind(_SockDesc, _SockAddr, SockAddr_Len));
  {$ENDIF}
end; { func. SockBind }

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

function SockConnect(_SockDesc: tSockDesc;
                     var _SockAddr: tSockAddr): Longint;
begin
  {$IFDEF WIN32}
    SockConnect := connect(_SockDesc, @_SockAddr, SockAddr_Len);
  {$ENDIF}

  {$IFDEF OS2}
    SockConnect := ibm_connect(_SockDesc, @_SockAddr, SockAddr_Len);
  {$ENDIF}

  {$IFDEF LINUX}
    SockConnect := connect(_SockDesc, _SockAddr, sockAddr_Len);
  {$ENDIF}
end; { func. SockConnect }

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

function SockCancel(_SockDesc: tSockDesc): Longint;
begin
  {$IFDEF WIN32}
    Result := SockCancel(_SockDesc);
  {$ENDIF}

  {$IFDEF OS2}
    Result := IBM_So_Cancel(_SockDesc);
  {$ENDIF}

  {$IFDEF LINUX}
    Result := longint(true);
    if _SockDesc=0 then ;

    {$WARNING SockCancel function not implemented }
    {!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
  {$ENDIF}
end; { func. SockCancel }

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

function SockShutdown(_SockDesc:  tSockDesc;
                      _how: ULong): Longint;
begin
  {$IFDEF WIN32}
    SockShutdown := ShutDown(_SockDesc, _How);
  {$ENDIF}

  {$IFDEF OS2}
    SockShutDown := IBM_ShutDown(_SockDesc, _How);
  {$ENDIF}

  {$IFDEF LINUX}
    SockShutDown := ShutDown(_SockDesc, _How);
  {$ENDIF}
end; { func. SockShutDown }

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

function SockGetSockAddr(_SockDesc: tSockDesc; var _SockAddr: tSockAddr): Longint;
var sLength: Integer;
begin
  FillChar(_SockAddr, SizeOf(_SockAddr), #00);
  sLength := SizeOf(_SockAddr);

  {$IFDEF WIN32}
    Result := GetSockName(_SockDesc, @_SockAddr, sLength);
  {$ENDIF}

  {$IFDEF OS2}
    Result := IBM_GetSockName(_SockDesc, @_SockAddr, @sLength);
  {$ENDIF}

  {$IFDEF LINUX}
    Result := GetSocketName(_SockDesc, _SockAddr, sLength);
  {$ENDIF}
end; { func. sockGetSockAddr }

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

function SockSetBlockingIO(_SockDesc: tSockDesc;
                          _BlockingIO: boolean): Longint;
var Arg: ULONG;
begin
  {$IFDEF OS2}
    if _BlockingIO then Arg := 00
      else Arg := 01;

    Result := IBM_IOCtl(_SockDesc, FIONBIO, @Arg, SizeOf(Arg));
  {$ENDIF}

  {$IFDEF WIN32}
    if _BlockingIO then Arg := 00
      else Arg := 01;

    Result := IOCtlSocket(_SockDesc, FIONBIO, Arg);
  {$ENDIF}

  {$IFDEF LINUX}
    if _BlockingIO then Arg := 00
      else Arg := 01;

    Result := Longint(ioctl(_SockDesc, Linux.FIONBIO, @Arg));
  {$ENDIF}
end; { func. SockSetBlockingIO }

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

function  SockIoCtlSocket(_SockDesc: tSockDesc; Func: Longint): Longint;
var Arg: ULONG;
begin
  Arg := 0;

  {$IFDEF OS2}
    Result := IBM_IOCtl(_SockDesc, FUNC, @Arg, SizeOf(Arg));
  {$ENDIF}

  {$IFDEF WIN32}
    Result := IOCtlSocket(_SockDesc, FUNC, Arg);
  {$ENDIF}

  {$IFDEF LINUX}
    Result := Longint(IoCtl(_SockDesc, Func, @Arg));
  {$ENDIF}
end; { func. SockIoCtlSocket }