• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1404
  • Last Modified:

Each Thread Wait 2 Second

How i can do this, i want on each Thread created in wait 2 second.

my code.

type
TMyThread1 = class(TThread)
private
HTTP1: TIdHTTP;
url1, rs1: String;
procedure Display1;
protected
procedure Execute; override;
public
constructor Create;
destructor Destroy; override;
procedure WEB1;
end;
 
type
TMyThread2 = class(TThread)
ProgressBar1: TProgressBar;
private
HTTP2: TIdHTTP;
url2, rs2: String;
procedure Display2;
protected
procedure Execute; override;
public
constructor Create;
destructor Destroy; override;
procedure WEB2;
end;
constructor TMyThread1.Create;
begin
inherited Create(true);
HTTP1 := TIdHTTP.Create(Application);
HTTP1.HandleRedirects := true;
FreeOnTerminate := true;
end;
 
constructor TMyThread2.Create;
begin
inherited Create(true);
HTTP2 := TIdHTTP.Create(Application);
HTTP2.HandleRedirects := true;
FreeOnTerminate := true;
end;
 
destructor TMyThread1.Destroy;
begin
HTTP1.Free;
inherited;
end;
 
destructor TMyThread2.Destroy;
begin
HTTP2.Free;
inherited;
end;
 
procedure TMyThread1.Display1;
begin
// My code
end;
 
procedure TMyThread2.Display2;
begin
// My code
end;
 
procedure TMyThread1.Execute;
begin
try
rs1 := Http1.Get(Url1);
except
on e:exception do
rs1 := e.Message;
end;
Synchronize(Display1);
end;
 
procedure TMyThread2.Execute;
begin
try
rs2 := Http2.Get(Url2);
except
on e:exception do
rs2 := e.Message;
end;
Synchronize(Display2);
end;
 
Procedure TMyThread1.WEB1;
var
g:integer;
begin
for g:=1 to FinalN +1 do
with TMyThread1.Create do begin
Url1 := 'http//www.site1.com';
ct_dix:=ct_dix+10;
Resume;
end;
end;
 
Procedure TMyThread2.WEB2;
var
y:integer;
begin
for y:=1 to FinalN +1 do
with TMyThread2.Create do begin
Url2 := 'http://www.site1.com';
ct_un2:=ct_un2+10;
Resume;
end;
end;
 
this code work #!1 only 1 problem it take the web page to fast !  i need it wait 2 seconde before creating another thread.
 
 
 
THANK YOU and sorry for my english

Open in new window

0
Clubreseau
Asked:
Clubreseau
  • 7
  • 4
  • 3
  • +1
1 Solution
 
2266180Commented:
you need to learn to write your code in a nice way. identation is a must. As it is, your code is unreadable. Following basic code formatiing rules ensures that everybody can read your code. When you have some time, read through the following: http://www.ciuly.com/forum/viewtopic.php?t=126

so, if all you want to do is make it wait 2 seconds before getting the webpage, simply add a sleep(2000) before getting the webpage. (I've changed your code to a more readable format plus added the sleep).
type
  TMyThread1 = class(TThread)
  private
    HTTP1: TIdHTTP;
    url1, rs1: String;
    procedure Display1;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure WEB1;
  end;
 
  TMyThread2 = class(TThread)
    ProgressBar1: TProgressBar;
  private
    HTTP2: TIdHTTP;
    url2, rs2: String;
    procedure Display2;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure WEB2;
  end;
 
constructor TMyThread1.Create;
begin
  inherited Create(true);
  HTTP1 := TIdHTTP.Create(Application);
  HTTP1.HandleRedirects := true;
  FreeOnTerminate := true;
end;
 
constructor TMyThread2.Create;
begin
  inherited Create(true);
  HTTP2 := TIdHTTP.Create(Application);
  HTTP2.HandleRedirects := true;
  FreeOnTerminate := true;
end;
 
destructor TMyThread1.Destroy;
begin
  HTTP1.Free;
  inherited;
end;
 
destructor TMyThread2.Destroy;
begin
  HTTP2.Free;
  inherited;
end;
 
procedure TMyThread1.Display1;
begin
// My code
end;
 
procedure TMyThread2.Display2;
begin
// My code
end;
 
procedure TMyThread1.Execute;
begin
  try
    sleep(2000);// wait 2 seconds before getting the web page
    rs1 := Http1.Get(Url1);
  except
    on e:exception do
      rs1 := e.Message;
  end;
  Synchronize(Display1);
end;
 
procedure TMyThread2.Execute;
begin
  try
    sleep(2000);// wait 2 seconds before getting the web page
    rs2 := Http2.Get(Url2);
  except
    on e:exception do
      rs2 := e.Message;
  end;
  Synchronize(Display2);
end;
 
Procedure TMyThread1.WEB1;
var
  g:integer;
begin
  for g:=1 to FinalN +1 do
    with TMyThread1.Create do 
    begin
      Url1 := 'http//www.site1.com';
      ct_dix:=ct_dix+10;
      Resume;
    end;
end;
 
Procedure TMyThread2.WEB2;
var
  y:integer;
begin
  for y:=1 to FinalN +1 do
  with TMyThread2.Create do 
  begin
    Url2 := 'http://www.site1.com';
    ct_un2:=ct_un2+10;
    Resume;
  end;
end;

Open in new window

0
 
ClubreseauAuthor Commented:
no if you put sleep(2000); its freeze the application, and if 10 thread are created its wait 2 second and after 10 thread created immediately no waiting, and me i want it sleep on each thread

thank you
0
 
2266180Commented:
man, I added the sleep in the right place. you application WILL NOT freeze. have you even bothered testing with the code I wrote?
0
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

 
Geert GOracle dbaCommented:
do you know your are creating threads inside the same thread type ?
what's that good for ?

use a class procedure instead
or a procedure in some other object (like a form)

and why do you type 2 exact same pieces of code except for a parameter and maybe some display procedure

btw you are using a parameter across thread boundaries
you need to synchronise the parameter access

and creating the progresbar inside the thread will certainly produce errors !

let's say you want to display the code in 2 different webbrowser windows
and you call a timing thread with Button1 and Button2
This timing thread will create a new thread every 2 secs to create a loading thread
you could use code below from a form like  

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    WebBrowser2: TWebBrowser;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  end;

procedure TForm1.Button1Click(Sender);
begin
  TTimingThread.Create('http//www.site1.com', 10);
end;

procedure TForm1.Button2Click(Sender);
begin
  TTimingThread.Create('http//www.site2.com', 20);
end;
unit ThreadsOverHttp;
 
const 
  THREADSLEEP = 2000;
 
type
  TTimingThread = class(TThread)
  private
    fTimes: Integer;
    fUrl: string;
  protected
    procedure Execute; override;
  public 
    constructor Create(aUrl: string; nTimes: Integer); 
  end;
 
  TMyThread = class(TThread)
  private
    fHTTP: TIdHTTP;
    fUrl: string;
    fRs: String;
    fWebBrowser: TWebBrowser;
    procedure Display;
  protected
    procedure Execute; override;
  public
    constructor Create(aUrl: string; aWebbBrowser: TWebBrowser);
    destructor Destroy; override;
  end;
 
constructor TMyThread.Create(aUrl: string; aWebbBrowser: TWebBrowser);
begin
  inherited Create(False);
  fWebbrowser := aWebBrowser;
  fIdHTTP := TIdHTTP.Create(Application);
  fIdHTTP.HandleRedirects := true;
  FreeOnTerminate := true;
end;
 
destructor TMyThread.Destroy;
begin
  FreeAndNil(fIdHTTP);
  inherited Destroy;
end;
 
procedure TMyThread.Display;
begin
  // just my guess at your code
  fWebbrowser.InnerHtml := fRs;
end;
 
procedure TMyThread.Execute;
begin
  try
    Sleep(THREADSLEEP);
    fRs := fIdHttp.Get(fUrl);
  except
    on e:exception do
      fRs := e.Message;
  end;
  Synchronize(Display);
end;
 
constructor TTimingThread.Create(aUrl: string; nTimes: Integer);
begin
  inherited Create(False);
  fTimes := nTimes;
  fUrl := aUrl;
  FreeOnTerminate := True;
end;
 
procedure TTimingThread.Execute;
var g:integer;
begin
  for g:=1 to nTimes +1 do
  begin
    Sleep(THREADSLEEP);
    TMyThread.Create(aUrl);
  end;
end;
 

Open in new window

0
 
ClubreseauAuthor Commented:
i test it man not working it not sleep 10 time only 1 time anf after 10 thread are created ! and me i want 10 time if i created 10 thread it sleeo 2 second
0
 
2266180Commented:
look, my code sleeps 2 seconds for each thread before getting the page.
that means that it will create all 10 threads at once, in the same second, but each thread will wait for 2 seconds before getting the webpage. so the entire operation is finished in aproximatly 2-4 seconds (maybe more, depends how long it takes to get the url).
geerts code sleeps twice as much, meaning it sleep 4 seconds for each thread: 2 seconds before it creates the thread and 2 seconds before it gets the web page.
more exactly, it will take 20 seconds to create the 10 threads and each one will wait 2 seconds before getting the webpage. the aprocimate time for the entire operation to finish is around 22-24 seconds, depending on how long it takes for the url to be downloaded.

so, I understood one thing from your post, geert probably something else. but both his and my code will wait 2 second for each thread as you asked, but you didn't mention when that waiting should happen. so geert placed it in both possible locations :) good thinking geert ;)

so, in worse case scenario, geerts code should work just fine (except if waiting 4 seconds to get a page is too much).

og, forgot to mention something about geerts code. here is a timeline:
2 seconds: thread 1 created
4 seconds: thread 1 gets the url, thread 2 created
6 seconds: thread 2 gets the url, thread 3 created
8 seconds: thread 4 gets the url, thread 4 creates
and so on.
so, as you can see, there is actually 2 seconds between each url donwload, but 4 seconds unitl the first one is done.
0
 
Geert GOracle dbaCommented:
>> in both possible locations :) good thinking geert ;)

i assumed the idea was to load different pages so something like an animated gif would be possible
but then with webpages

little bit extravagant way to load eh ?

putting a redirect in the browser header and start it after 2 secs would be a lot easier
don't even need delphi code for that ;)
0
 
ClubreseauAuthor Commented:
i search 1000 webpage with 60 thread this is exactely what i do that why i need to wai t 2 second on each thread.
0
 
ClubreseauAuthor Commented:
someone can make me a simple demo how it work with 2 webbrowser looking different page

thank for you patience
0
 
ClubreseauAuthor Commented:
500 point i give for demo example
0
 
Geert GOracle dbaCommented:
you don't need to sleep !
you need a different algorithm
1: something that starts threads to load pages and save them to file
2: and then another to load/search the files from disk
1 can work independant of 2
so no need for a sleep

the saving to file of pages can work like this:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    memUrls: TMemo;
    btnStart: TButton;
    edOutputDir: TEdit;
    memoLog: TMemo;
    procedure btnStartClick(Sender: TObject);
  private
    procedure TimingCallback(Msg: String; MsgInfo: Integer = 0);
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.btnStartClick(Sender: TObject);
begin
  TTimingThread.Create(TimingCallback, memUrls.Lines, edOutputDir.Text);
end;

procedure TForm1.TimingCallback(Msg: String; MsgInfo: Integer);
begin
  if MemoLog.Lines.Count > MaxLog then
    MemoLog.Lines.Delete(0);
  MemoLog.Lines.Add(Msg);
end;

end.

to search for the text in the file check this Q:
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_21091768.html
unit Unit2;
 
interface
 
uses Classes, idHttp;
 
const
  THREADSLEEP = 2000;
  MaxThreads = 20;
 
type
  TCallbackProc = procedure (aMessage: string; aMessageInfo: Integer = 0) of object;
 
  TCallbackThread = class(TThread)
  private
    FCallBack: TCallbackProc;
    FCallbackMsg: string;
    FCallbackMsgInfo: integer;
    procedure SynchedCallback;
  protected
    procedure DoCallback(aMsg: string; aMsgInfo: integer = 0); virtual;
    property Callback: TCallbackProc read FCallback;
  public
    constructor Create(aCallback: TCallbackProc; CreateSuspended: Boolean = False);
  end;
 
  TTimingThread = class(TCallbackThread)
  private
    fList: TStrings;
    fDir: string;
    nThreads: Integer;
    procedure PageCallback(aMessage: string; MsgInfo: Integer = 0);
  protected
    procedure Execute; override;
  public
    constructor Create(aCallback: TCallbackProc; aList: TStrings; aDir: string);
    destructor Destroy; override;
  end;
 
  TPageToFileThread = class(TCallbackThread)
  private
    fidHTTP: TIdHTTP;
    fUrl: string;
    fFileName: string;
  protected
    procedure Execute; override;
  public
    constructor Create(aCallback: TCallbackProc; aUrl: string; aFileName: string);
    destructor Destroy; override;
  end;
 
implementation
 
uses SysUtils;
 
{ TCallbackThread }
 
constructor TCallbackThread.Create(aCallback: TCallbackProc; CreateSuspended: Boolean = False);
begin
  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
  FCallback := aCallback;
end;
 
procedure TCallbackThread.DoCallback(aMsg: string; aMsgInfo: Integer = 0);
begin
  FCallbackMsg := aMsg;
  FCallbackMsgInfo := aMsgInfo;
  Synchronize(SynchedCallback);
end;
 
procedure TCallbackThread.SynchedCallback;
begin
  if Assigned(FCallback) then
    FCallBack(FCallbackMsg, FCallbackMsgInfo);
end;
 
{ TTimingThread }
 
constructor TTimingThread.Create(aCallback: TCallbackProc; aList: TStrings; aDir: string);
begin
  inherited Create(aCallback);
  fList := TStringList.Create;
  if Assigned(aList) then
    fList.Assign(aList);
  fDir := aDir;
end;
 
destructor TTimingThread.Destroy;
begin
  FreeAndNil(fList);
  inherited Destroy;
end;
 
procedure TTimingThread.PageCallback(aMessage: string; MsgInfo: Integer = 0);
begin
  if MsgInfo = 6 then // Thread finished, so decrement number of threads running
    Dec(nThreads);
  DoCallback(aMessage, MsgInfo); // Forward up to app
end;
 
procedure TTimingThread.Execute;
var g: Integer;
  aFileName: string;
begin
  nThreads := 0;
  g := 1;
  repeat
    if nThreads < MaxThreads then
    begin
      aFileName := fDir + Format('\page_%d_%s', [g, FormatDateTime('yyyymmddhhnnsszzz', Now)]);
      TPageToFileThread.Create(PageCallback, fList[0], aFileName);
      Inc(nThreads);
      fList.Delete(0);
      Inc(g);
    end;
    Sleep(THREADSLEEP);
  until fList.Count = 0;
  DoCallback('All done', 10);
end;
 
{ TLoaderThread }
 
constructor TPageToFileThread.Create(aCallback: TCallbackProc; aUrl: string; aFileName: string);
begin
  inherited Create(aCallback);
  fUrl := aUrl;
  fFileName := aFileName;
  fIdHTTP := TIdHTTP.Create(nil);
  fIdHTTP.HandleRedirects := True;
end;
 
destructor TPageToFileThread.Destroy;
begin
  FreeAndNil(fIdHTTP);
  inherited Destroy;
end;
 
procedure TPageToFileThread.Execute;
var
  F: File;
  Rs: string;
begin
  DoCallback(fUrl, 0); // Start loading
  try
    Rs := fIdHttp.Get(fUrl);
    DoCallback(fUrl, 1); // Loading success
  except
    on e:exception do
    begin
      Rs := e.Message;
      DoCallback(fUrl, 2); // Error loading
    end;
  end;
  DoCallback(fUrl, 3); // Start save to file
  AssignFile(F, fFileName);
  Rewrite(F);
  try
    DoCallback(fUrl, 4); // File opened for write
    BlockWrite(F, Rs, Length(Rs));
    DoCallback(fUrl, 5); // Page saved to file
  finally
    CloseFile(F);
  end;
  DoCallback(fUrl, 6); // Thread Done
end;
 
end.

Open in new window

0
 
ClubreseauAuthor Commented:
I load a List of website in Memo1 and use this code to find all webpage who in the source as astrology or ASTROLOGY i use this and it very slow someone have a better idea to make it faster ?

procedure TForm1.Button7Click(Sender: TObject);
 var
  S1: TStringList;
i: Integer;
 position : Integer;
  begin
   S1 := TStringList.Create;
    try
     for i:=0 to Memo1.Lines.Count  do
       begin
         try
          S1.Clear;
            label4.Caption:=(IntToStr(i));
               memo1.lines[i] := StringReplace( memo1.lines[i],'http://','',[rfReplaceAll]);
                 S1.Add(IdHttp1.Get('http://'+memo1.Lines[i]));
                     except on e:exception do
S1.Clear;
 end;
  position := AnsiPos('astrology', S1.text);
   if position = 0 then
    else
     memo2.Lines.Add(memo1.Lines[i]);
       label1.Caption:=(IntToStr(memo2.Lines.Count -0));

  position := AnsiPos('ASTROLOGY', S1.text);
   if position = 0 then
    else
     memo2.Lines.Add(memo1.Lines[i]);
      label1.Caption:=(IntToStr(memo2.Lines.Count -0));
        end;

finally
 AssignFile(myFile, 'URL.dat');
  ReWrite(myFile);
   WriteLn(myFile, memo2.text);
    CloseFile(myFile);
      end;
       end;

Thank You
0
 
Geert GOracle dbaCommented:
wow, you're using incremental indentation
what's that good for ?
please try and format the code in a delphi way
seems silly to format your code,
but i use formatting to find memory leaks
I can spot memory leaks at a glance with just formatting :)
your formatting is useless

you wanted threads
but now you're doing it in the main thread ?

0
 
Russell LibbySoftware Engineer, Advisory Commented:

Better yet, the asker should take the time to address his PREVIOUS OPEN question regarding threaded downloads. The reason I offered up my wininet wrapper (in that q) is that the asker would get the benefits of a threaded download with ZERO hassle.

C'est la vie
0
 
ClubreseauAuthor Commented:
can i use 5 thread and seach at the sametime maybe it will ne more fast ? if yes how
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 7
  • 4
  • 3
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now