rtcwsockhttpcliprov.pas

Delphi快速开发Web Server

        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);

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

            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 CompareText(StatusLine,'CHUNKED')=0 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:='';

              Leave;
              try
                inherited TriggerDataReceived;
              finally
                Enter;
                end;
              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;

              ReqComplete:=False; // DataReceived events have to wait until a new request has been sent out
              end;

            Leave;
            try
              inherited TriggerDataReceived;
            finally
              Enter;
              end;
            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;

              ReqComplete:=False; // DataReceived events have to wait until a new request has been sent out
              end;
            end
          else
            begin
            Response.Done:=True;
            Request.Active:=False;
            FHaveResponse:=False; // get ready for next request
            FChunked:=False;
            FResponseLine:=False;
            FHeaderOut:=False;

            ReqComplete:=False; // DataReceived events have to wait until a new request has been sent out
            end;

          Leave;
          try
            inherited TriggerDataReceived;
          finally
            Enter;
            end;
          Response.Started:=False;
          end;
        end
      else
        Break; // Failing to fetch a header will break the loop.

      until (InBuffer='') or not ReqComplete;

  finally
    Leave;
    end;
  end;

procedure TRtcWSockHttpClientProvider.WriteHeader(SendNow:boolean=True);
  var
    s:string;
  begin
  if FHeaderOut then
    raise Exception.Create('Last header intercepted with new header, before data sent out.');

  s:=Request.Method+' '+Request.URI+' HTTP/1.1'+CRLF+
     Request.HeaderText;

  if Request.Close then s:=s+'Connection: close'+CRLF;

  s:=s+CRLF;

  Request.Started:=True;
  Request.Active:=True;

  LenToWrite:=Request.ContentLength;
  LenToSend:=length(s) + Request.ContentLength;

  FHeaderOut:=True;
  inherited Write(s, SendNow or (LenToWrite<=0));
  end;

procedure TRtcWSockHttpClientProvider.WriteHeader(const Header_Text:string; SendNow:boolean=True);
  var
    s:string;
  begin
  if FHeaderOut then
    raise Exception.Create('Last header intercepted with new header, before data sent out.');

  if Header_Text<>'' then
    Request.HeaderText:=Header_Text;

  s:=Request.Method+' '+Request.URI+' HTTP/1.1'+CRLF +
     Request.HeaderText;

  if Request.Close then s:=s+'Connection: close'+CRLF;

  s:=s+CRLF;

  Request.Started:=True;
  Request.Active:=True;

  LenToWrite:=Request.ContentLength;
  LenToSend:=length(s) + Request.ContentLength;

  FHeaderOut:=True;
  inherited Write(s, SendNow or (LenToWrite<=0));
  end;

procedure TRtcWSockHttpClientProvider.Write(const ResultData: string; SendNow:boolean=True);
  begin
  if length(ResultData)=0 then Exit;

  if not FHeaderOut then
    raise Exception.Create('Trying to send Data without Header. Call WriteHeader before Write.');

  if length(ResultData)>LenToWrite then
    raise Exception.Create('Trying to send more Data out than specified in Header.');

  Dec(LenToWrite, length(ResultData));

  Request.ContentOut:=Request.ContentOut + length(ResultData);

  inherited Write(ResultData, SendNow);
  end;

function TRtcWSockHttpClientProvider.Read: string;
  begin
  if FResponseBuffer.Size>0 then
    begin
    Result:=FResponseBuffer.Get;
    FResponseBuffer.Clear;
    end
  else
    Result:='';
  end;

procedure TRtcWSockHttpClientProvider.TriggerDataSent;
  begin
  if Request.Active then
    Request.Started:=False;

  inherited TriggerDataSent;

  if FResponseWaiting then
    if ReqComplete then
      TriggerDataReceived;
  end;

procedure TRtcWSockHttpClientProvider.TriggerDataOut;
  begin
  if not ReqComplete then
    if assigned(Request) and Request.Active then
      begin
      Dec(LenToSend, DataOut);
      ReqComplete := LenToSend<=0;
      Request.Complete := ReqComplete;
      end;

  inherited TriggerDataOut;
  end;

end.