wsocket_rtc.pas

Delphi快速开发Web Server

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TCustomWSocket.RealSend(Data : Pointer; Len : Integer) : Integer;
begin
  if FProtoType=SOCK_DGRAM then
    begin
    if (self is TWSocketServer) and (FSrcLen>0) then
      Result := _SendTo(FHSocket, Data^, Len, 0, TSockAddr(FSrc), FSrcLen)
    else
      Result := _SendTo(FHSocket, Data^, Len, 0, TSockAddr(sin), SizeOf(sin));
    end
  else
    Result := _Send(FHSocket, Data^, Len, 0);
  if Result>0 then
    TriggerDataOut(Result);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomWSocket.TryToSend;
  var
    oBuffer   : TBuffer;
    Len       : Integer;
    Count     : Integer;
    Data      : Pointer;
    WantClose : Boolean;
  begin
  if bAllSent or not FReadyToSend then
    Exit;

  if (FHSocket = INVALID_SOCKET) or                { No more socket      }
     (FBufList.Count = 0) then                     { Nothing to send     }
    Exit;

  repeat
    WantClose := False;

    repeat
      oBuffer := TBuffer(FBufList.First);
      Data    := oBuffer.Peek(Len);
      if Len <= 0 then
        begin
        { Buffer is empty }
        if FBufList.Count <= 1 then
          begin
          { Everything has been sent }
          bAllSent := TRUE;
          Break;
          end
        else
          begin
          oBuffer.Free;
          FBufList.removeFirst;
          end;
        end
      else
        begin
        FLastError:=0;

        {if Len>WSOCK_MAX_SEND_SIZE then
          Len:=WSOCK_MAX_SEND_SIZE;}

        Count := RealSend(Data, Len);

        if Count > 0 then
          begin
          Inc(FSentOut,Count);
          oBuffer.Remove(Count);
          if (Count<Len) then
            begin
            if LOG_SOCKET_ERRORS then
              Log('SEND ERROR! Count<Len. Socket '+IntToStr(FHSocket));
            FReadyToSend:=False;
            FSentFlag:=True;
            Break;
            {end
          else if (FSentOut>=BufSize*4) then // not all sent, will be posting a message to retry
            begin
            // Log('SEND '+IntToStr(FSentOut)+' bytes, buffer full. Socket '+IntToStr(FHSocket));
            Break;}
            end;
          end
        else if Count < 0 then
          begin
          FLastError:=WSAGetLastError;
          if FLastError=WSAEWOULDBLOCK then
            begin
            // Log('SEND '+IntToStr(FSentOut)+' bytes, now would block. Socket '+IntToStr(FHSocket));
            FReadyToSend:=False;
            FSentFlag:=True;
            end
          else if (FLastError<>WSAENOBUFS) and  // not BUFFER Full error
                  (FLastError<>WSABASEERR) then // not BASE Error (no error)
            begin
            // Log('SEND '+IntToStr(FSentOut)+' bytes, err '+IntToStr(FLastError)+' (need to close). Socket '+IntToStr(FHSocket));
            FReadyToSend:=False;
            WantClose:=True;
            end
          else if LOG_SOCKET_ERRORS then
            Log('SEND '+IntToStr(FSentOut)+' bytes, base error. Socket '+IntToStr(FHSocket));
          Break;
          end
        else
          begin
          if LOG_SOCKET_ERRORS then
            Log('SEND '+IntToStr(FSentOut)+' bytes, Count=0. Socket '+IntToStr(FHSocket));
          FLastError:=WSAECONNABORTED;
          FReadyToSend:=False;
          WantClose:=True;
          Break; { Closed by remote }
          end;
        end;
      until False;

    if WantClose then
      begin
      // Log('ABORT from TryToSend for Socket '+IntToStr(FHSocket)+'. Error #'+IntToStr(FLastError)+': '+WSocketErrorDesc(FLastError));
      FSentFlag:=True;
      // Close;
      // raise EWinSockException('Can not send. Error #'+IntToStr(FLastError)+': '+WSocketErrorDesc(FLastError));
      end
    else
      begin
      if bAllSent and not FSentFlag then
        FSentFlag:=PostMessage(Handle,
                               FMessageCode,
                               FHSocket,
                               FD_WRITE);
      end;
    until FSentFlag or bAllSent;
  end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomWSocket.PutDataInSendBuffer(Data : Pointer; Len : Integer);
  var
    oBuffer  : TBuffer;
    cWritten : Integer;
    bMore    : Boolean;
  begin
  if (Len <= 0) or (Data = nil) then
    exit;

  if FBufList.Count = 0 then
    begin
    oBuffer := TBuffer.Create(FBufSize);
    FBufList.addLast(longword(oBuffer));
    end
  else
    oBuffer := TBuffer(FBufList.Last);

  bMore := TRUE;
  while bMore do
    begin
    cWritten := oBuffer.Write(Data, Len);
    if cWritten >= Len then
      bMore := FALSE
    else
      begin
      Len  := Len - cWritten;
      Data := PChar(Data) + cWritten;
      if Len < 0 then
        bMore := FALSE
      else
        begin
        oBuffer := TBuffer.Create(FBufSize);
        FBufList.addLast(longword(oBuffer));
        end;
      end;
    end;
  end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Return -1 if error, else return number of byte written                    }
function TCustomWSocket.SendData(Data : Pointer; Len : Integer) : integer;
  begin
    if (FState <> wsConnected) and (FState <> wsSocksConnected) then
      begin
      FLastError:=WSAENOTCONN;
      SocketError('Send');
      Result := -1;
      Exit;
      end;

    if Len <= 0 then
      begin
      Result := 0;
      Exit;
      end;

    if Protocol=spTcp then
      begin
      bAllSent := FALSE;

      Result   := Len;
      PutDataInSendBuffer(Data, Len);

      TryToSend;
      end
    else
      begin
      Result:=RealSend(Data,Len);
      if Result=Len then
        PostMessage(Handle,
                    FMessageCode,
                    FHSocket,
                    FD_WRITE)
      else if Result<0 then
        FLastError:=WSAGetLastError;
      end;
  end;


function TCustomWSocket.ToBuff(Data : Pointer; Len : Integer) : integer;
  begin
    if (FState <> wsConnected) and (FState <> wsSocksConnected) then
      begin
      FLastError:=WSAENOTCONN;
      SocketError('Send');
      Result := -1;
      Exit;
      end;

    if Len <= 0 then
      begin
      Result := 0;
      Exit;
      end;

    if Protocol=spTcp then
      begin
      bAllSent := FALSE;

      Result   := Len;
      PutDataInSendBuffer(Data, Len);
      end
    else
      begin
      Result:=RealSend(Data,Len);
      if Result=Len then
        PostMessage(Handle,
                    FMessageCode,
                    FHSocket,
                    FD_WRITE)
      else if Result<0 then
        FLastError:=WSAGetLastError;
      end;
  end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Return -1 if error, else return number of byte written                    }
function TCustomWSocket.SendStr(const Str : String) : Integer;
begin
    if Length(Str) > 0 then
        Result := SendData(@Str[1], Length(Str))
    else
        Result := 0;
end;

function TCustomWSocket.BuffStr(const Str : String) : Integer;
begin
    if Length(Str) > 0 then
        Result := ToBuff(@Str[1], Length(Str))
    else
        Result := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomWSocket.ASyncReceive(Error: Word);
  var
    bMore    : Boolean;
    lCount   : LongWord;
    TrashCan : array [0..1023] of char;
  begin
  bMore := TRUE;
  while bMore do
    begin
    FLastError := 0;
    if not TriggerDataReceived(Error) then
      begin
      { Nothing wants to receive, we will receive and throw away  23/07/98 }
      if DoRecv(TrashCan, SizeOf(TrashCan), 0) = SOCKET_ERROR then
        begin
        FLastError := WSAGetLastError;
        if FLastError = WSAEWOULDBLOCK then
          begin
          FLastError := 0;
          Break;
          end;
        end;
      end;

    if FLastError <> 0 then
      begin
      bMore := FALSE;
      { -1 value is not a true error but is used to break the loop }
      if FLastError = -1 then
        FLastError := 0;
      end
    { Check if we have something new arrived, if yes, process it }
    else
      begin
      if _ioctlsocket(FHSocket, FIONREAD, lCount) = SOCKET_ERROR then
        begin
        FLastError := WSAGetLastError;
        bMore      := FALSE;
        end
      else if lCount = 0 then
        bMore := FALSE;
      end;
    end;
  end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomWSocket.Do_FD_CONNECT(Err:word);
  begin
  if FState <> wsConnected then
    begin
    ChangeState(wsConnected);
    if (Err <> 0) and (FState <> wsClosed) then
      Close;
    end;
  end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomWSocket.Do_FD_READ;
  var
    cnt:integer;
    soc:TSocket;
  begin
  if FState <> wsConnected then
    ChangeState(wsConnected);

  soc:=FHSocket;

  FRcvdFlag:=False;
  TriggerDataReceived(0);

  if rtcCheckSocket(soc)<>Self then
    Exit; // connection destroyed from DataReceived

  if FRcvdFlag and (Protocol=spTcp) then
    begin
    cnt:=0;
    while FHSocket<>INVALID_SOCKET do
      begin
      Inc(cnt);
      if cnt<10 then
        begin
        FRcvdFlag:=False;
        TriggerDataReceived(0);

        if rtcCheckSocket(soc)<>Self then
          Exit; // connection destroyed from DataReceived

        if not FRcvdFlag then Break;
        end
      else
        begin
        if GetRcvdCount>0 then
          begin
          if PostMessage(Handle,FMessageCode,
                         FHSocket,FD_READ) then // can post message?
            Break
          else
            cnt:=0;
          end
        else
          Break;
        end;
      end;
    end;
  end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomWSocket.Do_FD_WRITE;
  begin
  FReadyToSend:=True;
  FSentFlag:=False;
  FSentOut:=0;

  if FState <> wsConnected then
    ChangeState(wsConnected);

  if bAllSent then
    TriggerDataSent(0)
  else
    TryToSend;
  end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomWSocket.Do_FD_CLOSE(Err:word);
begin
  if FState <> wsConnecting then
    begin
    if (Err =