Pomoc oko debagovanja aplikacije sa tridovima .

[ reikonija @ 07.02.2012. 21:04 ] @

Moja aplikacija pokrece 2 trida (en. threads) koja prvo preko kriticne sekcije uzimaju broj linka koji skidaju u tstringlist i preradjuju tj. parsuju i dodaju preko kriticne sekciju u glvani form1 trid.

Moj problem je :
1. Kako da podesim timeout u tridu , sta ako korisnik izgubi internet konekciju ili ako mu konekcija oslabi npr. ako je na javnom wifi , zelim da trid prekine i dealocira sve resurse , sad ne znam dal mi je bolje da ga ugasim unutar trida preko onterminate procedure ili da ga ugasim preko postmessage i pustim glavni trid da ga pravilno oslobodi.
2. Imam problem prilikom gasenja trida , uslov je ako trid preradi npr 60 linkova koje dadaje u listbox u glavnom programu ja ga gasim tj. preko for petlje gasim broj tridova koji je pokrenut (tu imam neki problem)
3. Bilo kakve sugestije kako da poboljsam trid jer sa svojim znanjem mislim da i nisam nesto napravio , opet mi je glavni trid ponekad blokiran.

Kod glavnog trida :

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..1] 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 1 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 1 do
  begin

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

   end;
   end;

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

end.

Kod trida koji treba da obavlja 'teski' posao:

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/aja...es/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.

Neko mi je predlozio da idem skidanje sorsa u tridu i prebacivanjem u glavni trid da ostavim posao parsiranja glavnom tridu , sad ne znam dal je to pametno.
Hvala na odgovorima , muci me ovo vec duze vreme.

[ reiser @ 07.02.2012. 22:08 ] @

Nisam ni ja neki guru za threadove, ali mi se na prvi pogled ovo cini kao vrlo lose realizovano resenje, recimo, ti iz threada pristupas form objektu, dok je to dozvoljeno samo unutar Synchronize() procedure, tj u threadu ne smes da pristupas non-thread-safe objektima.

Takodje, google ajax api vraca rezultat kao JSON, tako da bih ti preporucio da koristis neki JSON parser za to, recimo JSON – SuperObject

[ reiser @ 08.02.2012. 00:51 ] @

Evo, nije me mrzelo da ti odradim ovo, a i meni je bilo zanimljivo :)

Imas uGoogleThread (TThdGoogle klasa) i uGoogleThreadManager (TThdGoogleManager) klasa unite.

Ti ne bi trebao da imas nikakvog kontakta sa TThdGoogle klasom, osim sto se struktura TURLItem nalazi u njoj, pa zbog toga moras da stavis uGoogleThread u uses u implementation delu unita koji pripada tvojoj formi.

TThdGoogle klasa skida stranicu sa neta, parsuje je pomocu JSON SuperObjecta i poziva FOnNewData() proceduru, tj property koji ti prilikom kreiranja klase assignujes na neku proceduru.
Nakon skidanja se setuje FPaused property klase na TRUE, i ceka se da se thread odpauzira, tj da se pozove Unpaused() funkcija. Za ovo sam koristio event-driven mehanizam (CreateEvent, SetEvent, ResetEvent, WaitForSingleObject). Mogao sam da umesto WaitForSingleObject(FPauseEvent, INFINITE) stavim While FPaused Do Sleep(), ali je pristup sa eventima mnogo bolji (ne trosi dodatni CPU).

TThdGoogleManager klasa obavlja menadzment TThdGoogle threadova, tj prvo ih kreira, zatim kada thread zavrsi sa radom (tj FPaused property bude TRUE), povecava mu LinkIndex na sledeci koji treba da se skine sa neta i poziva .Unpause(), tj kaze mu da nastavi sa radom.

uGoogleThread.pas

Code:

unit uGoogleThread;

interface

uses
  Classes, OverbyteIcsWndControl, OverbyteIcsHttpProt;

type
  PURLItem = ^TURLItem;
  TURLItem = record
               URL        : String;
               VisibleURL : String;
             end;

  TOnNewData = procedure(const AData : TList) of object;

  TThdGoogle = class(TThread)
               private
                 FHTTPClient : THttpCli;
                 FLinkIndex  : Integer;
                 FURLList    : TList;
                 FProxy      : String;
                 FForm       : pointer;
                 FPaused     : Boolean;
                 FPauseEvent : THandle;
                 FOnNewData  : TOnNewData;

                 procedure ClearURLList;
                 procedure HttpRequestDone(Sender: TObject; RqType: THttpRequest; ErrCode: Word);
                 procedure UpdateData;
                 procedure SetLinkIndex(const AValue : Integer);
               protected
                 procedure Execute; override;
               public
                 constructor Create(const AForm : pointer; const ALinkIndex : Integer; const AProxy : String = '');

                 procedure Unpause;

                 property LinkIndex : Integer read FLinkIndex write SetLinkIndex;
                 property Paused    : Boolean read FPaused;
                 property OnNewData : TOnNewData read FOnNewData write FOnNewData;
               end;

implementation

uses
  Windows, SysUtils, superobject;

constructor TThdGoogle.Create(const AForm : pointer; const ALinkIndex : Integer; const AProxy : String = '');
begin
  FForm := AForm;
  FLinkIndex := ALinkIndex;
  FProxy := AProxy;
  FPaused := FALSE;

  inherited Create(FALSE);
end;

procedure TThdGoogle.Unpause;
begin
  SetEvent(FPauseEvent);
end;

procedure TThdGoogle.UpdateData;
begin
  If Assigned(FOnNewData) Then
    FOnNewData(FURLList);
end;

procedure TThdGoogle.ClearURLList;
var
  C1 : Integer;
begin
  If Assigned(FURLList) Then
  Begin
    For C1 := 0 to FURLList.Count - 1 Do
      Dispose(PURLItem(FURLList[C1]));
    FURLList.Clear;
  End;
end;

procedure TThdGoogle.SetLinkIndex(const AValue : Integer);
begin
  If FPaused Then
    FLinkIndex := AValue;
end;

procedure TThdGoogle.Execute;
var
  Success : Boolean;
begin
  FPauseEvent := CreateEvent(nil, FALSE, FALSE, nil);

  FURLList := TList.Create;

  FHTTPClient := THTTPCli.Create(Nil);
  FHTTPClient.MultiThreaded := TRUE;
  FHTTPClient.RcvdStream := TMemoryStream.Create;
  FHTTPClient.Proxy := FProxy;
  FHTTPClient.OnRequestDone := HttpRequestDone;
  FHTTPClient.Timeout := 5;

  While not Terminated Do
  Begin
    FPaused := FALSE;
    SetEvent(FPauseEvent);

    FHTTPClient.URL := Format('http://ajax.googleapis.com/aja...&rsz=large&q=rocksongs', [FLinkIndex]);
    (FHTTPClient.RcvdStream as TMemoryStream).Clear;

    ClearURLList;
    try
      FHTTPClient.Get;
      Success := TRUE;
    except
      Success := FALSE;
    end;

    If (not Terminated) and
       (Success) THen
    Begin
      Synchronize(UpdateData);
      FPaused := TRUE;
      ResetEvent(FPauseEvent);
      WaitForSingleObject(FPauseEvent, INFINITE);
    End;
  End;

  If Assigned(FHTTPClient.RcvdStream) Then
    FHTTPClient.RcvdStream.Free;
  FHTTPClient.Free;

  ClearURLList;
  FURLList.Free;

  CloseHandle(FPauseEvent);
end;

procedure TThdGoogle.HttpRequestDone(Sender: TObject; RqType: THttpRequest; ErrCode: Word);
var
  JSON            : ISuperObject;
  jsonItem        : ISuperObject;
  response        : String;
  urlItem         : PURLItem;
begin
  If ErrCode <> 0 Then
  Begin
    // err handling, errcode <> 0
  End
  else
  Begin
    If THTTPCli(Sender).StatusCode <> 200 Then
    Begin
      // err handling, statuscode <> 200
    End
    else
    Begin
      If (Assigned(THTTPCli(Sender).RcvdStream)) and
         (THTTPCli(Sender).RcvdCount > 0) Then
      Begin
        THTTPCli(Sender).RcvdStream.Position := 0;
        JSON := TSuperObject.ParseStream(THTTPCli(Sender).RcvdStream, FALSE);
        response := JSON.AsString;

        If (JSON.S['responseData'] <> '') and
           (JSON['responseData'].S['results'] <> '' ) Then
          For jsonItem in JSON['responseData']['results'] Do
          Begin
            New(urlItem);
            urlItem^.URL := jsonItem.S['url'];
            urlItem^.VisibleURL := jsonItem.S['visibleUrl'];
            FURLList.Add(urlItem);
          End;

        JSON := nil;
      End
      else
      Begin
        // err handling, received count = 0
      End;
    End;
  End;
end;

end.

uGoogleThreadManager.pas

Code:

unit uGoogleThreadManager;

interface

uses
  Classes, uGoogleThread;

type
  TThdGoogleManager = class(TThread)
                      private
                        FThreadCount : Integer;
                        FThreads     : Array of TThdGoogle;
                        FStartIndex  : Integer;
                        FStep        : Integer;
                        FForm        : pointer;
                        FNextIndex   : Integer;
                        FOnNewData   : TOnNewData;
                      protected
                        procedure Execute; override;
                      public
                        constructor Create(const AForm : pointer; const AThreadCount : Integer; const AStartIndex : Integer = 0; const AStep : Integer = 8);

                        property ThreadCount : Integer read FThreadCount;
                        property OnNewData : TOnNewData read FOnNewData write FOnNewData;
                      end;

implementation

uses
  Windows, SysUtils;

constructor TThdGoogleManager.Create(const AForm : pointer; const AThreadCount : Integer; const AStartIndex : Integer = 0; const AStep : Integer = 8);
begin
  inherited Create(TRUE);

  FForm := AForm;
  FStartIndex := AStartIndex;
  FStep := AStep;
  FThreadCount := AThreadCount;
  SetLength(FThreads, FThreadCount);
end;

procedure TThdGoogleManager.Execute;
var
  C1 : Integer;
begin
  FNextIndex := FStartIndex;

  While not Terminated Do
  Begin
    For C1 := 0 to FThreadCount - 1 Do
      If not Assigned(FThreads[C1]) Then
      Begin
        FThreads[C1] := TThdGoogle.Create(FForm, FNextIndex);
        FThreads[C1].OnNewData := FOnNewData;
        Inc(FNextIndex, FStep);
      End
      else
      Begin
        If FThreads[C1].Paused Then
        Begin
          FThreads[C1].LinkIndex := FNextIndex;
          FThreads[C1].OnNewData := FOnNewData;
          Inc(FNextIndex, FStep);
          FThreads[C1].Unpause;
        End;
      End;

    Sleep(50);
  End;

  For C1 := 0 to FThreadCount - 1 Do
    If Assigned(FThreads[C1]) Then
    Begin
      FThreads[C1].Terminate;
      FThreads[C1].Unpause;
      FThreads[C1].WaitFor;
      FThreads[C1].Free;
    End;
end;

end.

uMainWindow.pas

Code:

unit uMainWindow;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, uGoogleThreadManager;

type
  TMainWindow = class(TForm)
    btStart: TButton;
    btClear: TButton;
    Memo: TMemo;
    procedure btStartClick(Sender: TObject);
    procedure btClearClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure StopThreadManager;
  private
    FThdGoogle : TThdGoogleManager;

    procedure OnNewData(const AData : TList);
  public
  end;

var
  MainWindow: TMainWindow;

implementation

{$R *.dfm}

uses
  superobject, uGoogleThread;

procedure TMainWindow.btClearClick(Sender: TObject);
begin
  Memo.Clear;
end;

procedure TMainWindow.StopThreadManager;
begin
  FThdGoogle.Terminate;
  FThdGoogle.WaitFor;
  FreeAndNil(FThdGoogle);
end;

procedure TMainWindow.btStartClick(Sender: TObject);
begin
  If Assigned(FThdGoogle) Then
  Begin
    StopThreadManager;
    TButton(Sender).Caption := 'Start';
  End
  else
  Begin
    FThdGoogle := TThdGoogleManager.Create(self, 4);
    FThdGoogle.OnNewData := OnNewData;
    FThdGoogle.Start;
    TButton(Sender).Caption := 'Stop';
  End;
end;

procedure TMainWindow.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  If Assigned(FThdGoogle) Then
    StopThreadManager;
end;

procedure TMainWindow.OnNewData(const AData : TList);
var
  item : TURLItem;
  C1   : Integer;
begin
  For C1 := 0 to AData.Count - 1 Do
  Begin
    item := TURLItem(AData[C1]^);
    Memo.Lines.Add(item.URL);
    Memo.Lines.Add(item.VisibleURL);
    Memo.Lines.Add('');
  End;
end;

end.

Ceo projekat u attachu.

[ reikonija @ 12.02.2012. 20:44 ] @

Hvala na extra kodu , i sto si nasao vremena da mi to postavis i na download , tvoj pristup je daleko drugaciji od moga , ali je i daleko funkcionalniji.....