rtcfileprovider.pas

来自「Delphi快速开发Web Server」· PAS 代码 · 共 740 行 · 第 1/2 页

          Result:='';
          Exit;
          end;

      if Copy(FileName,length(FileName),1)='\' then
        begin
        for a:=0 to PageList.Count-1 do
          begin
          fsize:=File_Size(FullName+PageList.Strings[a]);
          if fsize>=0 then
            begin
            FileName:=FileName+PageList.Strings[a];
            Break;
            end;
          end;
        end
      else
        fsize:=File_Size(FullName);

      Result:=StringReplace(FileName,'\','/',[rfreplaceall]);
      end;

    procedure ParseRange(s:string; var r_type, r_from, r_to:string);
      var
        a:integer;
      begin
      r_type:=''; r_from:=''; r_to:='';

      a:=pos('=',s);
      if a>0 then
        begin
        r_type:=UpperCase(Trim(Copy(s,1,a-1)));
        Delete(s,1,a);

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

          a:=Pos(',',s);
          if a>0 then
            r_to:=Trim(Copy(s,1,a-1))
          else
            r_to:=Trim(s);
          end
        else
          begin
          a:=Pos(',',s);
          if a>0 then
            r_from:=Trim(Copy(s,1,a-1))
          else
            r_from:=Trim(s);
          end;
        end;
      end;

    begin
    with Sender do
      begin
      // Check HOST and find document root
      DocRoot:=GetDocRoot(Request.Host);
      if DocRoot='' then
        begin
        Sender.Accept;

        XLog('BAD! '+Sender.PeerAddr+' > '+Sender.Request.Host+
             ' "'+Sender.Request.Method+' '+Sender.Request.URI+'"'+
             ' 0'+
             ' REF "'+Sender.Request.Referer+'"'+
             ' AGENT "'+Sender.Request.Agent+'" > Invalid Host: "'+Request.Host+'".');

        Response.Status(400,'Bad Request');
        Write('Status 400: Bad Request');

        Exit;
        end;

      // Check File Name and send Result Header
      MyFileName := RepairFileName(Request.FileName);
      if MyFileName<>'' then
        begin
        if fsize>0 then
          begin
          Accept; // found the file, we will be responding to this request.

          // Check if we have some info about the content type for this file ...
          Content_Type:=GetContentType(MyFileName);

          Request.Info.asString['fname']:=StringReplace(MyFileName,'/','\',[rfReplaceAll]);
          Request.Info.asString['root']:=DocRoot;
          Request.Info.asLargeInt['$time']:=GetTickCount;
          Request.Info.asLargeInt['from']:=0;

          Response.ContentType:=Content_Type;
          Response.ContentLength:=fsize;

          if Request.Method='HEAD' then
            Response.SendContent:=False
          else if Request.Method='GET' then
            begin
            if Request['RANGE']<>'' then
              begin
              ParseRange(Trim(Request['RANGE']), rang_type, rang_from, rang_to);
              if rang_type='BYTES' then // we will support a single bytes range
                begin
                if rang_from<>'' then
                  begin
                  rang_end:=fsize-1;

                  rang_start:=StrToInt64Def(rang_from, 0);

                  if rang_to<>'' then
                    rang_end:=StrToInt64Def(rang_to, fsize-1);

                  if rang_start<=rang_end then
                    begin
                    if rang_end>=fsize then
                      rang_end:=fsize-1;

                    rang_from:=IntToStr(rang_start);
                    rang_to:=IntToStr(rang_end);

                    Request.Info.asLargeInt['from']:=rang_start;

                    Response.ContentLength:=rang_end-rang_start+1;
                    Response.Status(206,'Partial Content');
                    Response['Content-Range']:='bytes '+rang_from+'-'+rang_to+'/'+IntToStr(fsize);
                    end
                  else
                    begin
                    Response.Status(416,'Request range not satisfiable');
                    Request.ContentLength:=0;
                    end;
                  end
                else
                  begin
                  rang_end:=-1;

                  if rang_to<>'' then
                    rang_end:=StrToInt64Def(rang_to,-1);

                  if rang_end>0 then
                    begin
                    if rang_end>fsize then
                      rang_end:=fsize;

                    rang_start:=fsize-rang_end;
                    rang_end:=fsize-1;

                    if rang_to>=rang_from then
                      begin
                      rang_from:=IntToStr(rang_start);
                      rang_to:=IntToStr(rang_end);

                      Request.Info.asLargeInt['from']:=rang_start;

                      Response.ContentLength:=rang_end-rang_start+1;
                      Response.Status(206,'Partial Content');
                      Response['CONTENT-RANGE']:='bytes '+rang_from+'-'+rang_to+'/'+IntToStr(fsize);
                      end
                    else
                      begin
                      Response.Status(416,'Request range not satisfiable');
                      Response.ContentLength:=0;
                      end;
                    end;
                  end;
                end;
              end;
            end;

          if Sender.Request['RANGE']<>'' then
            XLog('PART '+PeerAddr+' > '+Request.Host+
                 ' "'+Request.Method+' '+Request.URI+'"'+
                 ' '+IntToStr(fsize)+
                 ' RANGE "'+Request['RANGE']+'"'+
                 ' ('+Response['CONTENT-RANGE']+')'+
                 ' REF "'+Request.Referer+'"'+
                 ' AGENT "'+Request.Agent+'"'+
                 ' TYPE "'+Content_Type+'"')
          else
            XLog('SEND '+PeerAddr+' > '+Request.Host+
                 ' "'+Request.Method+' '+Request.URI+'"'+
                 ' '+IntToStr(fsize)+
                 ' REF "'+Request.Referer+'"'+
                 ' AGENT "'+Request.Agent+'"'+
                 ' TYPE "'+Content_Type+'"');

          {$IFDEF RTC_FILESTREAM}
          if Response.ContentLength>0 then
            begin
            Request.Info.Obj['file']:=TRtcFileStream.Create;
            with TRtcFileStream(Request.Info.Obj['file']) do
              begin
              Open(DocRoot+Request.Info.asString['fname']);
              Seek(Request.Info.asLargeInt['from']);
              end;
            end;
          {$ENDIF}
          
          Write;
          end
        else if fsize=0 then
          begin
          // Found the file, but it is empty.
          Accept;

          XLog('SEND '+Sender.PeerAddr+' > '+Sender.Request.Host+
               ' "'+Sender.Request.Method+' '+Sender.Request.URI+'"'+
               ' 0'+
               ' REF "'+Sender.Request.Referer+'"'+
               ' AGENT "'+Sender.Request.Agent+'"');

          Write;
          end
        else
          begin
          // File not found.
          Accept;

          XLog('FAIL '+Sender.PeerAddr+' > '+Sender.Request.Host+
               ' "'+Sender.Request.Method+' '+Sender.Request.URI+'"'+
               ' 0'+
               ' REF "'+Sender.Request.Referer+'"'+
               ' AGENT "'+Sender.Request.Agent+'" > File not found: "'+MyFileName+'".');

          Response.Status(404,'File not found');
          Write('Status 404: File not found');
          end;
        end;
      end;
    end;

  begin
  with TRtcDataServer(Sender).Request do
    if (Method='GET') or (Method='HEAD') then
      CheckDiskFile(TRtcDataServer(Sender));
  end;

procedure TFile_Provider.FileProviderSendBody(Sender: TRtcConnection);
  var
    DocRoot,s:string;
  begin
  with TRtcDataServer(Sender) do
    begin
    if Request.Complete then
      begin
      if Response.DataOut<Response.DataSize then // need to send more content
        begin
        {$IFDEF RTC_FILESTREAM}
        if Response.DataSize-Response.DataOut>MAX_SEND_BLOCK_SIZE then
          s:=TRtcFileStream(Request.Info.Obj['file']).Read(MAX_SEND_BLOCK_SIZE)
        else
          s:=TRtcFileStream(Request.Info.Obj['file']).Read(Response.DataSize-Response.DataOut);
        {$ELSE}
        DocRoot:=Request.Info['root'];

        if Response.DataSize-Response.DataOut>MAX_SEND_BLOCK_SIZE then
          s:=Read_File(DocRoot+Request.Info.asString['fname'],
                       Request.Info.asLargeInt['from']+Response.DataOut,
                       MAX_SEND_BLOCK_SIZE)
        else
          s:=Read_File(DocRoot+Request.Info.asString['fname'],
                       Request.Info.asLargeInt['from']+Response.DataOut,
                       Response.DataSize-Response.DataOut);
        {$ENDIF}

        if s='' then // Error reading file.
          begin
          XLog('CRC! '+PeerAddr+' > '+Request.Host+
               ' "'+Request.Method+' '+Request.URI+'"'+
               ' > Error reading File: "'+DocRoot+Request.Info.asString['fname']+'".');
          Disconnect;
          end
        else
          Write(s);
        end;
      end
    else if Request.DataSize>MAX_ACCEPT_BODY_SIZE then // Do not accept requests with body longer than 128K
      begin
      XLog('BAD! '+PeerAddr+' > '+Request.Host+
           ' "'+Request.Method+' '+Request.URI+'"'+
           ' 0'+
           ' REF "'+Request.Referer+'"'+
           ' AGENT "'+Request.Agent+'" '+
           '> Content size exceeds 128K limit (size='+IntToStr(Request.DataSize)+' bytes).');

      Response.Status(400,'Bad Request');
      Write('Status 400: Bad Request');

      Disconnect;
      end;
    end;
  end;

procedure TFile_Provider.FileProviderDisconnect(Sender: TRtcConnection);
  var
    tim:int64;
  begin
  with TRtcDataServer(Sender) do
    begin
    if Request.DataSize>Request.DataIn then
      begin
      // did not receive a complete request
      XLog('ERR! '+PeerAddr+' > '+Request['HOST'] {.rHost} +
           ' "'+Request.Method+' '+Request.URI+'"'+
           ' 0'+
           ' REF "'+Request.Referer+'"'+
           ' AGENT "'+Request.Agent+'" '+
           '> DISCONNECTED while receiving a Request ('+IntToStr(Request.DataIn)+' of '+IntToStr(Request.DataSize)+' bytes received).');
      end
    else if Response.DataSize>Response.DataOut then
      begin
      tim:=GetTickCount-Request.Info.asLargeInt['$time'];
      if tim<=0 then tim:=1;

      if Response['CONTENT-RANGE']='' then // no need to show this for partial downloads
        // did not send a complete result
        XLog('ERR! '+PeerAddr+' > '+Request.Host+
             ' "'+Request.Method+' '+Request.URI+'"'+
             ' -'+IntToStr(Response.DataSize-Response.DataOut)+
             ' REF "'+Request.Referer+'"'+
             ' AGENT "'+Request.Agent+'" '+
             IntToStr(Response.DataOut)+'/'+IntToStr(Response.DataSize)+' bytes in '+
             IntToStr(GetTickCount-Request.Info.asLargeInt['$time'])+' ms ='+
             IntToStr(Response.DataOut div tim)+' kbits')
      else
        // did not send a complete result
        XLog('BRK! '+PeerAddr+' > '+Request.Host+
             ' "'+Request.Method+' '+Request.URI+'"'+
             ' -'+IntToStr(Response.DataSize-Response.DataOut)+
             ' REF "'+Request.Referer+'"'+
             ' AGENT "'+Request.Agent+'" '+
             IntToStr(Response.DataOut)+' bytes in '+
             IntToStr(GetTickCount-Request.Info.asLargeInt['$time'])+' ms ='+
             IntToStr(Response.DataOut div tim)+' kbits');
      end;
    end;
  end;

{ *** TIME PROVIDER *** }

procedure TFile_Provider.TimeProviderCheckRequest(Sender: TRtcConnection);
  begin
  with TRtcDataServer(Sender) do
    if UpperCase(Request.FileName)='/$TIME' then
      Accept;
  end;

procedure TFile_Provider.TimeProviderDataReceived(Sender: TRtcConnection);
  begin
  with TRtcDataServer(Sender) do
    if Request.Complete then
      Write('<html><body>Your IP: '+PeerAddr+'<br>'+
            'Server Time: '+TimeToStr(Now)+'<br>'+
            'Connection count: '+IntToStr(TotalConnectionCount)+'<br>'+
            'Memory in use: '+FormatFloat('0.### MB', Get_AddressSpaceUsed / 1024)+'</body></html>');
  end;

initialization
finalization
if assigned(File_Provider) then
  begin
  File_Provider.Free;
  File_Provider:=nil;
  end;
end.