nmhttp.pas

DELPHI里面一些常用的控件

    AssembleHTTPHeader;

    if assigned(FOnAboutToSend) then
      FOnAboutToSend(self);

    try
      Connect; {Now connect to  Host at Port}
      SendHTTP;
      FReplyNumber := 0;

      timeron;

      try
        while (FifoQ.BufferSize < 3) and (not beenCanceled) do
          wait;
      finally
        timeroff;
      end;

      if Timedout then
        raise ESockError.Create('Timed out waiting for response');
      if BeenCanceled then
        raise ESockError.Create('Wait for response Cancelled');

      Setlength(LkHead, 3);
      FifoQ.Peek(Pointer(@LkHead[1]), 3);

      if (LKHead = 'HTT') then
        RemoveHeader; {Get the Header of the file sent from host}

      if InputFileMode then
        CaptureFile(FBody) {Capture the body of the data from host}
      else
        CaptureString(FBody, -2);

      if ReplyNumber < 299 then
        begin
          if Assigned(FOnSuccess) then
            FOnSuccess(ConnType); {If a  message received event handler present execute it}

          StatusMessage(STATUS_BASIC, sHTTP_Msg_Trans); {Show status Message}
        end
      else if ReplyNumber > 399 then
        begin
          if Assigned(FOnFailure) then
            FOnFailure(ConnType)
        end
      else if (ReplyNumber >= 300) and (ReplyNumber <= 302) then
        URL_Holder := FLocation;

    finally
      CloseImmediate;
      FConnected := TRUE;
      Disconnect; {Disconnect from host}
    end;

    if (ReplyNumber > 299) and (ReplyNumber < 399) then
      begin
        Handled := FALSE;

        if CookieIn <> '' then
          HeaderInfo.Cookie := CookieIn;

        if assigned(OnRedirect) then
          OnRedirect(Handled);

        if Handled then
          break;

        ConnType := CmdGET; {Set transaction type to Get}

        if Pos('//', URL_Holder) = 0 then
          if Pos('/', URL_Holder) <> 1 then
            begin
              tmp := URL_Holder;
              URL_Holder := FScheme + '//' + FNetworkLocation;

              if FPort <> '' then
                URL_Holder := URL_Holder + FPort;

              URL_Holder := URL_Holder + FPath + tmp;
            end;
            //URL_Holder := 'http://' + Host + '/' + URL_Holder;
      end;

    if (ReplyNumber = 401) then
      if assigned(FOnAuthenticationNeeded) then
        FOnAuthenticationNeeded(self);

  until (ReplyNumber < 299) or (ReplyNumber > 399);
end;


(*
{*******************************************************************************************
Parse the URL
********************************************************************************************}

procedure TNMHTTP.ParsetheURL;
var
  Pos1                : integer;
  TempStr             : string;
begin
  if URL_Holder = '' then {Nothing to work on?}
    raise Exception.create( sHTTP_Cont_Msg_NoURL );

  if port = 0 then {Set default port}
    Port := 80;

  if Pos( '//', URL_Holder ) <> 0 then
    FSelector := system.Copy( URL_Holder, NthPos( URL_Holder, '/', 3 ), 256 )
  else if Pos( '/', URL_Holder ) <> 0 then
    FSelector := system.Copy( URL_Holder, Pos( '/', URL_Holder ), 256 )
  else
    Fselector := '';

  if Pos( ':', URL_Holder ) <> 0 then
    begin
      tempStr := LowerCase( NthWord( URL_Holder, ':', 1 ) ); {Extract URL type}

      if TempStr = Prt_gopher then
        Port := 70                              {If URL Type is gopher set port to 70}
      else if TempStr = Prt_ftp then
        Port := 21
      else if TempStr = 'https' then
        raise exception.create( 'HTTP Secure Socket is not supported' )
      else
        Port := 80;                             {If URL type is FTP set FPort to 21 else set port to 80}
    end;

  if Pos( '//', URL_Holder ) <> 0 then
    tempStr := NthWord( URL_Holder, '/', 3 )    {Extract Host part}
  else if URL_Holder[ 1 ] <> '/' then
    tempStr := NthWord( URL_Holder, '/', 1 )
  else
    tempstr := '';                              {Extract Host part}

  Pos1 := Pos( ':', tempStr );                  {see if a colon in host address}

  if Pos1 > 0 then
    {if so there is an embedded port number}
    begin
      Port := StrToInt( NthWord( tempStr, ':', 2 ) ); {If so extract port}
      system.Delete( tempStr, Pos1, 255 );      {and extract remaining IPAddr}
    end;

  if tempStr <> '' then
    Host := tempStr;

  if FSelector = '' then {If no seletor(directory) make it the home directory}
    begin FSelector := '/';
      URL_Holder := URL_Holder + '/';
    end;
end;
*)

{*******************************************************************************************
Send HTTP Header
********************************************************************************************}

procedure TNMHTTP.AssembleHTTPHeader;
var
  strm: TFileStream;
  Ins, Ous: TStringStream;
  NMUUProcessor1: TNMUUProcessor;
  tmp: string;
  i: PChar;
begin
  FSendHeader.clear; {Create memorystream to hold Http command}
  try
    case ConnType of
      {Construct the command line depending on type of Transaction}
      CmdGET:
        tmp := Cmd_Get;

      CmdOPTIONS:
        tmp := Cmd_Options;

      CmdPOST, CmdPOSTS:
        tmp := Cmd_Post;

      CmdPUT:
        tmp := Cmd_Put;

      CmdHEAD:
        tmp := Cmd_Head;

      CmdPATCH:
        tmp := Cmd_Patch;

      CmdCOPY:
        tmp := Cmd_Copy;

      CmdMOVE:
        tmp := Cmd_Move;

      CmdLINK:
        tmp := Cmd_Link;

      CmdUNLINK:
        tmp := Cmd_Unlink;

      CmdDELETE:
        tmp := Cmd_Delete;

      CmdTRACE:
        tmp := Cmd_Trace;
    end;

    if Proxy <> '' then
      begin
        i := StrPos(PChar(URL_Holder), ' ');
        while i <> nil do
          begin
            I^ := '+';
            i := StrPos(PChar(URL_Holder), ' ');
          end;

        {If Proxy server send whole URL}
        FsendHeader.add(tmp + URL_Holder + Prt_str_http);
        FsendHeader.add(Prox_Head_Str); {If Proxy ask connection to be kept alive}
        FsendHeader.add(Prox_Host_Str + Host); {Send host name to proxy}
      end
    else
      begin
        FSelector := FPath + FResource + FParameters + FQuery + FFragment;

        i := StrPos(PChar(FSelector), ' ');
        while i <> nil do
          begin
            I^ := '+';
            i := StrPos(PChar(FSelector), ' ');
          end;

        {If no proxy just send selector}
        FsendHeader.add(tmp + FSelector + Prt_str_http);
      end;

    {Send acceptable reply types}
    FsendHeader.values[Head_Host] := Host;
    FsendHeader.add(Host_Accpt_Str1);
    FsendHeader.add(Host_Accpt_Str2);

    if FHeaderInfo.FLocalAddress <> '' then
      FsendHeader.values[Host_UserAgent] := FHeaderInfo.FLocalAddress;

    if FHeaderInfo.FLocalProgram <> '' then
      FsendHeader.values[Head_From] := FHeaderInfo.FLocalProgram;

    if FHeaderInfo.FCookie <> '' then
      FsendHeader.values[Head_Cookie] := FHeaderInfo.FCookie;

    if FHeaderInfo.FReferer <> '' then
      FsendHeader.values[Head_Referer] := FHeaderInfo.FReferer;

    if (FHeaderInfo.FUserId <> '') and (FHeaderInfo.Fpassword <> '') then
      begin
        Ins := TStringStream.create(FHeaderInfo.FUserId + ':' + FHeaderInfo.Fpassword);
        Ous := TStringStream.create('');
        NMUUProcessor1 := TNMUUProcessor.create(self);
        try
          NMUUProcessor1.InputStream := Ins;
          NMUUProcessor1.OutputStream := Ous;
          NMUUProcessor1.method := UUMime;
          NMUUProcessor1.Encode;

          FsendHeader.values['Authorization'] := 'Basic ' + Ous.DataString;

        finally
          NMUUProcessor1.free;
          Ous.free;
          Ins.free;
        end;
      end;

    if (FHeaderInfo.FProxyUserId <> '') and (FHeaderInfo.FProxyPassword <> '') then
      begin
        Ins := TStringStream.create(FHeaderInfo.FProxyUserId + ':' + FHeaderInfo.FProxyPassword);
        Ous := TStringStream.create('');
        NMUUProcessor1 := TNMUUProcessor.create(self);

        try
          NMUUProcessor1.InputStream := Ins;
          NMUUProcessor1.OutputStream := Ous;
          NMUUProcessor1.method := UUMime;
          NMUUProcessor1.Encode;

          FsendHeader.values['Proxy-Authorization'] := 'Basic ' + Ous.DataString;

        finally
          NMUUProcessor1.free;
          Ous.free;
          Ins.free;
        end;
      end;

    FsendHeader.add(Head_Content); {Send content type of request}

    case ConnType of
      CmdLINK, CmdUNLINK:
        FsendHeader.add(Head_Link + TheDestURL); {Send link for link or unlink method}

      CmdMOVE, CmdCOPY:
        FsendHeader.add(Head_URI + TheDestURL); {Send destination URL for copy or move methods}
    end;

    case ConnType of
      {Construct the content length string}
      CmdPOSTS:
        FSendHeader.add(Head_ContentLength + IntToStr(FSendStream.size));

      CmdPOST, CmdPUT, CmdPATCH, CmdTRACE, CmdWRAPPED, CmdLINK, CmdUNLINK:
        begin
          if OutPutFileMode then
            begin
              strm := TFileStream.Create(TheSendFile, fmOpenRead); {Open stream}

              try
                FsendHeader.add(Head_ContentLength + IntToStr(strm.size)); {Send content length of stream}
              finally
                strm.destroy; {Destroy stream}
              end;
            end
          else
            FsendHeader.add(Head_ContentLength + IntToStr(length(TheSendFile)));
        end;
    end;

  finally
  end
end;

procedure TNMHTTP.SendHTTP;
begin
  write(FsendHeader.text);
  writeln('');

  case ConnType of
    CmdPOSTS:
      SendStream(FSendStream);

    CmdPOST, CmdPUT, CmdPATCH, CmdTRACE, CmdWRAPPED:
      if OutputFileMode then
        SendFile(TheSendFile)
      else
        write(TheSendFile);
  end;
end;

procedure TNMHTTP.RemoveHeader;
var
  strm: TFileStream;
  ReplyMess, tempbuff, temp2: string;
  i: integer;
  st: boolean;
begin
  strm := nil;
  FBytesTotal := 0;
  FCookieIn := '';

  if InPutFileMode then
    strm := TFileStream.Create(Header, fmCreate) {Create stream to take header}
  else
    FHeader := '';

  try
    ReplyMess := Readln;

    if ReplyMess <> '' then
      FReplyNumber := StrtoIntDef(NthWord(ReplyMess, ' ', 2), 0);

    if InPutFileMode then
      strm.WriteBuffer(ReplyMess[1], Length(ReplyMess)) {Write it to buffer}
    else
      FHeader := FHeader + ReplyMess;

    repeat
      ReplyMess := Readln;
      tempbuff := uppercase(ReplyMess); {Read a line}

      if NthWord(tempbuff, ' ', 1) = Head_SetCookie then
        begin
          if Pos(';', ReplyMess) > 0 then FCookieIn := system.Copy(ReplyMess, 13, Pos(';', ReplyMess) - 13)
          else FCookieIn := system.Copy(ReplyMess, 13, Length(ReplyMess) - 14);
        end;

      if NthWord(tempbuff, ' ', 1) = Head_Location then
        begin
          FLocation := system.Copy(ReplyMess, 11, 256);
          SetLength(FLocation, Length(FLocation) - 2);
        end;

      if NthWord(tempbuff, ' ', 1) = Head_CL2 then
        begin
          system.Delete(tempbuff, 1, pos(Head_length, tempbuff) + 6); {Delete anything before 'length:'}
          st := FALSE;
          temp2 := '';

          for i := 1 to length(tempbuff) do
            if st = TRUE then
              if ((tempbuff[i] < '0') or (tempbuff[i] > '9')) then
                break
              else
                temp2 := temp2 + tempbuff[i]
            else if ((tempbuff[i] >= '0') or (tempbuff[i] <= '9')) then
              begin
                temp2 := temp2 + tempbuff[i];
                st := TRUE;
              end;

          FBytesTotal := StrToIntDef(temp2, 0);
        end;

      if InPutFileMode then
        strm.WriteBuffer(ReplyMess[1], Length(ReplyMess)) {Write it to buffer}
      else
        FHeader := FHeader + ReplyMess;

    until (ReplyMess = #10) or (ReplyMess = #13#10) or (ReplyMess = ''); {Until blank line}
  finally
    if InPutFileMode then
      strm.free;
  end;
end;

end.