psock.pas

DELPHI里面一些常用的控件

begin
  StatusMessage(Status_Routines, sPSk_Cons_msg_accept); {Status message}
  TimerOn;

  while (not Wait_Flag) and (not Canceled) do
    Wait;
  TimerOff;
  {if error create exception}
  if Canceled then
    raise ESockError.Create(sPSk_Cons_msg_acc_can);
  if not Succeed then
    raise ESockError.Create(sPSk_Cons_err_data_conn);
  Asize := SizeOf(ASocKAddr); {Size of Socket address structure}

  {Accept socket}
{$IFDEF NMF3}
  SockHandle := Winsock.Accept(ThisSocket, @ASocKAddr, @Asize);
{$ELSE}
  //SockHandle := Winsock.Accept(ThisSocket, ASocKAddr, Asize);
{$ENDIF}
  Result := SockHandle; {Make the Accepte socket This Socket}
  WSAAsyncselect(SockHandle, FSocketWindow, WM_ASYNCHRONOUSPROCESS, FD_ALL); {To direct messages to clientsocket}
  RemoteAddress := ASocKAddr; {save remote host address info}

  if Canceled then
  begin
    Canceled := False;
    raise EAbortError.Create(sPSk_Cons_msg_send_a);
    if Assigned(OnAbortrestart) then
      OnAbortrestart(self);
  end;
end;

{*******************************************************************************************
Return Error Message Corresponding To Error number
********************************************************************************************}

function TPowersock.SocketErrorStr(Errno: Word): string;
var
  x: Integer;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_elookup + Result); {Status message}
  Result := '';
  if Errno <> 0 then
  begin
    for x := 0 to 50 do {Get error string}
      if WinsockMessage[x].ErrorCode = Errno then
        Result := IntToStr(WinsockMessage[x].ErrorCode) + ':' + WinsockMessage[x].Text;
    if Result = '' then {If not found say unknown error}
      Result := sPSk_Cons_msg_unknown + IntToStr(Errno);
  end;
end;

procedure TPowersock.CloseAfterData;
var
  gudtLinger: Tlinger;
begin
  gudtLinger.l_onoff := 0;
  gudtLinger.l_linger := 0;
  setsockopt(ThisSocket, SOL_SOCKET, SO_LINGER, @gudtLinger, 4);
end;

procedure TPowersock.CloseImmediate;
var
  gudtLinger: Tlinger;
begin
  gudtLinger.l_onoff := 0;
  gudtLinger.l_linger := 0;
  setsockopt(ThisSocket, SOL_SOCKET, SO_DONTLINGER, @gudtLinger, 4);
end;
{*******************************************************************************************
TimeOut Handler
********************************************************************************************}

procedure TPowersock.TimerFired(Sender: TObject);
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_ttrig); {Status Message}
  TimerOff; {Switch off timer}
  TimedOut := True; {Set timed out flag}
  WaitSignal.SetEvent;
  Abort;
end;

{*******************************************************************************************
Set Timer On
********************************************************************************************}

procedure TPowersock.TimerOn;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_TimerOn); {Status Message}
  TimedOut := False; {Timed out flag reset}
  Timer.Enabled := False; {Enable timer}
  Timer.Interval := FTimeOut; {Set TimeOut Interval}
  Timer.Enabled := True; {Enable timer}
end;

{*******************************************************************************************
Set Timer Off
********************************************************************************************}

procedure TPowersock.TimerOff;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_TimerOff); {Status Message}
  Timer.Enabled := False; {Disable timer}
end;

{*******************************************************************************************
Initialize WinSock
********************************************************************************************}

procedure TPowersock.InitWinsock;
var
  gudtLinger: Tlinger;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_InitSock); {Status Message}
  {Startup Winsock}
  if (not (csDesigning in ComponentState)) and SockAvailable then
  try
    ThisSocket := Socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
    gudtLinger.l_onoff := 0;
    gudtLinger.l_linger := 0;
{$T-}
    setsockopt(ThisSocket, SO_DONTLINGER, SO_LINGER, @gudtLinger, 4);
{$T+}
    if ThisSocket = TSocket(INVALID_SOCKET) then
      ErrorManager(WSAEWOULDBLOCK); {If error handle error}
    WSAAsyncselect(ThisSocket, FSocketWindow, WM_ASYNCHRONOUSPROCESS, FD_ALL);
  except
    raise ESockError.Create(sPSk_Cons_err_werr);
  end;
end;

{*******************************************************************************************
Socket Windows Message handler
********************************************************************************************}

procedure TPowersock.Wndproc(var message: TMessage);
begin
  try
    with message do
    begin
      if LParamHi > 0 then
        Succeed := False {Succeed flag not set}
      else
        Succeed := True;

      case Msg of
        WM_ASYNCHRONOUSPROCESS:
          case LParamLo of

            FD_CONNECT:
              if Succeed then
              begin
                    // If any data has come in, it should be added to the incoming data queue now.
                FConnected := True;
                WaitSignal.SetEvent;
                if Assigned(FOnConnect) then
                  FOnConnect(self);
              end;

            FD_CLOSE:
              begin
                try
                  if FConnected then
                  begin
                    ClearInput;
                    RequestCloseSocket;
                  end;
                except
                end;
                WaitSignal.SetEvent;
                if Assigned(FOnDisconnect) then
                  FOnDisconnect(self);
              end;

            FD_READ:
              try
                ReadToBuffer;
                if Assigned(FOnReadEvent) then
                  FOnReadEvent(self)
              except
              end;

            FD_ACCEPT:
              begin
                FConnected := True;
                WaitSignal.SetEvent;
                if Assigned(FOnAcceptEvent) then
                  FOnAcceptEvent(self);
              end;
          end;

        WM_WAITFORRESPONSE:
          begin
            Wait_Flag := True;
            WaitSignal.SetEvent;

            if LParamLo = FD_ACCEPT then
            begin
              FConnected := True;
              if not (csDestroying in ComponentState) then
                if Assigned(FOnConnect) then
                  FOnConnect(self);
            end;
          end;
      end;
    end;
  except
  end;
end;

procedure TPowersock.ReadToBuffer;
var
  rc: Integer;
begin
  repeat
    rc := recv(ThisSocket, Buf, MAX_RECV_BUF, 0);
    if rc = 0 then
      RequestCloseSocket;

    if rc > 0 then
      FifoQ.Append(Pointer(@Buf), rc);
    WaitSignal.SetEvent;
  until rc < MAX_RECV_BUF;
end;

{*******************************************************************************************
Request Socket to be closed
********************************************************************************************}

procedure TPowersock.RequestCloseSocket;
begin
  StatusMessage(Status_Routines, sPSk_Cons_msg_RCloseSock); {Report status}
  FConnected := False;
  if ThisSocket <> TSocket(INVALID_SOCKET) then
  begin
      {Close it}
    Winsock.CloseSocket(ThisSocket);
    if not (csDestroying in ComponentState) then
      if Assigned(FOnDisconnect) then
        FOnDisconnect(self);
    if not DestroySocket then
    begin
      ThisSocket := Socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
      WSAAsyncselect(ThisSocket, FSocketWindow, WM_ASYNCHRONOUSPROCESS, FD_OOB or FD_ACCEPT or FD_CONNECT or FD_CLOSE or FD_READ);
    end
  end;
end;

{*******************************************************************************************
Get The last error
********************************************************************************************}

function TPowersock.GetLastErrorNo: Integer;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_getLastE); {Report Status}
  Result := FLastErrorno; {Get Last error to result}
end;

{*******************************************************************************************
Set The Last Error
********************************************************************************************}

procedure TPowersock.SetLastErrorNo(Value: Integer);
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_setLastE); {Report status}
  FLastErrorno := Value; {Set Last error to value}
end;

{*******************************************************************************************
Handle Power socket error
********************************************************************************************}

function TPowersock.ErrorManager(Ignore: Word): string;
var
  slasterror: string;
begin
  FLastErrorno := wsagetlasterror; {Set last error}
  if FLastErrorno <> Ignore then
    if (FLastErrorno > 10000) then
    begin
      slasterror := SocketErrorStr(FLastErrorno); {Get the description string for error}
      if Assigned(FOnErrorEvent) then {If error handler present excecute it}
        FOnErrorEvent(self, FLastErrorno, slasterror);
      raise ESockError.Create(slasterror); {raise exception}
    end;
  Result := slasterror; {return error string}
end;

{*******************************************************************************************
Set Powersock error
********************************************************************************************}

procedure TPowersock.SetWSAError(ErrorNo: Word; ErrorMsg: string);
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_SetSockE); {Report status}
  FLastErrorno := ErrorNo; {Set Last error to error}
  if Length(ErrorMsg) = 0 then
    SocketErrorStr(ErrorNo); {If error message not there set it to error no}
  WSASetLastError(ErrorNo); {Set Socket error to error no}
  if Assigned(FOnErrorEvent) then {If error handler present excecute it}
    FOnErrorEvent(self, FLastErrorno, ErrorMsg);
end;

{*******************************************************************************************
Output a Status message: depends on current Reporting Level
********************************************************************************************}

procedure TPowersock.StatusMessage(Level: Byte; Value: string);
begin
  try
    if Level <= ReportLevel then
    begin
      _Status := Value; {Set status to vale of error}
      if not (csDestroying in ComponentState) then
        if Assigned(FOnStatus) then
          FOnStatus(self, _Status); {If Status handler present excecute it}
    end;
  except
  end;
end;

function TPowersock.DataAvailable: Boolean;
var
  rc: Integer;
  mc: Char;
begin
  Result := FifoQ.BufferSize > 0;
  if not Result then
  begin
    rc := recv(ThisSocket, mc, 1, MSG_PEEK);
    if rc > 0 then
    begin
      Result := True;
      ReadToBuffer;
    end
    else if rc = 0 then
    begin
      Result := True;
      try
        if FConnected then
        begin
          ClearInput;
          RequestCloseSocket;
        end;
      except
      end;
      WaitSignal.SetEvent;
      if Assigned(FOnDisconnect) then
        FOnDisconnect(self);
    end;
  end;
end;

procedure TPowersock.ClearInput;
var
  Buf: array[0..MAX_RECV_BUF] of Char;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_ClearInput); {Inform status}
  recv(ThisSocket, Buf, MAX_RECV_BUF, 0);
end;

{*******************************************************************************************
Resolve IP Address of Remote Host
********************************************************************************************}

procedure TPowersock.ResolveRemoteHost;
begin
  StatusMessage(Status_Debug, sPSk_Cons_msg_ResolvHos); {Inform status}

  if FProxy = '' then
    RemoteAddress.sin_addr.S_addr := Inet_Addr(StrPCopy(Buf, ServerName))
  else
    {else use Host address}
    RemoteAddress.sin_addr.S_addr := Inet_Addr(StrPCopy(Buf, FProxy));

  if RemoteAddress.sin_addr.S_addr = SOCKET_ERROR then
    {If given name not an IP address already}
  begin
    RemoteAddress.sin_addr.S_addr := 0;
    TimerOn; {Enable Timer}
    Wait_Flag := False; {Reset flag indicating wait over}

      {Resolve IP address}
    wsaasyncgethostbyname(FSocketWindow, WM_WAITFORRESPONSE, Buf, PChar(RemoteHost), MAXGETHOSTSTRUCT);

    repeat
      Wait;
    until Wait_Flag or TimedOut or Canceled; {Till host name resolved, Timed out or Cancelled}

    TimerOff; {Disable timer}

      {Handle errors}
    if TimedOut then
      raise ESockError.Create(sPSk_Cons_msg_host_to);

    if Canceled then
      raise ESockError.Create(sPSk_Cons_msg_host_Can);

    if Succeed = False then
      raise ESockError.Create(sPSk_Cons_msg_host_Fail);

      {Fill up remote host information with retreived results}
    with RemoteAddress.sin_addr.S_un_b do
    begin
      s_b1 := RemoteHost.h_addr_list^[0];
      s_b2 := RemoteHost.h_addr_list^[1];
      s_b3 := RemoteHost.h_addr_list^[2];
      s_b4 := RemoteHost.h_addr_list^[3];
    end;