home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 February / Chip_2004-02_cd1.bin / program / delphi / kompon / d4567 / google / DIHtmlGooglePlugin.exe / Demos / Google / fGoogle.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2003-08-29  |  8.1 KB  |  264 lines
  1. { Copyright 2003 by The Delphi Inspiration <delphi@zeitungsjunge.de>
  2.  
  3.   DIHtmlParser Demo to show how to extract search results from HTML pages
  4.   returned by the Google Internet search engine.
  5.  
  6.   Please visit the DIHtmlParser homepage for latest information and updates.
  7.  
  8.   http://www.zeitungsjunge.de/delphi/
  9.  
  10. { ---------------------------------------------------------------------------- }
  11.  
  12. unit fGoogle;
  13.  
  14. {$I DI.inc} // Download DIHtmlParser from http://www.zeitungsjunge.de/delphi/
  15.  
  16. interface
  17.  
  18. uses
  19.   Windows, Classes, Forms, Controls, StdCtrls, ExtCtrls, Graphics, ComCtrls, Buttons,
  20.  
  21.   DIUnicode,
  22.   DIHtmlParser,
  23.   DIHtmlCharSetPlugin,
  24.   DIHtmlGooglePlugin;
  25.  
  26. type
  27.   TfrmGoogle = class(TForm)
  28.     pnlTop: TPanel;
  29.     lblQuery: TLabel;
  30.     Image1: TImage;
  31.     DIHtmlGooglePlugin1: TDIHtmlGooglePlugin;
  32.     DIHtmlParser1: TDIHtmlParser;
  33.     DIHtmlCharSetPlugin1: TDIHtmlCharSetPlugin;
  34.     tvResults: TTreeView;
  35.     sbnOpen: TSpeedButton;
  36.     sbnCollapse: TSpeedButton;
  37.     sbnExpand: TSpeedButton;
  38.     sbnClear: TSpeedButton;
  39.     procedure FormCreate(Sender: TObject);
  40.     procedure FormDestroy(Sender: TObject);
  41.     procedure DIHtmlGooglePlugin1Result(const Sender: TDIHtmlParserPlugin);
  42.     procedure Image1Click(Sender: TObject);
  43.     procedure tvResultsCustomDrawItem(Sender: TCustomTreeView;
  44.       Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
  45.     procedure sbnOpenClick(Sender: TObject);
  46.     procedure sbnExpandClick(Sender: TObject);
  47.     procedure sbnCollapseClick(Sender: TObject);
  48.     procedure sbnClearClick(Sender: TObject);
  49.   private
  50.     FFileNode: TTreeNode;
  51.     procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
  52.     procedure ParseFile(const f: AnsiString);
  53.   public
  54.   end;
  55.  
  56. var
  57.   frmGoogle: TfrmGoogle;
  58.  
  59. const
  60.   APP_TITLE = 'Google Parser';
  61.  
  62. implementation
  63.  
  64. {$R *.DFM}
  65.  
  66. uses
  67.   Messages, ShellAPI, SysUtils, Dialogs,
  68.  
  69.   DIHtmlColors;
  70.  
  71. { ---------------------------------------------------------------------------- }
  72.  
  73. const
  74.   DATA_FILE = 1;
  75.   DATA_TITLE = 2;
  76.   DATA_URL = 3;
  77.   DATA_TRANSLATION = 4;
  78.   DATA_FILEFORMAT = 5;
  79.   DATA_FILEHTML_URL = 6;
  80.   DATA_EXCERPT = 7;
  81.   DATA_DESCRIPTION = 8;
  82.   DATA_CATEGORY = 9;
  83.   DATA_CATEGORY_URL = 10;
  84.   DATA_PROPERTIES = 11;
  85.   DATA_CACHE_URL = 12;
  86.   DATA_RELATED_URL = 13;
  87.  
  88.   G_COLORS: array[1..13] of TColor = (
  89.     clDkGray,
  90.     clBlack,
  91.     clBlue,
  92.     clBlack,
  93.     clGray,
  94.     clBlack,
  95.     clBlack,
  96.     clBlack,
  97.     clBlack,
  98.     clBlack,
  99.     clGreen,
  100.     clGray,
  101.     clGray);
  102.  
  103.   { ---------------------------------------------------------------------------- }
  104.  
  105. procedure TfrmGoogle.FormCreate(Sender: TObject);
  106. begin
  107.   Application.OnMessage := AppMessage;
  108.   DragAcceptFiles(tvResults.Handle, True);
  109. end;
  110.  
  111. { ---------------------------------------------------------------------------- }
  112.  
  113. procedure TfrmGoogle.FormDestroy(Sender: TObject);
  114. begin
  115.   Application.OnMessage := nil;
  116.   DragAcceptFiles(tvResults.Handle, False);
  117. end;
  118.  
  119. { ---------------------------------------------------------------------------- }
  120.  
  121. procedure TfrmGoogle.AppMessage(var Msg: TMsg; var Handled: Boolean);
  122. var
  123.   s: array[0..MAX_PATH] of AnsiChar;
  124. begin
  125.   if Msg.Message = WM_DROPFILES then
  126.     begin
  127.       DragQueryFile(Msg.wParam, 0, s, SizeOf(s));
  128.       DragFinish(Msg.wParam);
  129.       ParseFile(s);
  130.       Handled := True;
  131.     end;
  132. end;
  133.  
  134. { ---------------------------------------------------------------------------- }
  135.  
  136. procedure TfrmGoogle.ParseFile(const f: AnsiString);
  137. var
  138.   s: TFileStream;
  139. begin
  140.   Caption := f +  ' - ' + APP_TITLE;
  141.  
  142.   s := TFileStream.Create(f, fmOpenRead or fmShareDenyWrite);
  143.   try
  144.     tvResults.Items.BeginUpdate;
  145.     try
  146.       FFileNode := tvResults.Items.Add(nil, 'File: ' + f);
  147.       FFileNode.Data := Pointer(DATA_FILE);
  148.  
  149.       DIHtmlParser1.SourceStream := s;
  150.       DIHtmlParser1.Reset;
  151.       DIHtmlParser1.ParseAll;
  152.  
  153.       lblQuery.Caption := 'Searched for: ' + DIHtmlGooglePlugin1.Query;
  154.     finally
  155.       tvResults.Items.EndUpdate;
  156.     end;
  157.   finally
  158.     s.Free;
  159.   end;
  160. end;
  161.  
  162. { ---------------------------------------------------------------------------- }
  163.  
  164. procedure TfrmGoogle.Image1Click(Sender: TObject);
  165. begin
  166. end;
  167.  
  168. { ---------------------------------------------------------------------------- }
  169.  
  170. procedure TfrmGoogle.DIHtmlGooglePlugin1Result(const Sender: TDIHtmlParserPlugin);
  171. var
  172.   ItemNode: TTreeNode;
  173. begin
  174.   ItemNode := tvResults.Items.AddChild(FFileNode, TDIHtmlGooglePlugin(Sender).Title);
  175.   ItemNode.Data := Pointer(DATA_TITLE);
  176.   if TDIHtmlGooglePlugin(Sender).LinkUrl <> '' then
  177.     tvResults.Items.AddChild(ItemNode, 'URL: ' + TDIHtmlGooglePlugin(Sender).LinkUrl).Data := Pointer(DATA_URL);
  178.   if TDIHtmlGooglePlugin(Sender).TranslationUrl <> '' then
  179.     tvResults.Items.AddChild(ItemNode, 'Translation: ' + TDIHtmlGooglePlugin(Sender).TranslationUrl).Data := Pointer(DATA_TRANSLATION);
  180.   if TDIHtmlGooglePlugin(Sender).FileFormat <> '' then
  181.     tvResults.Items.AddChild(ItemNode, 'FileFormat: ' + TDIHtmlGooglePlugin(Sender).FileFormat).Data := Pointer(DATA_FILEFORMAT);
  182.   if TDIHtmlGooglePlugin(Sender).FileHtmlUrl <> '' then
  183.     tvResults.Items.AddChild(ItemNode, 'FileHTML URL: ' + TDIHtmlGooglePlugin(Sender).FileHtmlUrl).Data := Pointer(DATA_FILEHTML_URL);
  184.   if TDIHtmlGooglePlugin(Sender).Abstract <> '' then
  185.     tvResults.Items.AddChild(ItemNode, 'Excerpt: ' + TDIHtmlGooglePlugin(Sender).Abstract).Data := Pointer(DATA_EXCERPT);
  186.   if TDIHtmlGooglePlugin(Sender).Description <> '' then
  187.     tvResults.Items.AddChild(ItemNode, 'Description: ' + TDIHtmlGooglePlugin(Sender).Description).Data := Pointer(DATA_DESCRIPTION);
  188.   if TDIHtmlGooglePlugin(Sender).Category <> '' then
  189.     tvResults.Items.AddChild(ItemNode, 'Category: ' + TDIHtmlGooglePlugin(Sender).Category).Data := Pointer(DATA_CATEGORY);
  190.   if TDIHtmlGooglePlugin(Sender).CategoryUrl <> '' then
  191.     tvResults.Items.AddChild(ItemNode, 'Category-URL: ' + TDIHtmlGooglePlugin(Sender).CategoryUrl).Data := Pointer(DATA_CATEGORY_URL);
  192.   if TDIHtmlGooglePlugin(Sender).Properties <> '' then
  193.     tvResults.Items.AddChild(ItemNode, 'Properties: ' + TDIHtmlGooglePlugin(Sender).Properties).Data := Pointer(DATA_PROPERTIES);
  194.   if TDIHtmlGooglePlugin(Sender).CacheUrl <> '' then
  195.     tvResults.Items.AddChild(ItemNode, 'Cache-URL: ' + TDIHtmlGooglePlugin(Sender).CacheUrl).Data := Pointer(DATA_CACHE_URL);
  196.   if TDIHtmlGooglePlugin(Sender).RelatedUrl <> '' then
  197.     tvResults.Items.AddChild(ItemNode, 'Related-URL: ' + TDIHtmlGooglePlugin(Sender).RelatedUrl).Data := Pointer(DATA_RELATED_URL);
  198. end;
  199.  
  200. { ---------------------------------------------------------------------------- }
  201.  
  202. procedure TfrmGoogle.tvResultsCustomDrawItem(Sender: TCustomTreeView;
  203.   Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
  204. begin
  205.   case Cardinal(Node.Data) of
  206.     DATA_FILE:
  207.       Sender.Canvas.Font.Style := [fsBold];
  208.     DATA_TITLE:
  209.       Sender.Canvas.Font.Style := [fsBold];
  210.   end;
  211.  
  212.   if (State = []) and (Node.Data <> nil) then
  213.     begin
  214.       Sender.Canvas.Font.Color := G_COLORS[Cardinal(Node.Data)];
  215.     end;
  216. end;
  217.  
  218. { ---------------------------------------------------------------------------- }
  219.  
  220. procedure TfrmGoogle.sbnOpenClick(Sender: TObject);
  221. begin
  222.   with TOpenDialog.Create(nil) do
  223.     try
  224.       Filter := 'HTML-files (*.htm;*.html)|*.htm;*.html|All files (*.*)|*.*';
  225.       if Execute then
  226.         ParseFile(FileName);
  227.     finally
  228.       Free;
  229.     end;
  230. end;
  231.  
  232. { ---------------------------------------------------------------------------- }
  233.  
  234. procedure TfrmGoogle.sbnExpandClick(Sender: TObject);
  235. begin
  236.   tvResults.FullExpand;
  237. end;
  238.  
  239. { ---------------------------------------------------------------------------- }
  240.  
  241. procedure TfrmGoogle.sbnCollapseClick(Sender: TObject);
  242. begin
  243.   tvResults.FullCollapse;
  244. end;
  245.  
  246. { ---------------------------------------------------------------------------- }
  247.  
  248. procedure TfrmGoogle.sbnClearClick(Sender: TObject);
  249. begin
  250.   tvResults.Items.Clear;
  251. end;
  252.  
  253. { ---------------------------------------------------------------------------- }
  254.  
  255. initialization
  256.   RegisterHtmlTags;
  257.   RegisterHtmlAttribs;
  258.   RegisterHtmlDecodingEntities;
  259.   RegisterHtmlColors;
  260.   RegisterCharSets;
  261.  
  262. end.
  263.  
  264.