Take the 2-minute tour ×
Code Review Stack Exchange is a question and answer site for peer programmer code reviews. It's 100% free, no registration required.

My code has to download the source code of a page and parse it for URLs. I want it to ask for number which is increased inside the critical section. My problem happens on thread termination.

Main form code:

    unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OverbyteIcsWndControl, OverbyteIcsHttpProt, StdCtrls,Unit2, Spin;
const
  WM_DATA_IN_BUF = WM_APP + 1000;

type
  TForm1 = class(TForm)
    HttpCli1: THttpCli;
    Button1: TButton;
    ListBox1: TListBox;
    Memo1: TMemo;
    Button2: TButton;
    SpinEdit1: TSpinEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    FStringSectInit: boolean;
    FGoogle: array [0..2] of TGoogle;
    FStringBuf: TStringList;
    FLink:integer;
    procedure HandleNewData(var Message: TMessage); message WM_DATA_IN_BUF;
  public
     StringSection: TRTLCriticalSection;
    property StringBuf: TStringList read FStringBuf write FStringBuf;
    property Link: integer read FLink write FLink;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
  if not FStringSectInit then
  begin
    form1.FLink:=0;
    InitializeCriticalSection(StringSection);
    FStringBuf := TStringList.Create;
    FStringSectInit := true;
     for i:=0 to 2 do
     begin
    FGoogle[i]:= TGoogle.Create(true);
    SetThreadPriority(FGoogle[i].Handle, THREAD_PRIORITY_BELOW_NORMAL);
    FGoogle[i].Resume;
    end;
    end;
    end;





procedure TForm1.HandleNewData(var Message: TMessage);
var k,i,s:integer;

begin
  if FStringSectInit then
  begin
    EnterCriticalSection(StringSection);
    s:=flink;
    inc(s,8);
    flink:=s;

    memo1.Lines.Add(FStringBuf.Text);

    FStringBuf.Clear;
    LeaveCriticalSection(StringSection);
    {Now trim the Result Memo.}
  end;
  if form1.Memo1.Lines.Count>20 then
for k:=0 to 2 do
  begin

  fgoogle[k].Terminate;
  fgoogle[k].WaitFor;
  fgoogle[k].Free;
  FStringBuf.Free;
  DeleteCriticalSection(StringSection);
  FStringSectInit := false;
  memo1.Lines.Add('Thread is done: ' + inttostr(k));

   end;
   end;

procedure TForm1.Button2Click(Sender: TObject);
begin
listbox1.Clear;
end;

end.

Worker thread code:

    unit Unit2;

interface

uses
  Classes,Windows,IDHTTP, OverbyteIcsWndControl, StdCtrls,OverbyteIcsHttpProt,SysUtils,Dialogs;

type
  TGoogle = class(TThread)
  private
google:TStringList;
    Upit:string;
    Broj:integer;
    Buffer : TStringList;
    httpcli1:THTTPcli;
  protected
    procedure parsegoogleapi;
    procedure SkiniSors;
    procedure Execute; override;
  public
    property StartNum: integer read Broj write Broj;
  end;

implementation
uses unit1,StrUtils;

function ExtractText(const Str, Delim1, Delim2: string; PosStart: integer; var PosEnd: integer): string;
var
 pos1, pos2: integer;
begin
    Result := '';
    pos1 := PosEx(Delim1, Str, PosStart);
    if pos1 > 0 then
    begin
    pos2 := PosEx(Delim2, Str, pos1 + Length(Delim1));
    if pos2 > 0 then
    begin
      PosEnd := pos2 + Length(Delim2);
      Result := Copy(Str, pos1 + Length(Delim1), pos2 - (pos1 + Length(Delim1)));
end;
end;
end;
function ChangeString(const Value: string; replace:string): string;
var i: Integer;
begin
    Result := '';
    for i := 1 to Length(Value) do
    if Value[i] = ' ' then
    Result := Result + replace
    else
    Result := Result + Value[i]
end;

(*Ovo je procedura za skidanje sorsa*)

procedure TGoogle.SkiniSors;
var
criter:string;

begin
HttpCli1:=THttpCli.Create(nil);
google:=TStringList.Create;
criter:= ChangeString(Upit,'%20');

With HttpCli1 do begin
    URL            := 'http://ajax.googleapis.com/ajax/services/search/web?v=1.0&start=' + inttostr(broj) + '&rsz=large&q=rocksongs';
    RequestVer     := '1.1';
    Connection := 'Keep-Alive';
    RcvdStream := TMemoryStream.Create;
    try
        Get;
    except
        RcvdStream.Free;
        Exit;
        (*How can I terminate thread here if I get error*)
    end;
RcvdStream.Seek(0,0);
google.LoadFromStream(RcvdStream);
RcvdStream.Free;
ParseGoogleApi;
end;
end;

procedure TGoogle.ParseGoogleApi;
var Pos: integer;
    sText: string;
begin
Buffer:= TStringList.Create;
  sText := ExtractText(google.Text, '"url":"', '","visibleUrl"', 1, Pos);
  while sText <> '' do
  begin
    buffer.Add(sText);
        sText := ExtractText(google.Text, '"url":"', '","visibleUrl"', Pos, Pos);
  end;
  google.Clear;
end;


procedure TGoogle.Execute;
var i:integer;
begin
 while not terminated do
  begin
  EnterCriticalSection(Form1.StringSection);
  Broj:=form1.Link;
  skinisors;

  Form1.StringBuf.Add(buffer.Text);
  LeaveCriticalSection(Form1.StringSection);
  PostMessage(Form1.Handle, WM_DATA_IN_BUF, 0, 0);

  end;
Google.Free;
Buffer.Free;
httpcli1.Free;
end;
end.

Also, how do I deal with timeouts with THttpCli1? Is it a smart idea to use Timer inside threads?

share|improve this question
1  
It's been a while since I've done Delphi, but make sure the code between EnterCriticalSection and LeaveCriticalSection are within try..finally to clean up properly in the event of exceptional situations. –  Jesse C. Slicer Feb 10 '12 at 16:30
    
Thanks for that , adding it right now :) –  Danijel Maksimovic Maxa Feb 10 '12 at 16:46

1 Answer 1

up vote 1 down vote accepted

I haven't looked closely at your code .. yet. But I did a similar project some months ago. First off ...

    Exit;
    (*How can I terminate thread here if I get error*)

Should be simple enough. Change skinisors into a function skinisors : boolean and let it do the Exit(false);

I've just realized you are on Delphi7. I can't remember if you can do a Exit(false) there, so just do it the old-fashioned way.

Result := false;
Exit;

Then in your execute of thread, you of course will have to change the main criteria for when to terminate into something that also includes the result of the function.

I remember I used TDownloadUrl for getting a complete URL - and then parsing it with JvclHtmlParser. I can dig up the project and see if it could help you - if you are interested?

share|improve this answer
    
If you can upload it to any free file sharing sites , it would be great.Thanks for answer :) –  Danijel Maksimovic Maxa Feb 10 '12 at 16:08
    
@DanijelMaksimovicMaxa. You could try this. Building on two specifik resources: Wiki TJvHTMLParser: wiki.delphi-jedi.org/wiki/JVCL_Help:TJvHTMLParser and Using TDownloadURL: delphi.about.com/od/networking/a/html_scraping.htm ... SearchURL := <some url string>; // parse with TJvHTMLParser.Create(nil) do try FileName := tmpFileName; ClearConditions; AddCondition('URL', 'URL', '</td>'); // Look for URL OnKeyFoundEx := PageSectionFound; // your method for doing the string thing ..... AnalyseFile; finally Free; end; –  Bimmer_R Feb 13 '12 at 20:27

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.