psistack.pas

一个delphi的p2p控件的源代码

unit PsiStack;

//******************************************************************************
// The original software is under
// Copyright (c) 1993 - 2000, Chad Z. Hower (Kudzu)
//   and the Indy Pit Crew - http://www.nevrona.com/Indy/
//
// Amended : November 2000, by Michael M. Michalak MACS for use with
// MorphTek.com Inc Peer to Peer Open Source Components - http://www.morphtek.com
//
//******************************************************************************

interface

uses
  Classes,
  PsiStackConsts, PsiGlobal;

type
  TPsiServeFile = function(ASocket: TPsiStackSocketHandle; AFileName: string): cardinal;

  // Abstract PsiStack class
  TPsiStackVersion = class
  protected
    FMaxUdpDg: Cardinal;
    FMaxSockets: Cardinal;
    FVersion: Word;
    FLowVersion: Word;
    FDescription: string;
    FVendorInfo: string;
    FSystemStatus: String;
    FName: String;
    constructor Create(InfoStruct: Pointer); virtual; abstract;
  published
    property Name: String read FName;
    property Version: Word read FVersion;
    property LowVersion: Word read FLowVersion;
    property Description: string read FDescription;
    property SystemStatus: String read FSystemStatus;
    property MaxSockets: Cardinal read FMaxSockets;
    property MaxUdpDg: Cardinal read FMaxUdpDg;
    property VendorInfo: string read FVendorInfo;
  end;

  TPsiSunB = packed record
    s_b1, s_b2, s_b3, s_b4: byte;
  end;

  TPsiSunW = packed record
    s_w1, s_w2: word;
  end;

  PPsiInAddr = ^TPsiInAddr;
  TPsiInAddr = record
    case integer of
      0: (S_un_b: TPsiSunB);
      1: (S_un_w: TPsiSunW);
      2: (S_addr: longword);
  end;

  TPsiStack = class
  protected
    FStackVersion: TPsiStackVersion;
    FLocalAddress: string;
    FLocalAddresses: TStrings;
    procedure PopulateLocalAddresses; virtual; abstract;
    function WSGetLocalAddress: string; virtual; abstract;
    function WSGetLocalAddresses: TStrings; virtual; abstract;
  public
    function CheckForSocketError(const AResult: integer = Psi_SOCKET_ERROR): boolean; overload;
    function CheckForSocketError(const AResult: integer; const AIgnore: array of integer)
     : boolean; overload;
    constructor Create; reintroduce; virtual;
    destructor Destroy; override;
    class function CreateStack: TPsiStack;
    function CreateSocketHandle(const ASocketType: Integer;
      const AProtocol: Integer = Psi_IPPROTO_IP): TPsiStackSocketHandle;
    function IsIP(AIP: string): boolean;
    procedure RaiseSocketError(const AErr: integer);
    function ResolveHost(const AHost: string): string;
    // Resolves host passed in sHost. sHost may be an IP or a HostName.
    // sIP returns string version of the IP
    function WSAccept(ASocket: TPsiStackSocketHandle; var VIP: string; var VPort: Integer)
     : TPsiStackSocketHandle; virtual; abstract;
    function WSBind(ASocket: TPsiStackSocketHandle; const AFamily: Integer;
     const AIP: string; const APort: Integer): Integer; virtual; abstract;
    function WSCloseSocket(ASocket: TPsiStackSocketHandle): Integer; virtual; abstract;
    function WSConnect(const ASocket: TPsiStackSocketHandle; const AFamily: Integer;
     const AIP: string; const APort: Integer): Integer; virtual; abstract;
    function WSGetHostByName(const AHostName: string): string; virtual; abstract;
    function WSGetHostName: string; virtual; abstract;
    function WSGetHostByAddr(const AAddress: string): string; virtual; abstract;
    function WSGetServByName(const AServiceName: string): Integer; virtual; abstract;
    function WSGetServByPort(const APortNumber: Integer): TStrings; virtual; abstract;
    function WSHToNs(AHostShort: Word): Word; virtual; abstract;
    function WSListen(ASocket: TPsiStackSocketHandle; ABackLog: Integer): Integer; virtual; abstract;
    function WSNToHs(ANetShort: Word): Word; virtual; abstract;
    function WSHToNL(AHostLong: LongWord): LongWord; virtual; abstract;
    function WSNToHL(ANetLong: LongWord): LongWord; virtual; abstract;
    function WSRecv(ASocket: TPsiStackSocketHandle; var ABuffer; ABufferLength, AFlags: Integer)
     : Integer; virtual; abstract;
    function WSRecvFrom(const ASocket: TPsiStackSocketHandle; var ABuffer;
     const ALength, AFlags: Integer; var VIP: string; var VPort: Integer): Integer; virtual;
     abstract;
    function WSSelect(ARead, AWrite, AErrors: TList; ATimeout: Integer): Integer; virtual; abstract;
    function WSSend(ASocket: TPsiStackSocketHandle; var ABuffer;
     const ABufferLength, AFlags: Integer): Integer; virtual; abstract;
    function WSSendTo(ASocket: TPsiStackSocketHandle; var ABuffer;
     const ABufferLength, AFlags: Integer; const AIP: string; const APort: integer): Integer;
      virtual; abstract;
    function WSSetSockOpt(ASocket: TPsiStackSocketHandle; ALevel, AOptName: Integer; AOptVal: PChar;
     AOptLen: Integer): Integer; virtual; abstract;
    function WSSocket(AFamily, AStruct, AProtocol: Integer): TPsiStackSocketHandle; virtual; abstract;
    function WSTranslateSocketErrorMsg(const AErr: integer): string; virtual;
    function WSGetLastError: Integer; virtual; abstract;

    function StringToTInAddr(AIP: string): TPsiInAddr;
    function TInAddrToString(var AInAddr): string; virtual; abstract;
    procedure TranslateStringToTInAddr(AIP: string; var AInAddr); virtual; abstract;
    //
    property LocalAddress: string read WSGetLocalAddress;
    property LocalAddresses: TStrings read WSGetLocalAddresses;

    property StackVersion: TPsiStackVersion read FStackVersion;
  end;

var
  GStack: TPsiStack = nil;
  GServeFileProc: TPsiServeFile = nil;

implementation

uses
  PsiStackWinsock,
  PsiException,
  PsiResourceStrings,
	SysUtils;

{ TPsiStack }

function TPsiStack.CheckForSocketError(const AResult: integer): boolean;
begin
  result := CheckForSocketError(AResult, [0]);
end;

function TPsiStack.CheckForSocketError(const AResult: integer;
  const AIgnore: array of integer): boolean;
var
  i, nErr: integer;
begin
  Result := false;
  if AResult = Psi_SOCKET_ERROR then begin
    nErr := WSGetLastError;
    for i := Low(AIgnore) to High(AIgnore) do begin
      if nErr = AIgnore[i] then begin
        Result := True;
        exit;
      end;
    end;
    RaiseSocketError(nErr);
  end;
end;

function TPsiStack.CreateSocketHandle(const ASocketType: Integer;
  const AProtocol: Integer = Psi_IPPROTO_IP): TPsiStackSocketHandle;
begin
  result := WSSocket(Psi_PF_INET, ASocketType, AProtocol);
  if result = Psi_INVALID_SOCKET then begin
    raise EPsiInvalidSocket.Create(RSCannotAllocateSocket);
  end;
end;

procedure TPsiStack.RaiseSocketError(const AErr: integer);
begin
  // It is normal to receive a 10038 exception here when shutting down servers.
  if AErr <> 10038 then
    raise EPsiSocketError.CreateError(AErr, WSTranslateSocketErrorMsg(AErr));
end;

constructor TPsiStack.Create;
begin
  // Here so descendants can override and call inherited for future exp since TObject's Create
  // is not virtual
end;

class function TPsiStack.CreateStack: TPsiStack;
begin
  result := TPsiStackWinsock.Create;
end;

function TPsiStack.ResolveHost(const AHost: string): string;
begin
  // Sometimes 95 forgets who localhost is
  if AnsiSameText(AHost, 'LOCALHOST') then begin
    result := '127.0.0.1';
  end else if IsIP(AHost) then begin
    result := AHost;
  end else begin
    result := WSGetHostByName(AHost);
  end;
end;

function TPsiStack.WSTranslateSocketErrorMsg(const AErr: integer): string;
begin
  Result := '';
  case AErr of
    Psi_WSAEINTR: Result           := RSStackEINTR;
    Psi_WSAEBADF: Result           := RSStackEBADF;
    Psi_WSAEACCES: Result          := RSStackEACCES;
    Psi_WSAEFAULT: Result          := RSStackEFAULT;
    Psi_WSAEINVAL: Result          := RSStackEINVAL;
    Psi_WSAEMFILE: Result          := RSStackEMFILE;

    Psi_WSAEWOULDBLOCK: Result     := RSStackEWOULDBLOCK;
    Psi_WSAEINPROGRESS: Result     := RSStackEINPROGRESS;
    Psi_WSAEALREADY: Result        := RSStackEALREADY;
    Psi_WSAENOTSOCK: Result        := RSStackENOTSOCK;
    Psi_WSAEDESTADDRREQ: Result    := RSStackEDESTADDRREQ;
    Psi_WSAEMSGSIZE: Result        := RSStackEMSGSIZE;
    Psi_WSAEPROTOTYPE: Result      := RSStackEPROTOTYPE;
    Psi_WSAENOPROTOOPT: Result     := RSStackENOPROTOOPT;
    Psi_WSAEPROTONOSUPPORT: Result := RSStackEPROTONOSUPPORT;
    Psi_WSAESOCKTNOSUPPORT: Result := RSStackESOCKTNOSUPPORT;
    Psi_WSAEOPNOTSUPP: Result      := RSStackEOPNOTSUPP;
    Psi_WSAEPFNOSUPPORT: Result    := RSStackEPFNOSUPPORT;
    Psi_WSAEAFNOSUPPORT: Result    := RSStackEAFNOSUPPORT;
    Psi_WSAEADDRINUSE: Result      := RSStackEADDRINUSE;
    Psi_WSAEADDRNOTAVAIL: Result   := RSStackEADDRNOTAVAIL;
    Psi_WSAENETDOWN: Result        := RSStackENETDOWN;
    Psi_WSAENETUNREACH: Result     := RSStackENETUNREACH;
    Psi_WSAENETRESET: Result       := RSStackENETRESET;
    Psi_WSAECONNABORTED: Result    := RSStackECONNABORTED;
    Psi_WSAECONNRESET: Result      := RSStackECONNRESET;
    Psi_WSAENOBUFS: Result         := RSStackENOBUFS;
    Psi_WSAEISCONN: Result         := RSStackEISCONN;
    Psi_WSAENOTCONN: Result        := RSStackENOTCONN;
    Psi_WSAESHUTDOWN: Result       := RSStackESHUTDOWN;
    Psi_WSAETOOMANYREFS: Result    := RSStackETOOMANYREFS;
    Psi_WSAETIMEDOUT: Result       := RSStackETIMEDOUT;
    Psi_WSAECONNREFUSED: Result    := RSStackECONNREFUSED;
    Psi_WSAELOOP: Result           := RSStackELOOP;
    Psi_WSAENAMETOOLONG: Result    := RSStackENAMETOOLONG;
    Psi_WSAEHOSTDOWN: Result       := RSStackEHOSTDOWN;
    Psi_WSAEHOSTUNREACH: Result    := RSStackEHOSTUNREACH;
    Psi_WSAENOTEMPTY: Result       := RSStackENOTEMPTY;
    Psi_WSAEPROCLIM: Result        := RSStackEPROCLIM;
    Psi_WSAEUSERS: Result          := RSStackEUSERS;
    Psi_WSAEDQUOT: Result          := RSStackEDQUOT;
    Psi_WSAESTALE: Result          := RSStackESTALE;
    Psi_WSAEREMOTE: Result         := RSStackEREMOTE;

    Psi_WSASYSNOTREADY: Result     := RSStackSYSNOTREADY;
    Psi_WSAVERNOTSUPPORTED: Result := RSStackVERNOTSUPPORTED;
    Psi_WSANOTINITIALISED: Result  := RSStackNOTINITIALISED;

    Psi_WSAHOST_NOT_FOUND: Result  := RSStackHOST_NOT_FOUND;
    Psi_WSATRY_AGAIN: Result       := RSStackTRY_AGAIN;
    Psi_WSANO_RECOVERY: Result     := RSStackNO_RECOVERY;
    Psi_WSANO_DATA: Result         := RSStackNO_DATA;
  end;
  Result := Format(RSStackError, [AErr, Result]);
end;

function TPsiStack.IsIP(AIP: string): boolean;
var
  s1, s2, s3, s4: string;

  function ByteIsOk(const AByte: string): boolean;
  begin
    result := (StrToIntDef(AByte, -1) > -1) and (StrToIntDef(AByte, 256) < 256);
  end;

begin
  s1 := Fetch(AIP, '.');
  s2 := Fetch(AIP, '.');
  s3 := Fetch(AIP, '.');
  s4 := AIP;
  result := ByteIsOk(s1) and ByteIsOk(s2) and ByteIsOk(s3) and ByteIsOk(s4);
end;

destructor TPsiStack.Destroy;
begin
  FLocalAddresses.Free;
  inherited;
end;

function TPsiStack.StringToTInAddr(AIP: string): TPsiInAddr;
begin
  TranslateStringToTInAddr(AIP, result);
end;

{ TPsiStackVersion }

end.