PC Pro 1999 February/DPPCPRO0299.ISO/February/Delphi/Runimage/DELPHI20/DEMOS/INTERNET/HTTP/MAIN.PAS

Pascal/Delphi Source File | 1996-06-10 | 5.1 KB | 219 lines

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Menus, ComCtrls, OleCtrls, ISP, Buttons, Ole2;

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Panel1: TPanel;
    Bevel1: TBevel;
    URLs: TComboBox;
    GoButton: TSpeedButton;
    CancelBtn: TSpeedButton;
    Label1: TLabel;
    HTTP1: THTTP;
    Memo1: TMemo;
    procedure Exit1Click(Sender: TObject);
    procedure GoButtonClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
    procedure HTML1BeginRetrieval(Sender: TObject);
    procedure HTML1EndRetrieval(Sender: TObject);
    procedure URLsKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure HTTP1DocOutput(Sender: TObject; const DocOutput: Variant);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Data: String;

implementation

{$R *.DFM}

{ TSimpleHTMLParser }

type

  TToken = (etEnd, etSymbol, etLineEnd, etHTMLTag);

  TSimpleHTMLParser = class
  private
    FText: string;
    FSourcePtr: PChar;
    FTokenPtr: PChar;
    FTokenString: string;
    FToken: TToken;
    procedure NextToken;
    procedure NextSymbol;
    function TokenSymbolIs(const S: string): Boolean;
    function TokenHTMLTagIs(const S: string): Boolean;
  public
    constructor Create(const Text: string);
  end;

constructor TSimpleHTMLParser.Create(const Text: string);
begin
  FText := Text;
  FSourcePtr := PChar(Text);
  NextToken;
end;

procedure TSimpleHTMLParser.NextToken;
var
  P, TokenStart: PChar;
  StrBuf: array[0..255] of Char;
begin
  FTokenString := '';
  P := FSourcePtr;
  while (P^ <> #0) and (P^ <= ' ') do Inc(P);
  FTokenPtr := P;
  case P^ of
    '<':
      begin
        Inc(P);
        TokenStart := P;
        while (P^ <> '>') and (P^ <> #0) do Inc(P);
        SetString(FTokenString, TokenStart, P - TokenStart);
        FToken := etHTMLTag;
        Inc(P);
      end;
    #13: FToken := etLineEnd;
    #0: FToken := etEnd;
  else
    begin
      TokenStart := P;
      Inc(P);
      while not (P^ in ['<', #0, #13,#10]) do Inc(P);
      SetString(FTokenString, TokenStart, P - TokenStart);
      FToken := etSymbol;
    end;
  end;
  FSourcePtr := P;
end;

procedure TSimpleHTMLParser.NextSymbol;
begin
  while (FToken <> etEnd) do
  begin
    NextToken;
    if FToken = etSymbol then
      break;
  end;
end;

function TSimpleHTMLParser.TokenSymbolIs(const S: string): Boolean;
begin
  Result := (FToken = etSymbol) and (CompareText(FTokenString, S) = 0);
end;

function TSimpleHTMLParser.TokenHTMLTagIs(const S: string): Boolean;
begin
  Result := (FToken = etHTMLTag) and ((CompareText(FTokenString, S) = 0) or
    (Pos(S, FTokenString) = 1));
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.GoButtonClick(Sender: TObject);
var
  a,b: variant;
begin
  Memo1.Lines.Clear;
  if URLs.Items.IndexOf(URLs.Text) = -1 then
    URLs.Items.Add(URLs.Text);
  HTTP1.GetDoc(URLs.text, a, b);
  Statusbar1.Panels[0].Text := HTTP1.URL;
end;

procedure TForm1.CancelBtnClick(Sender: TObject);
begin
  HTTP1.Cancel;
  CancelBtn.Enabled := False;
end;

procedure TForm1.HTML1BeginRetrieval(Sender: TObject);
begin
  CancelBtn.Enabled := True;
end;

procedure TForm1.HTML1EndRetrieval(Sender: TObject);
begin
  CancelBtn.Enabled := False;
end;

procedure TForm1.URLsKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_Return then
    GoButtonClick(nil);
end;

procedure TForm1.HTTP1DocOutput(Sender: TObject; const DocOutput: Variant);
var
  S: String;
  i: integer;
  MsgNo, Header: String;
  Parser: TSimpleHTMLParser;
  ALine: String;
begin
  Statusbar1.Panels[2].Text := Format('Bytes: %s',[DocOutput.BytesTransferred]);
  case DocOutput.State of
    icDocBegin:
      begin
        Memo1.Lines.Clear;
        Data := '';
      end;
    icDocData:
      begin
        DocOutput.GetData(S, VT_BSTR);
        Data := Data + S;
      end;
    icDocEnd:
      begin
        { Now remove all the HTML tags and only display the text }
        Parser := TSimpleHTMLParser.Create(Data);
        ALine := '';
        while Parser.FToken <> etEnd do
        begin
          case Parser.FToken of
            etHTMLTag:
              begin
                if Parser.TokenHTMLTagIs('BR') then
                  ALine := ALine + #13#10;
                if Parser.TokenHTMLTagIs('P') then
                  ALine := ALine + #13#10#13#10;
              end;
            etSymbol: ALine := ALine + ' ' + Parser.FTokenString;
            etLineEnd:
              begin
                Memo1.Lines.Add(ALine);
                ALine := '';
              end;
          end;
          Parser.NextToken;
        end;
        Memo1.Lines.Add(ALine);
        Memo1.SelStart := 0;
        SendMessage(Memo1.Handle, EM_ScrollCaret, 0, 0);
      end;
  end;
  Refresh;
end;

end.