httptst1.pas

文件名称：新曦 我的资源 搜索软件 源程序(Borland Delphi 7)说明

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

    try
        httpcli1.URL        := URLEdit.Text;
        httpcli1.Proxy      := ProxyHostEdit.Text;
        httpcli1.ProxyPort  := ProxyPortEdit.Text;
        httpcli1.RcvdStream := nil;
        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));

        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.PostButtonClick(Sender: TObject);
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);

        httpcli1.SendStream := DataOut;
        httpcli1.Proxy      := ProxyHostEdit.Text;
        httpcli1.ProxyPort  := ProxyPortEdit.Text;
        httpcli1.RcvdStream := nil;
        httpcli1.URL        := URLEdit.Text;

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

        try
            httpcli1.Post;
        except
            DataOut.Free;
            Display('POST Failed !');
            Display('StatusCode   = ' + IntToStr(httpcli1.StatusCode));
            Display('ReasonPhrase = ' + httpcli1.ReasonPhrase);
            Exit;
        end;
        DataOut.Free;

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

        for I := 0 to httpcli1.RcvdHeader.Count - 1 do
            Display('hdr>' + httpcli1.RcvdHeader.Strings[I]);

        DataIn := TFileStream.Create(httpcli1.DocName, fmOpenRead);
        try
            DocumentMemo.Lines.LoadFromStream(DataIn);
        finally
            DataIn.Free;
        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('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.Check64ButtonClick(Sender: TObject);
const
    Inp : String = 'Aladdin:open sesame';
    Res : String = 'QWxhZGRpbjpvcGVuIHNlc2FtZQ==';
begin
    if EncodeLine(encBase64, @Inp[1], Length(Inp)) <> Res then
        Display('Base64 encoding do not work !')
    else
        Display('Base64 encoding works OK !');
end;


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


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


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.AbortButtonClick(Sender: TObject);
begin
    HttpCli1.Abort;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpTestForm.Panel1Resize(Sender: TObject);
begin
    GetButton.Left   := Panel1.Width - GetButton.Width - 8;
    PostButton.Left  := GetButton.Left;
    HeadButton.Left  := GetButton.Left;
    AbortButton.Left := GetButton.Left;
    URLEdit.Width    := GetButton.Left - URLEdit.Left - 8;
    DataEdit.Width   := URLEdit.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);
begin
    Display('Location changed to "' + HttpCli1.Location + '"');
end;


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

end.