rtcwsockhttpsrvprov.pas

Delphi快速开发Web Server

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

                if CompareText(s,'CONTENT-LENGTH')=0 then
                  begin
                  LenToRead:=StrToInt64Def(StatusLine,0);
                  Request.ContentLength:=LenToRead;
                  end
                else
                  Request[s]:=StatusLine;
                end;

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

            if CompareText(Request['CONNECTION'],'CLOSE')=0 then
              Request.Close:=True;

            if CompareText(Request['TRANSFER-ENCODING'],'CHUNKED')=0 then
              begin
              FChunked:=True;
              FChunkState:=0;
              end
            else
              FChunked:=False;

            if CompareText(Copy(Request.ContentType,1,19),'MULTIPART/FORM-DATA')=0 then
              begin
              MyPos:=Pos('BOUNDARY=',UpperCase(Request.ContentType));
              if MyPos>0 then
                // Get MULTIPART Boundary (Params.Delimiter)
                begin
                Request.Params.Delimiter:=
                  Copy(Request.ContentType, MyPos+9, length(Request.ContentType)-MyPos-8);
                if (Copy(Request.Params.Delimiter,1,1)='"') and
                   (Copy(Request.Params.Delimiter,
                         length(Request.Params.Delimiter),1)='"') then
                  begin
                  Request.Params.Delimiter:=
                     Copy(Request.Params.Delimiter, 2, length(Request.Params.Delimiter)-2);
                  end;
                end;
              end;

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

      if FHaveRequest then // Processing a request ...
        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
              Request.ContentIn:=Request.ContentIn+length(InBuffer);

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

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

              Leave;
              try
                inherited TriggerDataReceived;
              finally
                Enter;
                end;
              Request.Started:=False;
              end
            else
              begin
              if LenToRead>0 then
                begin
                Request.ContentIn:=Request.ContentIn+LenToRead;

                FRequestBuffer.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 // not the last chunk
              begin
              FChunkState:=0; // will continue with next chunk
              end
            else
              begin
              Request.Complete:=True;
              FHaveRequest:=False; // get ready for next request
              FRequestLine:=False;
              end;

            Leave;
            try
              inherited TriggerDataReceived;
            finally
              Enter;
              end;
            Request.Started:=False;
            end;
          end
        else
          begin
          if LenToRead>0 then
            begin
            if LenToRead>length(InBuffer) then // need more than we have
              begin
              Request.ContentIn:=Request.ContentIn + length(InBuffer);

              FRequestBuffer.Add(InBuffer);

              Dec(LenToRead, length(InBuffer));

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

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

              Delete(InBuffer,1,LenToRead);

              LenToRead:=0;
              Request.Complete:=True;
              FHaveRequest:=False; // get ready for next request
              FRequestLine:=False;
              end;
            end
          else
            begin
            Request.Complete:=True;
            FHaveRequest:=False; // get ready for next request
            FRequestLine:=False;
            end;

          Leave;
          try
            inherited TriggerDataReceived;
            Request.Started:=False;
          finally
            Enter;
            end;
          end;

        if Request.Complete and not Response.Done then
          begin
          FRequestWaiting:=InBuffer<>'';
          Break; // need to wait for the request to be processed, before we can go to the next one.
          end;
        end
      else
        Break; // Failing to fetch a header will break the loop.
      end;

  finally
    Leave;
    end;
  end;

procedure TRtcWSockHttpServerProvider.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:='HTTP/1.1 '+IntToStr(Response.StatusCode)+' '+Response.StatusText+CRLF+
     Response.HeaderText;

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

  s:=s+CRLF;

  Response.Sending:=True;
  Response.Started:=True;

  if Response.SendContent and
    (Response['CONTENT-LENGTH']='')  then // streaming data
    begin
    LenToWrite:=-1;
    LenToSend:=-1;
    end
  else
    begin
    if not Response.SendContent then
      Response['CONTENT-LENGTH']:='';

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

  Response.Sent:=LenToWrite=0;

  if Response.Sent then
    TriggerLastWrite;

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

procedure TRtcWSockHttpServerProvider.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
    begin
    Response.HeaderText:=Header_Text;

    s:='HTTP/1.1 '+IntToStr(Response.StatusCode)+' '+Response.StatusText+CRLF+
       Response.HeaderText;

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

    s:=s+CRLF;
    end
  else
    begin
    s:='';
    Request.Close:=True;
    end;

  Response.Sending:=True;
  Response.Started:=True;

  if Response.SendContent and
    (Response['CONTENT-LENGTH']='')  then // streaming data
    begin
    LenToWrite:=-1;
    LenToSend:=-1;
    end
  else
    begin
    if not Response.SendContent then
      Response['CONTENT-LENGTH']:='';

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

  Response.Sent:=LenToWrite=0;

  if Response.Sent then
    TriggerLastWrite;

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

procedure TRtcWSockHttpServerProvider.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 LenToWrite>=0 then
    begin
    if length(ResultData)>LenToWrite then
      raise Exception.Create('Trying to send more Data out than specified in Header.');

    Dec(LenToWrite, length(ResultData));
    end;

  Response.Sent:=LenToWrite=0;
  Response.ContentOut:=Response.ContentOut + length(ResultData);

  if Response.Sent then
    TriggerLastWrite;

  inherited Write(ResultData,SendNow);
  end;

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

procedure TRtcWSockHttpServerProvider.TriggerDataSent;
  begin
  if Response.Sending then
    Response.Started:=False;

  inherited TriggerDataSent;

  if Response.Done then
    begin
    ClearRequest;
    if FRequestWaiting then
      TriggerDataReceived;
    end;
  end;

procedure TRtcWSockHttpServerProvider.TriggerDataOut;
  begin
  if Response.Sending then
    begin
    if LenToSend>=0 then
      begin
      Dec(LenToSend, DataOut);
      Response.Done := LenToSend=0;
      end;

    if Response.Done then
      begin
      Request.Started:=False;
      Request.Active:=False;
      Response.Started:=False;
      Response.Sending:=False;
      FHeaderOut:=False;
      end;
    end;

  inherited TriggerDataOut;
  end;

end.