- Delphi thread [Review my code] [closed]
- 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.
- 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.