Question

So my code does this:

1. Download page in thread
2. Parse the page
3. Send it to main thread

All that is done over critical section and postmessage .
IF anyone could review it fix it change it , or anything else that could make it better.

Main VCL form :

    unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    HttpCli1: THttpCli;
    Button1: TButton;
    ListBox1: TListBox;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    FStringSectInit: boolean;
    FGoogle: TGoogle;
    FStringBuf: TStringList;
    procedure HandleNewData(var Message: TMessage); message WM_DATA_IN_BUF;
  public
     StringSection: TRTLCriticalSection;
    property StringBuf: TStringList read FStringBuf write FStringBuf;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not FStringSectInit then
  begin
    InitializeCriticalSection(StringSection);
    FStringBuf := TStringList.Create;
    FStringSectInit := true;
    FGoogle := TGoogle.Create(true);
    SetThreadPriority(FGoogle.Handle, THREAD_PRIORITY_BELOW_NORMAL);
    try
      FGoogle.StartNum := 8;
    except
      on EConvertError do FGoogle.StartNum := 2;
    end;
    FGoogle.Resume;
  end;
end;

procedure TForm1.HandleNewData(var Message: TMessage);
var i:integer;
begin
  if FStringSectInit then
  if listbox1.Items.Count<10 then
  begin
    EnterCriticalSection(StringSection);
    for i:=0 to 5 do
    if length(fstringbuf.Text)>10 then
    begin
    listbox1.Items.Add(FStringBuf.Strings[i]);
    end
    else
    FStringBuf.Clear;
    LeaveCriticalSection(StringSection);
    {Now trim the Result Memo.}
  end
  else
  begin
    with FGoogle do
    begin
      Terminate;
      WaitFor;
      Free;
    end;
   FGoogle := nil;
    FStringBuf.Free;
    FStringBuf := nil;
    DeleteCriticalSection(StringSection);
    FStringSectInit := false;
  end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if listbox1.Items.Count>80 then
end;

end.

And the Thread :

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;
  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
HttpCli1 : THttpCli;
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=index.php';
    RequestVer     := '1.1';
    RcvdStream := TMemoryStream.Create;
    try
        Get;
    except
        ShowMessage('There has been an error , check your internet connection !');
        RcvdStream.Free;
        Exit;
    end;

RcvdStream.Seek(0,0);
google.LoadFromStream(RcvdStream);
RcvdStream.Free;
 broj:=broj+8;
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;
end;


procedure TGoogle.Execute;
var
  CurrentNum: integer;
  i:integer;

begin

  CurrentNum := Broj;
  while not terminated do
  begin
  skinisors;
      EnterCriticalSection(Form1.StringSection);
      for i:=0 to 5 do                        begin
      Form1.StringBuf.Add(buffer.strings[i]);
      end;
      LeaveCriticalSection(Form1.StringSection);
      PostMessage(Form1.Handle, WM_DATA_IN_BUF, 0, 0);

    end;


end;
end.

So I want to know how can I stop the thread when page timeouts or if user gets disconnected etc.. so that thread can be terminated properly.

I want to start 3 instances of this thread and every instance should access critical section take one link ex link[i] where i is integer value that is incremented by thread which has ownership over critical section at that moment. Thanks

Answer 1

Give your thread a constructor, and in that constructor set FreeOnTerminate := True;.

In the thread’s execute method you can then call Terminate; on page timeout or disconnection.