Don't like ads? PRO users don't see any ads ;-)
Guest

Untitled

By: a guest on May 2nd, 2012  |  syntax: None  |  size: 4.59 KB  |  hits: 13  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. Delphi thread [Review my code] [closed]
  2. Main VCL form :
  3.  
  4.     unit Unit1;
  5.  
  6. interface
  7.  
  8. uses
  9.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  10.   Dialogs, OverbyteIcsWndControl, OverbyteIcsHttpProt, StdCtrls,Unit2;
  11. const
  12.   WM_DATA_IN_BUF = WM_APP + 1000;
  13.  
  14. type
  15.   TForm1 = class(TForm)
  16.     HttpCli1: THttpCli;
  17.     Button1: TButton;
  18.     ListBox1: TListBox;
  19.     Memo1: TMemo;
  20.     Button2: TButton;
  21.     procedure Button1Click(Sender: TObject);
  22.     procedure Button2Click(Sender: TObject);
  23.   private
  24.     FStringSectInit: boolean;
  25.     FGoogle: TGoogle;
  26.     FStringBuf: TStringList;
  27.     procedure HandleNewData(var Message: TMessage); message WM_DATA_IN_BUF;
  28.   public
  29.      StringSection: TRTLCriticalSection;
  30.     property StringBuf: TStringList read FStringBuf write FStringBuf;
  31.   end;
  32.  
  33. var
  34.   Form1: TForm1;
  35.  
  36. implementation
  37.  
  38. {$R *.dfm}
  39.  
  40. procedure TForm1.Button1Click(Sender: TObject);
  41. begin
  42.   if not FStringSectInit then
  43.   begin
  44.     InitializeCriticalSection(StringSection);
  45.     FStringBuf := TStringList.Create;
  46.     FStringSectInit := true;
  47.     FGoogle := TGoogle.Create(true);
  48.     SetThreadPriority(FGoogle.Handle, THREAD_PRIORITY_BELOW_NORMAL);
  49.     try
  50.       FGoogle.StartNum := 8;
  51.     except
  52.       on EConvertError do FGoogle.StartNum := 2;
  53.     end;
  54.     FGoogle.Resume;
  55.   end;
  56. end;
  57.  
  58. procedure TForm1.HandleNewData(var Message: TMessage);
  59. var i:integer;
  60. begin
  61.   if FStringSectInit then
  62.   if listbox1.Items.Count<10 then
  63.   begin
  64.     EnterCriticalSection(StringSection);
  65.     for i:=0 to 5 do
  66.     if length(fstringbuf.Text)>10 then
  67.     begin
  68.     listbox1.Items.Add(FStringBuf.Strings[i]);
  69.     end
  70.     else
  71.     FStringBuf.Clear;
  72.     LeaveCriticalSection(StringSection);
  73.     {Now trim the Result Memo.}
  74.   end
  75.   else
  76.   begin
  77.     with FGoogle do
  78.     begin
  79.       Terminate;
  80.       WaitFor;
  81.       Free;
  82.     end;
  83.    FGoogle := nil;
  84.     FStringBuf.Free;
  85.     FStringBuf := nil;
  86.     DeleteCriticalSection(StringSection);
  87.     FStringSectInit := false;
  88.   end;
  89. end;
  90. procedure TForm1.Button2Click(Sender: TObject);
  91. begin
  92. if listbox1.Items.Count>80 then
  93. end;
  94.  
  95. end.
  96.        
  97. unit Unit2;
  98.  
  99. interface
  100.  
  101. uses
  102.   Classes,Windows,IDHTTP, OverbyteIcsWndControl, StdCtrls,OverbyteIcsHttpProt,SysUtils,Dialogs;
  103.  
  104. type
  105.   TGoogle = class(TThread)
  106.   private
  107. google:TStringList;
  108.     Upit:string;
  109.     Broj:integer;
  110.     Buffer : TStringList;
  111.   protected
  112.     procedure parsegoogleapi;
  113.     procedure SkiniSors;
  114.     procedure Execute; override;
  115.   public
  116.     property StartNum: integer read Broj write Broj;
  117.   end;
  118.  
  119. implementation
  120. uses unit1,StrUtils;
  121.  
  122. function ExtractText(const Str, Delim1, Delim2: string; PosStart: integer; var PosEnd: integer): string;
  123. var
  124.  pos1, pos2: integer;
  125. begin
  126.     Result := '';
  127.     pos1 := PosEx(Delim1, Str, PosStart);
  128.     if pos1 > 0 then
  129.     begin
  130.     pos2 := PosEx(Delim2, Str, pos1 + Length(Delim1));
  131.     if pos2 > 0 then
  132.     begin
  133.       PosEnd := pos2 + Length(Delim2);
  134.       Result := Copy(Str, pos1 + Length(Delim1), pos2 - (pos1 + Length(Delim1)));
  135. end;
  136. end;
  137. end;
  138. function ChangeString(const Value: string; replace:string): string;
  139. var i: Integer;
  140. begin
  141.     Result := '';
  142.     for i := 1 to Length(Value) do
  143.     if Value[i] = ' ' then
  144.     Result := Result + replace
  145.     else
  146.     Result := Result + Value[i]
  147. end;
  148.  
  149. (*Ovo je procedura za skidanje sorsa*)
  150.  
  151. procedure TGoogle.SkiniSors;
  152. var
  153. HttpCli1 : THttpCli;
  154. criter:string;
  155.  
  156. begin
  157.  
  158. HttpCli1:=THttpCli.Create(nil);
  159. google:=TStringList.Create;
  160. criter:= ChangeString(Upit,'%20');
  161.  
  162. With HttpCli1 do begin
  163.     URL            := 'http://ajax.googleapis.com/ajax/services/search/web?v=1.0&start=' + inttostr(broj) + '&rsz=large&q=index.php';
  164.     RequestVer     := '1.1';
  165.     RcvdStream := TMemoryStream.Create;
  166.     try
  167.         Get;
  168.     except
  169.         ShowMessage('There has been an error , check your internet connection !');
  170.         RcvdStream.Free;
  171.         Exit;
  172.     end;
  173.  
  174. RcvdStream.Seek(0,0);
  175. google.LoadFromStream(RcvdStream);
  176. RcvdStream.Free;
  177.  broj:=broj+8;
  178. ParseGoogleApi;
  179. end;
  180. end;
  181.  
  182. procedure TGoogle.ParseGoogleApi;
  183. var Pos: integer;
  184.     sText: string;
  185. begin
  186. Buffer:= TStringList.Create;
  187.   sText := ExtractText(google.Text, '"url":"', '","visibleUrl"', 1, Pos);
  188.   while sText <> '' do
  189.   begin
  190.     buffer.Add(sText);
  191.  
  192.     sText := ExtractText(google.Text, '"url":"', '","visibleUrl"', Pos, Pos);
  193.   end;
  194. end;
  195.  
  196.  
  197. procedure TGoogle.Execute;
  198. var
  199.   CurrentNum: integer;
  200.   i:integer;
  201.  
  202. begin
  203.  
  204.   CurrentNum := Broj;
  205.   while not terminated do
  206.   begin
  207.   skinisors;
  208.       EnterCriticalSection(Form1.StringSection);
  209.       for i:=0 to 5 do                        begin
  210.       Form1.StringBuf.Add(buffer.strings[i]);
  211.       end;
  212.       LeaveCriticalSection(Form1.StringSection);
  213.       PostMessage(Form1.Handle, WM_DATA_IN_BUF, 0, 0);
  214.  
  215.     end;
  216.  
  217.  
  218. end;
  219. end.