httptst1.pas

BaiduMp3 search baidu mp3

        end;

        Display('StatusCode = ' + IntToStr(HttpCli1.StatusCode));

        if DisplayHeaderCheckBox.Checked then
            for I := 0 to HttpCli1.RcvdHeader.Count - 1 do
                Display('hdr>' + HttpCli1.RcvdHeader.Strings[I]);
    finally
        SetButtonState(TRUE);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.GetButtonClick(Sender: TObject);
var
    I       : Integer;
    DataIn  : TStream;
begin
    DisplayMemo.Clear;
    DocumentMemo.Clear;
    SetButtonState(FALSE);

    try
        if NoBasicAuthCheckBox.Checked then
            HttpCli1.Options      := HttpCli1.Options + [httpoNoBasicAuth]
        else
            HttpCli1.Options      := HttpCli1.Options - [httpoNoBasicAuth];
        if NoNTLMAuthCheckBox.Checked then
            HttpCli1.Options      := HttpCli1.Options + [httpoNoNTLMAuth]
        else
            HttpCli1.Options      := HttpCli1.Options - [httpoNoNTLMAuth];
        HttpCli1.FollowRelocation := not NoRelocCheckbox.Checked;
        HttpCli1.URL              := Trim(URLEdit.Text);
        HttpCli1.Proxy            := Trim(ProxyHostEdit.Text);
        HttpCli1.ProxyPort        := Trim(ProxyPortEdit.Text);
        HttpCli1.ProxyUsername    := Trim(ProxyUserEdit.Text);
        HttpCli1.ProxyPassword    := Trim(ProxyPassEdit.Text);
        HttpCli1.AcceptLanguage   := 'en, fr';
        HttpCli1.Connection       := 'Keep-Alive';
        HttpCli1.RequestVer       := '1.' +
                                     IntToStr(HttpVersionComboBox.ItemIndex);
        HttpCli1.RcvdStream       := nil;
        HttpCli1.Cookie           := CookieEdit.Text;
        if DateTimeEdit.Text <> '' then
            HttpCli1.ModifiedSince := StrToDateTime(DateTimeEdit.Text)
        else
            HttpCli1.ModifiedSince := 0;

        if HttpCli1.Proxy <> '' then
            Display('Using proxy ''' + HttpCli1.Proxy + ':' +
                    HttpCli1.ProxyPort + '''')
        else
            Display('Not using proxy');

        try
            HttpCli1.Get;
        except
            Display('GET Failed !');
            Display('StatusCode   = ' + IntToStr(HttpCli1.StatusCode));
            Display('ReasonPhrase = ' + HttpCli1.ReasonPhrase);
            HttpCli1DocEnd(nil);  { This will close the file }
            Exit;
        end;

        Display('StatusCode = ' + IntToStr(HttpCli1.StatusCode));

        if DisplayHeaderCheckBox.Checked then 
            for I := 0 to HttpCli1.RcvdHeader.Count - 1 do
                Display('hdr>' + HttpCli1.RcvdHeader.Strings[I]);

        if Length(DocFileName) = 0 then begin
            DocumentMemo.Lines.Add('*** NO DOCUMENT FILE NAME ***');
        end
        else begin
            DataIn := TFileStream.Create(DocFileName, fmOpenRead);
            try
                if Copy(HttpCli1.ContentType, 1, 5) = 'text/' then
                    DocumentMemo.Lines.LoadFromStream(DataIn)
                else begin
                    DocumentMemo.Lines.Add('Content type is ' +
                                           HttpCli1.ContentType);
                    DocumentMemo.Lines.Add('Document stored in ''' +
                                           DocFileName +
                                           ''' Size=' + IntToStr(DataIn.Size));
                end;
            finally
                DataIn.Free;
            end;
        end;
    finally
        SetButtonState(TRUE);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.CloseButtonClick(Sender: TObject);
begin
    try
        HttpCli1.Close;
    except
        Display('CLOSE Failed !');
        Display('StatusCode   = ' + IntToStr(HttpCli1.StatusCode));
        Display('ReasonPhrase = ' + HttpCli1.ReasonPhrase);
        Exit;
    end;
    Display('StatusCode = ' + IntToStr(HttpCli1.StatusCode));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.PutButtonClick(Sender: TObject);
begin
    PostOrPut(httpPUT);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.PostButtonClick(Sender: TObject);
begin
    PostOrPut(httpPOST);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.PostOrPut(Request: THttpRequest);
var
    DataOut : TMemoryStream;
    DataIn  : TFileStream;
    Buf     : String;
    I       : Integer;
begin
    DisplayMemo.Clear;
    DocumentMemo.Clear;
    SetButtonState(FALSE);

    try
        DataOut := TMemoryStream.Create;
        Buf     := DataEdit.Text;
        if Length(Buf) > 0 then      { Check if some data to post }
            DataOut.Write(Buf[1], Length(Buf));
        DataOut.Seek(0, soFromBeginning);

        if NoBasicAuthCheckBox.Checked then
            HttpCli1.Options      := HttpCli1.Options + [httpoNoBasicAuth]
        else
            HttpCli1.Options      := HttpCli1.Options - [httpoNoBasicAuth];
        if NoNTLMAuthCheckBox.Checked then
            HttpCli1.Options      := HttpCli1.Options + [httpoNoNTLMAuth]
        else
            HttpCli1.Options      := HttpCli1.Options - [httpoNoNTLMAuth];
        HttpCli1.FollowRelocation := not NoRelocCheckbox.Checked;
        HttpCli1.SendStream       := DataOut;
        HttpCli1.Proxy            := ProxyHostEdit.Text;
        HttpCli1.ProxyPort        := ProxyPortEdit.Text;
        HttpCli1.Connection       := 'Keep-Alive';
        HttpCli1.RcvdStream       := nil;
        HttpCli1.ContentTypePost  := PostContentTypeEdit.Text;
        HttpCli1.Cookie           := CookieEdit.Text;
        HttpCli1.URL              := URLEdit.Text;
        HttpCli1.RequestVer       := '1.' +
                                     IntToStr(HttpVersionComboBox.ItemIndex);

        if HttpCli1.Proxy <> '' then
            Display('Using proxy ''' + HttpCli1.Proxy + ':' +
                                  HttpCli1.ProxyPort + '''')
        else
            Display('Not using proxy');

        try
            if Request = httpPOST then
                HttpCli1.Post
            else
                HttpCli1.Put;
        except
            DataOut.Free;
            Display('POST Failed !');
            Display('StatusCode   = ' + IntToStr(HttpCli1.StatusCode));
            Display('ReasonPhrase = ' + HttpCli1.ReasonPhrase);
            Exit;
        end;
        DataOut.Free;

        Display('StatusCode = ' + IntToStr(HttpCli1.StatusCode) +
                ' (' + HttpCli1.ReasonPhrase + ')');

        if DisplayHeaderCheckBox.Checked then
            for I := 0 to HttpCli1.RcvdHeader.Count - 1 do
                Display('hdr>' + HttpCli1.RcvdHeader.Strings[I]);

        if HttpCli1.ContentLength = 0 then
            DocumentMemo.Lines.Add('No document received.')
        else begin
            DataIn := TFileStream.Create(HttpCli1.DocName, fmOpenRead);
            try
                if Copy(HttpCli1.ContentType, 1, 5) = 'text/' then
                    DocumentMemo.Lines.LoadFromStream(DataIn)
                else begin
                    DocumentMemo.Lines.Add('Content type is ' +
                                           HttpCli1.ContentType);
                    DocumentMemo.Lines.Add('Document stored in ''' +
                                           DocFileName +
                                           ''' Size=' + IntToStr(DataIn.Size));
                end;
            finally
                DataIn.Free;
            end;
        end;
    finally
        SetButtonState(TRUE);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ WARNING: With DELPHI1, change "s: String" to "s: OpenString"              }
procedure THttpTestForm.HttpCli1Command(Sender: TObject; var S: String);
begin
    Display('cmd> ' + s);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.HttpCli1DocBegin(Sender: TObject);
begin
    Display(HttpCli1.ContentType + ' => ' + HttpCli1.DocName);
    Display('Location = ' + HttpCli1.Location);
    Display('URL = ' + HttpCli1.URL);
    Display('Document = ' + HttpCli1.DocName);

    DocFileName := HttpCli1.DocName;

    if HttpCli1.ContentType = 'image/gif' then
        ReplaceExt(DocFileName, 'gif')
    else if HttpCli1.ContentType = 'image/jpeg' then
        ReplaceExt(DocFileName, 'jpg')
    else if HttpCli1.ContentType = 'image/bmp' then
        ReplaceExt(DocFileName, 'bmp');

    if DocFileName = '' then
        DocFileName := 'HttpTst.htm';
    try
        HttpCli1.RcvdStream := TFileStream.Create(DocFileName, fmCreate);
    except
        on E:Exception do begin
            Display('Error opening file: ' + E.Message);
            DocFileName := 'HttpTst.htm';
            Display('Using default file name: ' + DocFileName);
            HttpCli1.RcvdStream := TFileStream.Create(DocFileName, fmCreate);
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.HttpCli1DocEnd(Sender: TObject);
begin
    if HttpCli1.RcvdStream <> nil then begin
        HttpCli1.RcvdStream.Free;
        HttpCli1.RcvdStream := nil;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.SetButtonState(State : Boolean);
begin
    GetButton.Enabled   := State;
    PostButton.Enabled  := State;
    HeadButton.Enabled  := State;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.HttpCli1RequestDone(
    Sender  : TObject;
    RqType  : THttpRequest;
    ErrCode : Word);
begin
    SetButtonState(TRUE);
    if ErrCode <> 0 then
        Display('RequestDone Error = ' + IntToStr(ErrCode) + '. Status = ' +
                IntToStr(HttpCli1.StatusCode))
    else
        Display('RequestDone, no error. Status =' +
                IntToStr(HttpCli1.StatusCode));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.AbortButtonClick(Sender: TObject);
begin
    HttpCli1.Abort;
    Display('StatusCode = ' + IntToStr(HttpCli1.StatusCode));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.Panel1Resize(Sender: TObject);
begin
    URLEdit.Width             := Panel1.Width - Panel2.Width - URLEdit.Left - 8;
    DataEdit.Width            := URLEdit.Width;
    PostContentTypeEdit.Width := Panel1.Width - Panel2.Width -
                                 PostContentTypeEdit.Left - 8;
    CookieEdit.Width          := PostContentTypeEdit.Width;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.ParseButtonClick(Sender: TObject);
var
    Proto, User, Pass, Host, Port, Path : String;
begin
    ParseURL(URLEdit.Text, Proto, User, Pass, Host, Port, Path);
    Display('URL   = ''' + URLEdit.Text + '''');
    Display('Proto = ''' + Proto + '''');
    Display('Host  = ''' + Host  + '''');
    Display('Path  = ''' + Path  + '''');
    Display('Port  = ''' + Port  + '''');
    Display('User  = ''' + User  + '''');
    Display('Pass  = ''' + Pass  + '''');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.HttpCli1HeaderData(Sender: TObject);
begin
{    Display('Header: "' + HttpCli1.LastResponse + '"'); }
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.HttpCli1Cookie(
    Sender     : TObject;
    const Data : String;
    var Accept : Boolean);
begin
    Display('Cookie: "' + Data + '"');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.HttpCli1LocationChange(Sender: TObject);
var
    I : Integer;
begin
    if DisplayHeaderCheckBox.Checked then
        for I := 0 to HttpCli1.RcvdHeader.Count - 1 do
            Display('hdr>' + HttpCli1.RcvdHeader.Strings[I]);
    Display('Location changed to "' + HttpCli1.Location + '"');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.ClearButtonClick(Sender: TObject);
begin
    DocumentMemo.Clear;
    DisplayMemo.Clear;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

procedure THttpTestForm.Button1Click(Sender: TObject);
begin
    if BorderStyle <> bsNone then
        BorderStyle := bsNone
    else
        BorderStyle := bsSizeable;
end;

end.