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.
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.
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.