Marco Web Center |
Home: Code Repository: Mastering Delphi 5Project WEBFIND
Project StructureWEBFIND.DPRprogram WebFind; uses Forms, WebFindF in 'WebFindF.pas' {Form1}, FindTh in 'FindTh.pas'; {$R *.RES} begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end. WEBFINDF.PASunit WebFindF; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls; type TForm1 = class(TForm) BtnFind: TButton; Memo1: TMemo; EditSearch: TEdit; StatusBar1: TStatusBar; procedure BtnFindClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} uses FindTh; procedure TForm1.BtnFindClick(Sender: TObject); var FindThread: TFindWebThread; begin // create suspended, set initial values, and start FindThread := TFindWebThread.Create (True); FindThread.FreeOnTerminate := True; FindThread.strUrl := 'http://search.yahoo.com/bin/search?p=' + EditSearch.Text + '&n=100&h=s&b=1'; FindThread.Resume; end; end. FINDTH.PASunit FindTh; interface uses Classes; type TFindWebThread = class(TThread) protected strAddr, strStatus: string; procedure Execute; override; procedure AddToList; procedure ShowStatus; public strUrl: string; end; implementation { TFindWebThread } uses WinInet, WebFindF, SysUtils; procedure TFindWebThread.AddToList; begin Form1.Memo1.Lines.Add (strAddr); end; procedure TFindWebThread.Execute; var hHttpSession, hReqUrl: HInternet; Buffer: array [0..1023] of Char; nRead: Cardinal; strRead: string; nBegin, nEnd: Integer; begin strRead := ''; hHttpSession := InternetOpen ('FindWeb', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); try hReqUrl := InternetOpenURL (hHttpSession, PChar(StrUrl), nil, 0,0,0); strStatus := 'Connected to ' + StrUrl; Synchronize (ShowStatus); try // read all the data repeat InternetReadFile (hReqUrl, @Buffer, sizeof (Buffer), nRead); strRead := strRead + string (Buffer); strStatus := 'Retrieved ' + IntToStr (Length (strRead)) + ' of ' + StrUrl; Synchronize (ShowStatus); until nRead = 0; finally InternetCloseHandle (hReqUrl); end; finally InternetCloseHandle (hHttpSession); end; // extract the HTTP headers strStatus := 'Extracting headers from ' + StrUrl; Synchronize (ShowStatus); strRead := LowerCase (strRead); repeat // find the initial part HTTP reference nBegin := Pos ('href="http', strRead); if nBegin <> 0 then begin // get the remaining part of the string strRead := Copy (strRead, nBegin + 6, Length (strRead) - nBegin - 6); // find the end of the HTTP reference nEnd := Pos ('>', strRead); strAddr := Copy (strRead, 0, nEnd - 2); // add the URL if 'yahoo' is not in it if (strAddr <> '') and (Pos ('yahoo', strAddr) = 0) then Synchronize (AddToList); end; until nBegin = 0; strStatus := 'Done with ' + StrUrl; Synchronize (ShowStatus); end; procedure TFindWebThread.ShowStatus; begin Form1.StatusBar1.SimpleText := strStatus; end; end. WEBFINDF.DFMobject Form1: TForm1 Left = 176 Top = 123 Width = 386 Height = 346 Caption = 'Web Find' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object BtnFind: TButton Left = 284 Top = 16 Width = 75 Height = 23 Anchors = [akTop, akRight] Caption = '&Find' TabOrder = 0 OnClick = BtnFindClick end object Memo1: TMemo Left = 16 Top = 56 Width = 344 Height = 231 Anchors = [akLeft, akTop, akRight, akBottom] ScrollBars = ssVertical TabOrder = 1 end object EditSearch: TEdit Left = 16 Top = 16 Width = 247 Height = 21 Anchors = [akLeft, akTop, akRight] TabOrder = 2 Text = 'Inprise' end object StatusBar1: TStatusBar Left = 0 Top = 300 Width = 378 Height = 19 Panels = <> SimplePanel = True end end
|
||
© Copyright Marco Cantù, 1995-2020, All rights reserved |