rtcmsgcliprov.pas

Delphi快速开发Web Server

            begin
            ClearResponse;

            Response.Receiving:=True;
            Response.Started:=True;

            FHaveResponse:=True;
            FResponseLine:=True;
            LenToRead:=-1; // Unlimited length (streaming data until disconnected)

            Continue;
            end;

          MyPos:=Pos(CRLF,InBuffer);
          if (MaxResponseSize>0) and
             ( (MyPos>MaxResponseSize+1) or
               ((MyPos<=0) and (length(InBuffer)>MaxResponseSize+length(CRLF))) ) then
            begin
            ClearResponse;

            ResponseError;
            Exit;
            end
          else if (MyPos>0) then
            begin
            ClearResponse;

            StatusLine:=Copy(InBuffer,1,MyPos-1);
            Delete(InBuffer,1,MyPos+length(CRLF)-1);

            if CompareText(Copy(StatusLine,1,5),'HTTP/')<>0 then
              begin
              ResponseError;
              Exit;
              end;

            Response.Receiving:=True;
            Response.Started:=True;

            { Our line probably looks like this:
              HTTP/1.1 200 OK }
            MyPos:=Pos(' ',StatusLine); // first space before StatusCode
            if MyPos<=0 then
              begin
              ResponseError;
              Exit;
              end;
            Delete(StatusLine,1,MyPos); // remove 'HTTP/1.1 '

            MyPos:=Pos(' ',StatusLine); // space after StatusCode
            if MyPos<=0 then
              begin
              ResponseError;
              Exit;
              end;

            s:=Copy(StatusLine,1,MyPos-1); // StatusCode
            Delete(StatusLine,1,MyPos); // StatusText

            if (s<>'') and (StatusLine<>'') then
              begin
              try
                Response.StatusCode:=StrToInt(s);
                Response.StatusText:=StatusLine;
              except
                // if there is something wrong with this, just ignore the exception
                end;
              end;

            FResponseLine:=True;
            end;
          end;

        if FResponseLine then
          begin
          // See if we can get the whole header ...
          HeadLen:=Pos(CRLF, InBuffer);
          if HeadLen<>1 then
            HeadLen:=Pos(END_MARK, InBuffer);

          if HeadLen=1 then
            begin
            // Delete CRLF from the body
            Delete(InBuffer,1,2);

            if Response.StatusCode=100 then
              begin // special handling of the "100:Continuing" Http status code
              FResponseLine:=False;
              Continue;
              end;

            // No Header: disconnect closes the response.
            Request.Close:=True;

            if Request.Method='HEAD' then
              begin
              FChunked:=False;
              LenToRead:=0;
              end;

            FHaveResponse:=True;
            end
          else if (MaxHeaderSize>0) and
             ( (HeadLen>MaxHeaderSize) or
               ((HeadLen<=0) and (length(InBuffer)>MaxHeaderSize+length(END_MARK))) ) then
            begin
            ResponseError;
            Exit;
            end
          else if HeadLen>0 then
            begin
            // Separate header from the body
            HeadStr:=Copy(InBuffer, 1, HeadLen+length(END_MARK)-1);
            Delete(InBuffer,1,HeadLen+length(END_MARK)-1);

            FHaveResponse:=True;

            // Scan for all header attributes ...
            MyPos:=Pos(CRLF, HeadStr);
            while (MyPos>1) do // at least 1 character inside line
              begin
              StatusLine:=Copy(HeadStr,1,MyPos-1);
              Delete(HeadStr,1,MyPos+Length(CRLF)-1);

              MyPos:=Pos(':',StatusLine);
              if MyPos>0 then
                begin
                s:=Trim(Copy(StatusLine,1,MyPos-1));
                Delete(StatusLine,1,MyPos);
                StatusLine:=Trim(StatusLine);

                if CompareText(s,'TRANSFER-ENCODING')=0 then
                  begin
                  if UpperCase(StatusLine)='CHUNKED' then
                    begin
                    FChunked:=True;
                    FChunkState:=0;
                    end;
                  end
                else if CompareText(s,'CONTENT-LENGTH')=0 then
                  begin
                  LenToRead:=StrToInt64Def(StatusLine,0);

                  Response.ContentLength:=LenToRead;
                  end
                else if CompareText(s,'CONNECTION')=0 then
                  begin
                  if Trim(Uppercase(StatusLine))='CLOSE' then
                    Request.Close:=True
                  else if Trim(Uppercase(StatusLine))='KEEP-ALIVE' then
                    Request.Close:=False;
                  end;

                Response[s]:=StatusLine;
                end;

              MyPos:=Pos(CRLF, HeadStr);
              end;

            if LenToRead=-1 then
              Request.Close:=True;

            if Request.Method='HEAD' then
              begin
              FChunked:=False;
              LenToRead:=0;
              end;

            StatusLine:='';
            HeadStr:='';
            end;
          end;
        end;

      if FHaveResponse then // Processing a response ...
        begin
        if FChunked then // Read data as chunks
          begin
          if (FChunkState=0) and (InBuffer<>'') then // 1.step = read chunk size
            begin
            MyPos:=Pos(CRLF,InBuffer);
            if MyPos>0 then
              begin
              StatusLine:=Trim(Copy(InBuffer,1,MyPos-1));
              Delete(InBuffer,1,MyPos+1);

              LenToRead:=HexToInt(StatusLine);

              FChunkState:=1; // ready to read data
              end;
            end;

          if (FChunkState=1) and (InBuffer<>'') then // 2.step = read chunk data
            begin
            if (LenToRead>length(InBuffer)) then // need more than we have
              begin
              Response.ContentIn:=Response.ContentIn+length(InBuffer);

              if LenToRead>0 then
                Dec(LenToRead, length(InBuffer));

              FResponseBuffer.Add(InBuffer);
              InBuffer:='';

              inherited TriggerDataReceived;

              Response.Started:=False;
              end
            else
              begin
              if LenToRead>0 then
                begin
                Response.ContentIn:=Response.ContentIn+LenToRead;

                FResponseBuffer.Add(Copy(InBuffer,1,LenToRead));

                Delete(InBuffer,1,LenToRead);
                LenToRead:=0;
                FChunkState:=2; // this is not the last chunk, ready to read CRLF
                end
              else
                FChunkState:=3; // this was last chunk, ready to read CRLF
              end;
            end;

          if (FChunkState>=2) and (length(InBuffer)>=2) then // 3.step = close chunk
            begin
            LenToRead:=-1;
            Delete(InBuffer,1,2); // Delete CRLF

            if FChunkState=2 then
              begin
              FChunkState:=0;
              end
            else
              begin
              Response.Done:=True;
              Request.Active:=False;
              FHaveResponse:=False; // get ready for next request
              FChunked:=False;
              FChunkState:=0;
              FResponseLine:=False;
              FHeaderOut:=False;

              FDone:=True;
              end;

            inherited TriggerDataReceived;

            Response.Started:=False;
            end;
          end
        else // Read data as stream or with predefined length
          begin
          if (LenToRead>0) or (LenToRead=-1) then
            begin
            if (LenToRead>length(InBuffer)) or
               (LenToRead=-1) then // need more than we have
              begin
              Response.ContentIn:=Response.ContentIn+length(InBuffer);

              if LenToRead>0 then
                Dec(LenToRead, length(InBuffer));

              FResponseBuffer.Add(InBuffer);

              InBuffer:='';
              end
            else
              begin
              Response.ContentIn:=Response.ContentIn+LenToRead;

              FResponseBuffer.Add(Copy(InBuffer,1,LenToRead));

              Delete(InBuffer,1,LenToRead);

              LenToRead:=0;
              Response.Done:=True;
              Request.Active:=False;
              FHaveResponse:=False; // get ready for next request
              FChunked:=False;
              FResponseLine:=False;
              FHeaderOut:=False;

              FDone:=True;
              end;
            end
          else
            begin
            Response.Done:=True;
            Request.Active:=False;
            FHaveResponse:=False; // get ready for next request
            FChunked:=False;
            FResponseLine:=False;
            FHeaderOut:=False;

            FDone:=True;
            end;

          inherited TriggerDataReceived;

          Response.Started:=False;
          end;
        end
      else
        Break; // Failing to fetch a header will break the loop.

      until (InBuffer='') or FDone;
    end;

  begin
  if not _Active then Exit;

  if not assigned(FServer) then
    raise RtcMsgCliException.Create('Error! Server component removed!');

  FServer.ProcessMessage(RequestStream, ResponseStream);

  FResponseBuffer.Clear;

  FChunked:=False;
  FChunkState:=0;

  FHaveResponse:=False;
  FResponseLine:=False;
  LenToRead:=0;

  RequestStream.Clear;
  ResponseStream.Position:=0;

  try
    while (ResponseStream.Position<ResponseStream.Size) and not Response.Done do
      begin
      len:=ResponseStream.Size-ResponseStream.Position;
      if len>32000 then len:=32000;

      SetLength(s,len);
      len2:=ResponseStream.Read(s[1],len);

      FDataIn:=len;
      TriggerDataIn;

      ProcessData(s);
      if len2<len then Break;
      end;
  finally
    ResponseStream.Clear;
    if _Active and not Request.Active then
      FResponseBuffer.Clear;
    end;
  end;

function TRtcMsgClientProvider._Active: boolean;
  begin
  Result:=not Closing and (FState in [conActive,conActivating]);
  end;

procedure TRtcMsgClientProvider.Release;
  begin
  if assigned(Client_Thread) then
    TRtcThread.PostJob(Client_Thread, Message_WSRelease, True)
  else
    inherited;
  end;

{ TRtcMsgClientThread }

constructor TRtcMsgClientThread.Create;
  begin
  inherited;
  RtcConn:=nil;
  end;

procedure TRtcMsgClientThread.OpenConn;
  begin
  RtcConn.OpenConnection;
  end;

procedure TRtcMsgClientThread.CloseConn(_lost:boolean);
  begin
  if assigned(RtcConn) then
    begin
    try
      RtcConn.Lost:=_lost;
      RtcConn.InternalDisconnect;
    except
      on E:Exception do
        if LOG_MSGCLI_EXCEPTIONS then
          Log('MsgClientThread.CloseConn : RtConn.InternalDisconnect',E);
        // ignore exceptions
      end;
    end;
  end;

destructor TRtcMsgClientThread.Destroy;
  begin
  CloseConn(false);
  if assigned(RtcConn) then
    begin
    try
      if Releasing then
        RtcConn.Free
      else if assigned(RtcConn.Client_Thread) then
        RtcConn.Client_Thread:=nil;
    finally
      RtcConn:=nil;
      end;
    end;
  inherited;
  end;

function TRtcMsgClientThread.Work(Job: TObject):boolean;
  begin
  Result:=False;
  try
    if Job=Message_WSOpenConn then
      OpenConn
    else if Job=Message_WSCloseConn then
      CloseConn(false)
    else if Job=Message_WSStop then
      begin
      RtcConn:=nil;
      Result:=True;

      Free;
      end
    else if Job=Message_WSRelease then
      begin
      Releasing:=True;
      Result:=True;

      Free;
      end
    else
      Result:=inherited Work(Job);
  except
    on E:Exception do
      begin
      if LOG_MSGCLI_EXCEPTIONS then
        Log('MsgClientThread.Work',E);
      CloseConn(true);
      // raise;
      end;
    end;
  end;

type
  TMyMsgCli=class
    public
    constructor Create;
    destructor Destroy; override;
    end;

var
  MyMsgCli:TMyMsgCli;

{ TMyWinInet }

constructor TMyMsgCli.Create;
  begin
  inherited;
  Message_WSOpenConn:=TRtcBaseMessage.Create;
  Message_WSCloseConn:=TRtcBaseMessage.Create;
  Message_WSStop:=TRtcBaseMessage.Create;
  Message_WSRelease:=TRtcBaseMessage.Create;
  end;

destructor TMyMsgCli.Destroy;
  begin
  Message_WSOpenConn.Free;
  Message_WSCloseConn.Free;
  Message_WSStop.Free;
  Message_WSRelease.Free;
  inherited;
  end;

initialization
MyMsgCli:=TMyMsgCli.Create;
finalization
Garbage(MyMsgCli);
end.