psock.pas.~1~

DELPHI里面一些常用的控件

unit Psock;

{$IFDEF VER100}
{$DEFINE NMF3}
{$ENDIF}
{$IFDEF VER110}
{$DEFINE NMF3}
{$ENDIF}
{$IFDEF VER120}
{$DEFINE NMF3}
{$ENDIF}
{$IFDEF VER125}
{$DEFINE NMF3}
{$ENDIF}
{$IFDEF VER130}
{$DEFINE NMF3}
{$ENDIF}
{$IFDEF VER150}
{$DEFINE NMF3}
{$ENDIF}

{$X+}
{$H+}
{$R-}
{$DEFINE _WINSOCKAPI_}

interface

uses
  Winsock, Classes, SysUtils, Extctrls, Forms, Messages, StdCtrls,
  WinProcs, NMConst, NMFIFOBuffer, SyncObjs;

{$IFDEF VER110}
{$OBJEXPORTALL On}
{$ENDIF}
{$IFDEF VER120}
{$OBJEXPORTALL On}
{$ENDIF}
{$IFDEF VER125}
{$OBJEXPORTALL On}
{$ENDIF}

type
  TSocket = Word;

const

  FD_ALL = 63;

  {Size of receive and send buffer}
  MAX_RECV_BUF = 65536;

  { Levels for reporting Status Messages}
  Status_None = 0;
  Status_Informational = 1;
  Status_Basic = 2;
  Status_Routines = 4;
  Status_Debug = 8;
  Status_Trace = 16;

  {Carriage Return and Line Feed constants}
  CR = #13;
  LF = #10;
  CRLF = #13#10;

  WM_ASYNCHRONOUSPROCESS = WM_USER + 101; {Message number for asynchronous socket messages}
  WM_WAITFORRESPONSE = WM_USER + 102; {Message number for synchronous responses}

type
  TErrorMessage = record
    ErrorCode: Integer;
    Text: string[50];
  end;

const
  WinsockMessage: array[0..50] of TErrorMessage =
  (
    (ErrorCode: 10004; Text: 'Interrupted system call'),
    (ErrorCode: 10009; Text: 'Bad file number'),
    (ErrorCode: 10013; Text: 'Permission denied'),
    (ErrorCode: 10014; Text: 'Bad address'),
    (ErrorCode: 10022; Text: 'Invalid argument'),
    (ErrorCode: 10024; Text: 'Too many open files'),
    (ErrorCode: 10035; Text: 'Operation would block'),
    (ErrorCode: 10036; Text: 'Operation now in progress'),
    (ErrorCode: 10037; Text: 'Operation already in progress'),
    (ErrorCode: 10038; Text: 'Socket operation on non-socket'),
    (ErrorCode: 10039; Text: 'Destination address required'),
    (ErrorCode: 10040; Text: 'Message too long'),
    (ErrorCode: 10041; Text: 'Wrong protocol type for socket'),
    (ErrorCode: 10042; Text: 'Bad protocol option'),
    (ErrorCode: 10043; Text: 'Protocol not supported'),
    (ErrorCode: 10044; Text: 'Socket type not supported'),
    (ErrorCode: 10045; Text: 'Operation not supported on socket'),
    (ErrorCode: 10046; Text: 'Protocol family not supported'),
    (ErrorCode: 10047; Text: 'Address family not supported by protocol family'),
    (ErrorCode: 10048; Text: 'Address already in use'),
    (ErrorCode: 10049; Text: 'Can''t assign requested address'),
    (ErrorCode: 10050; Text: 'Network is down'),
    (ErrorCode: 10051; Text: 'Network is unreachable'),
    (ErrorCode: 10052; Text: 'Network dropped connection or reset'),
    (ErrorCode: 10053; Text: 'Software caused connection abort'),
    (ErrorCode: 10054; Text: 'Connection reset by peer'),
    (ErrorCode: 10055; Text: 'No buffer space available'),
    (ErrorCode: 10056; Text: 'Socket is already connected'),
    (ErrorCode: 10057; Text: 'Socket is not connected'),
    (ErrorCode: 10058; Text: 'Can''t send after socket shutdown'),
    (ErrorCode: 10059; Text: 'Too many references, can''t splice'),
    (ErrorCode: 10060; Text: 'Connection timed out'),
    (ErrorCode: 10061; Text: 'Connection refused'),
    (ErrorCode: 10062; Text: 'Too many levels of symbolic links'),
    (ErrorCode: 10063; Text: 'File name too long'),
    (ErrorCode: 10064; Text: 'Host is down'),
    (ErrorCode: 10065; Text: 'No route to Host'),
    (ErrorCode: 10066; Text: 'Directory not empty'),
    (ErrorCode: 10067; Text: 'Too many processes'),
    (ErrorCode: 10068; Text: 'Too many users'),
    (ErrorCode: 10069; Text: 'Disc quota exceeded'),
    (ErrorCode: 10070; Text: 'Stale NFS file handle'),
    (ErrorCode: 10071; Text: 'Too many levels of remote in path'),
    (ErrorCode: 10091; Text: 'Network subsystem is unavailable'),
    (ErrorCode: 10092; Text: 'Incompatible version of WINSOCK.DLL'),
    (ErrorCode: 10093; Text: 'Successful WSAStartup not yet performed'),
    (ErrorCode: 11001; Text: 'Host not found'),
    (ErrorCode: 11002; Text: 'Non-Authoritative Host not found'),
    (ErrorCode: 11003; Text: 'Non-Recoverable error: FORMERR, REFUSED, NOTIMP'),
    (ErrorCode: 11004; Text: 'Valid name, no data record of requested type'),
    (ErrorCode: 0; Text: 'Unrecognized error code')
    );
type
    {Event Handlers}
  TOnErrorEvent = procedure(Sender: TComponent; Errno: Word; Errmsg: string) of object;
  TOnHostResolved = procedure(Sender: TComponent) of object;
  TOnStatus = procedure(Sender: TComponent; Status: string) of object;
  THandlerEvent = procedure(var Handled: Boolean) of object;

  { new basic pointer types }
  PLongint = ^Longint;
  PPLongInt = ^PLongint;
  PPChar = ^PChar;
  PINT = ^PInteger;

  THostInfo = record
    Name: PChar;
    AliasList: PPChar;
    AddressType: Integer;
    AddressSize: Integer;
    AddressList: PPLongInt;
    Reserved: array[1..MAXGETHOSTSTRUCT] of Char;
  end;

  TServerInfo = record
    Name: PChar;
    Aliases: PPChar;
    PORT: Integer;
    Protocol: PChar;
    Reserved: array[1..MAXGETHOSTSTRUCT] of Char;
  end;

  TProtocolInfo = record
    Name: PChar;
    Aliases: PPChar;
    ProtocolID: Integer;
    Reserved: array[1..MAXGETHOSTSTRUCT] of Char;
  end;

  TSocketAddress = record
    Family: Integer;
    PORT: Word;
    Address: Longint;
    Unused: array[1..8] of Char;
  end;

  TSocketList = record
    Count: Integer;
    DescriptorList: array[1..64] of Integer;
  end;

  TTimeValue = record
    Sec: Longint;
    uSec: Longint;
  end;

  {new WINSOCK pointer types}
  PWSAData = ^TWSAData;
  PHostInfo = ^THostInfo;
  PServerInfo = ^TServerInfo;
  PProtocolInfo = ^TProtocolInfo;
  PSocketAddress = ^TSocketAddress;
  PSocketList = ^TSocketList;
  PTimeValue = ^TTimeValue;

  ESockError = class(Exception);
  EAbortError = class(ESockError);

  TThreadTimer = class(TComponent)
  private
    FInterval: Cardinal;
    FWindowHandle: HWND;
    FOnTimer: TNotifyEvent;
    FEnabled: Boolean;
    procedure UpdateTimer;
    procedure SetEnabled(Value: Boolean);
    procedure SetInterval(Value: Cardinal);
    procedure SetOnTimer(Value: TNotifyEvent);
    procedure Wndproc(var Msg: TMessage);
  protected
    procedure Timer; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Interval: Cardinal read FInterval write SetInterval default 1000;
    property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
  end;

{$IFNDEF NMF3}

  { TStringStream }
  TStringStream = class(TStream)
  private
    FDataString: string;
    FPosition: Integer;
  protected

  public
    procedure SetSize(NewSize: Longint);
    constructor Create(const AString: string);
    function Read(var Buffer; Count: Longint): Longint; override;
    function ReadString(Count: Longint): string;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    procedure WriteString(const AString: string);
    property DataString: string read FDataString;
  end;

  TThreadList = class
  private
    FList: TList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(Item: Pointer);
    procedure Clear;
    function LockList: TList;
    procedure Remove(Item: Pointer);
    procedure UnlockList;
  end;
{$ENDIF}

  {*******************************************************************************************
  Power Socket class definition
  ********************************************************************************************}
  TPowersock = class(TComponent)
  private
    Buf: array[0..MAX_RECV_BUF] of Char;

    WaitSignal: TEvent;

    {Event Handlers for Asynchronous socket events}
    FOnReadEvent: TNotifyEvent;
    FOnAcceptEvent: TNotifyEvent;
    FOnConnect: TNotifyEvent;
    FOnDisconnect: TNotifyEvent;
    FOnErrorEvent: TOnErrorEvent; {Event handler for error notification}

    FInvalidHost: THandlerEvent;
    FOnHostResolved: TOnHostResolved; {Event handler after a host name is found}
    FOnConnectionRequired: THandlerEvent;
    FOnStatus: TOnStatus; {Event handler on a status change}
    FOnConnectionFailed: TNotifyEvent;
    FWSAInfo: TStringList;
    {Component Internals}
    FBytesSent: Longint; {Number of bytes currently sent}

    Canceled: Boolean; {Flag to indicate request cancelled}
    DestroySocket: Boolean; {flag to indicate socket to be destroyed or not}
    FLastErrorno: Integer; {The last error Encountered}
    FTimeOut: Integer; {Time to wait before timout}
    FReportLevel: Integer; {Reporting Level}
    _Status: string; {Current status}
    FProxy: string; {Name or IP of proxy server}
    FProxyPort: Integer; {Port of proxy server}

    {TimeOut Functions}
    Timer: TThreadTimer; {Timer for synchronous requests}

    {For Documentation of functions and procedures see implementation}
    procedure TimerFired(Sender: TObject);
    procedure Wndproc(var message: TMessage); {}

  protected
    FifoQ: TNMFifoBuffer;
    Succeed: Boolean; {Flag for indicating if synchronous request succeded}
    TimedOut: Boolean; {Flag to indicate process timed out}
    FPort: Integer; {Port at server to connect to}
    FBytesTotal: Longint; {Total number of bytes to send or receive}
    FBytesRecvd: Longint; {Number of bytes currently received}
    FPacketRecvd: TNotifyEvent; {Handler after each packet received for progress reports etc}
    FPacketSent: TNotifyEvent; {Handler after each packet received for progress reports etc}
    Wait_Flag: Boolean; {Flag to indicate if synchronous request completed or not}
    RemoteAddress: TSockAddr; {Address of remote host}
    ServerName: string; {Name of remote host}
    RemoteHost: PHostEnt; {Entity to store remote host linfo from a Hostname request}
    FTransactionReply: string; {Reply to a command request}
    FReplyNumber: Smallint; {Reply number to a command request}
    DataGate: Boolean;
    AbortGate: Boolean;
    StrmType: Boolean;

    OnAbortrestart: TNotifyEvent;

    procedure TimerOn;
    procedure TimerOff;
    procedure InitWinsock;
    procedure ReadToBuffer;
    procedure SetLastErrorNo(Value: Integer);
    function SocketErrorStr(Errno: Word): string;
    function GetLastErrorNo: Integer;
    function ErrorManager(Ignore: Word): string;
    procedure SetWSAError(ErrorNo: Word; ErrorMsg: string);
    procedure StatusMessage(Level: Byte; Value: string);
    function GetRemoteIP: string;
    function GetLocalIP: string;

    procedure SetFifoCapacity(NewCapacity: Longint);
    function GetFifoCapacity: Longint;

    {Properties - Make Public the ones that the User needs to respond to in derived class}
    {Event Handlers for Asynchronous Events}
    property OnAccept: TNotifyEvent read FOnAcceptEvent write FOnAcceptEvent;
    {Event Handler for Errors}
    property OnError: TOnErrorEvent read FOnErrorEvent write FOnErrorEvent;
    {Event Handler for Status changes}
    property OnConnectionRequired: THandlerEvent read FOnConnectionRequired write FOnConnectionRequired;
    property Proxy: string read FProxy write FProxy; {name or IP of proxy server}
    property ProxyPort: Integer read FProxyPort write FProxyPort; {Port of proxy server}

  public
    ThisSocket: TSocket; {The socket number of the Powersocket}
    FSocketWindow: HWND; {Dummy window handle to receive Socket messages}
    FConnected: Boolean; {Flag indicating socket connected or not}

    {For Documentation of functions and procedures see implementation}
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    {Runtime Properties}

    {Methods}
    function Accept: TSocket; virtual;
    procedure Cancel;
    procedure Connect; virtual;
    procedure Disconnect; virtual;
    procedure Wait;
    procedure Listen(sync: Boolean);
    procedure SendBuffer(Value: PChar; BufLen: Word);
    procedure Write(Value: string);
    procedure Writeln(Value: string);
    function Read(Value: Word): string;
    function Readln: string;
    function Transaction(const CommandString: string): string; virtual;
    procedure SendFile(Filename: string);
    procedure SendStream(MainStream: TStream);
    procedure SendRestStream(MainStream: TStream);
    procedure CaptureFile(Filename: string);
    procedure AppendFile(Filename: string);
    procedure CaptureStream(MainStream: TStream; Size: Longint);
    procedure CaptureString(var AString: string; Size: Longint);
    procedure FilterHeader(HeaderStream: TFileStream);
    procedure ResolveRemoteHost;
    procedure RequestCloseSocket;
    procedure Close(Socket: THandle);
    procedure Abort; virtual;
    procedure CertifyConnect;
    function DataAvailable: Boolean;
    procedure ClearInput;
    procedure CloseAfterData;
    procedure CloseImmediate;
    function GetLocalAddress: string;
    function GetPortString: string;
    property WSAInfo: TStringList read FWSAInfo; {Winsock info}
    property Connected: Boolean read FConnected;
    property LastErrorNo: Integer read GetLastErrorNo write SetLastErrorNo; {Last Socket error}
    property BeenCanceled: Boolean read Canceled write Canceled; {Status of Cancel request}
    property BeenTimedOut: Boolean read TimedOut;
    property ReplyNumber: Smallint read FReplyNumber; {Numerical result from transaction}
    property RemoteIP: string read GetRemoteIP;
    property LocalIP: string read GetLocalIP;
    property TransactionReply: string read FTransactionReply; {Result from commnd request}
    property BytesTotal: Longint read FBytesTotal; {Total bytes to send or receive}
    property BytesSent: Longint read FBytesSent; {Bytes currently sent}
    property BytesRecvd: Longint read FBytesRecvd; {Bytes currently received}
    property Handle: TSocket read ThisSocket; {Power Socket handle}
    property Status: string read _Status; {Current status}
    property OnRead: TNotifyEvent read FOnReadEvent write FOnReadEvent;
    property OnPacketRecvd: TNotifyEvent read FPacketRecvd write FPacketRecvd; {Handler for status messages during send or receive}
    property OnPacketSent: TNotifyEvent read FPacketSent write FPacketSent; {Handler for status messages during send or receive}

    property FifoCapacity: Longint read GetFifoCapacity write SetFifoCapacity;
  published
    {Properties}
    property Host: string read ServerName write ServerName; {Host Nmae or IP of remote host}
    property PORT: Integer read FPort write FPort; {Port of remote host}
    property TimeOut: Integer read FTimeOut write FTimeOut default 0; {Time before being timed out}
    property ReportLevel: Integer read FReportLevel write FReportLevel default Status_Informational;
    {Events}
    property OnDisconnect: TNotifyEvent read FOnDisconnect write FOnDisconnect;
    property OnConnect: TNotifyEvent read FOnConnect write FOnConnect;
    property OnInvalidHost: THandlerEvent read FInvalidHost write FInvalidHost;