home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / Info / Extras / NetManage / Demos / Http / main.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1997-03-17  |  4.7 KB  |  202 lines
  1. unit main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, Menus, ComCtrls, OleCtrls, ISP3, Buttons, ActiveX;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     StatusBar1: TStatusBar;
  12.     MainMenu1: TMainMenu;
  13.     File1: TMenuItem;
  14.     Exit1: TMenuItem;
  15.     Panel1: TPanel;
  16.     Bevel1: TBevel;
  17.     URLs: TComboBox;
  18.     GoButton: TSpeedButton;
  19.     CancelBtn: TSpeedButton;
  20.     Label1: TLabel;
  21.     HTTP1: THTTP;
  22.     Memo1: TMemo;
  23.     procedure Exit1Click(Sender: TObject);
  24.     procedure GoButtonClick(Sender: TObject);
  25.     procedure CancelBtnClick(Sender: TObject);
  26.     procedure HTML1BeginRetrieval(Sender: TObject);
  27.     procedure HTML1EndRetrieval(Sender: TObject);
  28.     procedure URLsKeyDown(Sender: TObject; var Key: Word;
  29.       Shift: TShiftState);
  30.     procedure HTTP1DocOutput(Sender: TObject; const DocOutput: DocOutput);
  31.   private
  32.     { Private declarations }
  33.   public
  34.     { Public declarations }
  35.   end;
  36.  
  37. var
  38.   Form1: TForm1;
  39.   Data: String;
  40.  
  41. implementation
  42.  
  43. {$R *.DFM}
  44.  
  45. { TSimpleHTMLParser }
  46.  
  47. type
  48.  
  49.   TToken = (etEnd, etSymbol, etLineEnd, etHTMLTag);
  50.  
  51.   TSimpleHTMLParser = class
  52.   private
  53.     FText: string;
  54.     FSourcePtr: PChar;
  55.     FTokenPtr: PChar;
  56.     FTokenString: string;
  57.     FToken: TToken;
  58.     procedure NextToken;
  59.     function TokenHTMLTagIs(const S: string): Boolean;
  60.   public
  61.     constructor Create(const Text: string);
  62.   end;
  63.  
  64. constructor TSimpleHTMLParser.Create(const Text: string);
  65. begin
  66.   FText := Text;
  67.   FSourcePtr := PChar(Text);
  68.   NextToken;
  69. end;
  70.  
  71. procedure TSimpleHTMLParser.NextToken;
  72. var
  73.   P, TokenStart: PChar;
  74. begin
  75.   FTokenString := '';
  76.   P := FSourcePtr;
  77.   while (P^ <> #0) and (P^ <= ' ') do Inc(P);
  78.   FTokenPtr := P;
  79.   case P^ of
  80.     '<':
  81.       begin
  82.         Inc(P);
  83.         TokenStart := P;
  84.         while (P^ <> '>') and (P^ <> #0) do Inc(P);
  85.         SetString(FTokenString, TokenStart, P - TokenStart);
  86.         FToken := etHTMLTag;
  87.         Inc(P);
  88.       end;
  89.     #13: FToken := etLineEnd;
  90.     #0: FToken := etEnd;
  91.   else
  92.     begin
  93.       TokenStart := P;
  94.       Inc(P);
  95.       while not (P^ in ['<', #0, #13,#10]) do Inc(P);
  96.       SetString(FTokenString, TokenStart, P - TokenStart);
  97.       FToken := etSymbol;
  98.     end;
  99.   end;
  100.   FSourcePtr := P;
  101. end;
  102.  
  103. function TSimpleHTMLParser.TokenHTMLTagIs(const S: string): Boolean;
  104. begin
  105.   Result := (FToken = etHTMLTag) and ((CompareText(FTokenString, S) = 0) or
  106.     (AnsiPos(S, FTokenString) = 1));
  107. end;
  108.  
  109. procedure TForm1.Exit1Click(Sender: TObject);
  110. begin
  111.   Close;
  112. end;
  113.  
  114. procedure TForm1.GoButtonClick(Sender: TObject);
  115. var
  116.   a,b: Olevariant;
  117. begin
  118.   Memo1.Lines.Clear;
  119.   if URLs.Items.IndexOf(URLs.Text) = -1 then
  120.     URLs.Items.Add(URLs.Text);
  121.   if HTTP1.Busy then
  122.     HTTP1.Cancel;
  123.   HTTP1.OleObject.GetDoc(URLs.text, a, b);
  124.   Statusbar1.Panels[0].Text := HTTP1.URL;
  125. end;
  126.  
  127. procedure TForm1.CancelBtnClick(Sender: TObject);
  128. begin
  129.   HTTP1.Cancel;
  130.   CancelBtn.Enabled := False;
  131. end;
  132.  
  133. procedure TForm1.HTML1BeginRetrieval(Sender: TObject);
  134. begin
  135.   CancelBtn.Enabled := True;
  136. end;
  137.  
  138. procedure TForm1.HTML1EndRetrieval(Sender: TObject);
  139. begin
  140.   CancelBtn.Enabled := False;
  141. end;
  142.  
  143. procedure TForm1.URLsKeyDown(Sender: TObject; var Key: Word;
  144.   Shift: TShiftState);
  145. begin
  146.   if Key = VK_Return then
  147.     GoButtonClick(nil);
  148. end;
  149.  
  150. procedure TForm1.HTTP1DocOutput(Sender: TObject;
  151.   const DocOutput: DocOutput);
  152. var
  153.   S: OleVariant;
  154.   Parser: TSimpleHTMLParser;
  155.   ALine: String;
  156. begin
  157.   Statusbar1.Panels[2].Text := Format('Bytes: %d',[DocOutput.BytesTransferred]);
  158.   case DocOutput.State of
  159.     icDocBegin:
  160.       begin
  161.         Memo1.Lines.Clear;
  162.         Data := '';
  163.       end;
  164.     icDocData:
  165.       begin
  166.         DocOutput.GetData(S, '');
  167.         Data := Data + S;
  168.       end;
  169.     icDocEnd:
  170.       begin
  171.         { Now remove all the HTML tags and only display the text }
  172.         Parser := TSimpleHTMLParser.Create(Data);
  173.         ALine := '';
  174.         while Parser.FToken <> etEnd do
  175.         begin
  176.           case Parser.FToken of
  177.             etHTMLTag:
  178.               begin
  179.                 if Parser.TokenHTMLTagIs('BR') then
  180.                   ALine := ALine + #13#10;
  181.                 if Parser.TokenHTMLTagIs('P') then
  182.                   ALine := ALine + #13#10#13#10;
  183.               end;
  184.             etSymbol: ALine := ALine + ' ' + Parser.FTokenString;
  185.             etLineEnd:
  186.               begin
  187.                 Memo1.Lines.Add(ALine);
  188.                 ALine := '';
  189.               end;
  190.           end;
  191.           Parser.NextToken;
  192.         end;
  193.         Memo1.Lines.Add(ALine);
  194.         Memo1.SelStart := 0;
  195.         SendMessage(Memo1.Handle, EM_ScrollCaret, 0, 0);
  196.       end;
  197.   end;
  198.   Refresh;
  199. end;
  200.  
  201. end.
  202.