Solved

Move timer driven routine to a separate thread.

Posted on 2011-09-12
12
307 Views
Last Modified: 2012-05-12
Url checking code that runs on timer when active is impacting GUI. You can see this when constantly move mouse over menu items. I would like to move that code to a separate thread. Need help.
Comments about how url checking is realized are also welcomed.
I'm on Delphi 7.
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    click1: TMenuItem;
    Item12: TMenuItem;
    Item22: TMenuItem;
    Item32: TMenuItem;
    Item42: TMenuItem;
    Item52: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  hInet: HINTERNET;

implementation

{$R *.dfm}

function CheckUrl(url:string):boolean;
var
  hConnect: HINTERNET;
  infoBuffer: array [0..512] of char;
  dummy: DWORD;
  bufLen: DWORD;
  okay: LongBool;
  reply: String;
begin
  if pos('http://',lowercase(url))=0 then url:= 'http://'+url;
  hConnect := InternetOpenUrl(hInet,PChar(url),nil,0, INTERNET_FLAG_NO_UI,0);
  if not Assigned(hConnect) then
    result := false
  else
  begin
    dummy := 0;
    bufLen := Length(infoBuffer);
    okay := HttpQueryInfo(hConnect,HTTP_QUERY_STATUS_CODE, @infoBuffer[0],bufLen,dummy);
    if not okay then
      result := False
    else
    begin
      reply := infoBuffer;
      if reply = '200' then
        result := True
      else if reply = '401' then
        result := True
      else if reply = '404' then
        result := True
      else if reply = '500' then
        result := False
      else
        result := False;
    end;
    InternetCloseHandle(hConnect);
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if CheckUrl('google.com') then  Label1.Caption:= 'everything is fine' else Label1.Caption:= 'something is wrong';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  hInet := InternetOpen(PChar(application.title), INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY,nil,nil,0);
  Timer1.Enabled:= True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(hInet) then InternetCloseHandle(hInet);
end;
end.


--------- Unit1.dfm ---------

object Form1: TForm1
  Left = 636
  Top = 804
  Width = 197
  Height = 109
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 80
    Top = 8
    Width = 97
    Height = 13
    Caption = 'waiting for timer...'
  end
  object Timer1: TTimer
    Enabled = False
    Interval = 5000
    OnTimer = Timer1Timer
    Left = 40
    Top = 24
  end
  object MainMenu1: TMainMenu
    Left = 8
    Top = 24
    object click1: TMenuItem
      Caption = 'click'
      object Item12: TMenuItem
        Caption = 'Item 1'
      end
      object Item22: TMenuItem
        Caption = 'Item 2'
      end
      object Item32: TMenuItem
        Caption = 'Item 3'
      end
      object Item42: TMenuItem
        Caption = 'Item 4'
      end
      object Item52: TMenuItem
        Caption = 'Item 5'
      end
    end
  end
end

Open in new window

0
Comment
Question by:3axap
  • 5
  • 3
  • 3
  • +1
12 Comments
 
LVL 36

Expert Comment

by:Geert Gruwez
ID: 36525192
0
 
LVL 36

Accepted Solution

by:
Geert Gruwez earned 300 total points
ID: 36525359
i have a problem starting my delphi 2010 here, so i'll have to use the browser ... :)
(i don't have any syntax checking ...)

if i change my thread unit from my article :
unit uEELoadData;

interface

uses Classes;

const
  WaitSleep = 500;

type
  TDataLoadedProc = procedure (Url, UrlCheck: string) of object;
  TDataProgressProc = procedure (Url: string; ProcentDone: integer) of object;

procedure UrlCheck(Url: string; DataLoaded: TDataLoadedProc; DataProgress: TDataProgressProc = nil);

implementation

uses SysUtils, Wininet;

var
  mLoadDataThreadRunning: boolean;
  hInet: HINTERNET;

type
  TLoadDataThread = class(TThread)
  private
    fDataLoaded: TDataLoadedProc;
    fDataProgress: TDataProgressProc;
    fUrl: string;
    fUrlCheck: string;
    fProcentDone: integer;
    procedure DoDataLoaded;
    procedure DoProgress;
    function CheckUrl: boolean;
  protected
    procedure ReportProgress(ProcentDone: Integer);
    procedure Execute; override;
  public
    constructor Create(aUrl: string; DataLoaded: TDataLoadedProc; DataProgress: TDataProgressProc = nil); reintroduce; virtual;
  end;

{ TLoadDataThread }

constructor TLoadDataThread.Create(aUrl: string; DataLoaded: TDataLoadedProc; DataProgress: TDataProgressProc = nil);
begin
  // Create thread not suspended
  inherited Create(False);
  // When finished, autofree
  FreeOnTerminate := True;
  // remember parameters
  fUrl := aUrl;
  fUrlCheck := '';
  fDataLoaded := DataLoaded;
  fDataProgress := DataProgress;
  if not Assigned(hInet) then 
    hInet := InternetOpen(PChar(application.title), INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY,nil,nil,0);
end;

function TLoadDataThread.CheckUrl: boolean;
var
  hConnect: HINTERNET;
  infoBuffer: array [0..512] of char;
  dummy: DWORD;
  bufLen: DWORD;
  okay: LongBool;
  reply: String;
begin
  if pos('http://',lowercase(furl))=0 then furl:= 'http://'+furl;
  hConnect := InternetOpenUrl(hInet,PChar(fUrl),nil,0, INTERNET_FLAG_NO_UI,0);
  if not Assigned(hConnect) then
    result := false
  else
  begin
    dummy := 0;
    bufLen := Length(infoBuffer);
    okay := HttpQueryInfo(hConnect,HTTP_QUERY_STATUS_CODE, @infoBuffer[0],bufLen,dummy);
    if not okay then
      result := False
    else
    begin
      reply := infoBuffer;
      if reply = '200' then
        result := True
      else if reply = '401' then
        result := True
      else if reply = '404' then
        result := True
      else if reply = '500' then
        result := False
      else
        result := False;
    end;
    InternetCloseHandle(hConnect);
  end;
end;

procedure TLoadDataThread.Execute;
begin
  ReportProgress(0);
  if CheckUrl then 
    fUrlCheck := 'Ok'
  else 
    fUrlCheck := 'Not Ok';
  ReportProgress(100);
  // Call the show procedure with the url to show the created data in
  Synchronize(DoDataLoaded);
end;

procedure TLoadDataThread.ReportProgress(ProcentDone: Integer);
begin
  fProcentDone := ProcentDone;
  Synchronize(DoProgress);
end;

procedure TLoadDataThread.DoDataLoaded;
begin
  // Make sure we have all items assigned
  if Assigned(fDataLoaded) then
    fDataLoaded(fUrl, fUrlCheck);

  // clear the flag to stop a second thread
  mLoadDataThreadRunning := False;
end;

procedure TLoadDataThread.DoProgress;
begin
  if Assigned(fDataProgress) then
    fDataProgress(fUrl, fProcentDone);
end;

procedure UrlCheck(Url: string; DataLoaded: TDataLoadedProc; DataProgress: TDataProgressProc = nil);
begin
  if not mLoadDataThreadRunning then
  begin
    mLoadDataThreadRunning := True;
    TLoadDataThread.Create(url, DataLoaded, DataProgress);
  end;
end;

initialization
  mLoadDataThreadRunning := False;
finalization
  if Assigned(hInet) then InternetCloseHandle(hInet);
end.

Open in new window

0
 
LVL 36

Expert Comment

by:Geert Gruwez
ID: 36525387
then your form code would be like this:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    click1: TMenuItem;
    Item12: TMenuItem;
    Item22: TMenuItem;
    Item32: TMenuItem;
    Item42: TMenuItem;
    Item52: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    procedure CheckedUrl(aUrl, aUrlStatus: string);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses uEELoadData;

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  CheckUrl('google.com', CheckedUrl);

  //if CheckUrl('google.com') then  Label1.Caption:= 'everything is fine' else Label1.Caption:= 'something is wrong';
end;

procedure TForm1.CheckedUrl(aUrl, aUrlStatus: string);
begin
  Label1.Caption := 'Status is "' + aUrlStatus + '" for URL:' + aUrl;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // setup inside thread unit
  //hInet := InternetOpen(PChar(application.title), INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY,nil,nil,0);
  Timer1.Enabled:= True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  // Cleared inside thread unit
  // if Assigned(hInet) then InternetCloseHandle(hInet);
end;

end.

Open in new window

0
 
LVL 3

Expert Comment

by:VahaC
ID: 36525392
try this

Unit1.pas
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    click1: TMenuItem;
    Item12: TMenuItem;
    Item22: TMenuItem;
    Item32: TMenuItem;
    Item42: TMenuItem;
    Item52: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  hInet: HINTERNET;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Enabled := True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  with TMyThread.Create('google.com') do
    Start;
end;

end.

Open in new window


Unit2.pas
unit Unit2;

interface

uses
  Classes, SysUtils, Windows, Dialogs, wininet;

type
  TMyThread = class (TThread)
  protected
    procedure UpdateLabel;
    procedure Execute; override;
  private
    FUrl: string;
    FCheckResult: Boolean;
    FhInet: HINTERNET;
    function CheckUrl(url:string):boolean;
  public
    constructor Create(aUrl: string);
    destructor Destroy;
  end;
implementation

uses Unit1;

{ TMyThread }

function TMyThread.CheckUrl(url:string):boolean;
var
  hConnect: HINTERNET;
  infoBuffer: array [0..512] of char;
  dummy: DWORD;
  bufLen: DWORD;
  reply: String;
begin
  if pos('http://', lowercase(url))=0 then
    url:= 'http://' + url;
  hConnect := InternetOpenUrl(FhInet, PChar(url), nil, 0, INTERNET_FLAG_NO_UI, 0);
  if not Assigned(hConnect) then
    Result := false
  else
  begin
    dummy := 0;
    bufLen := Length(infoBuffer);
    if not HttpQueryInfo(hConnect,HTTP_QUERY_STATUS_CODE, @infoBuffer[0],bufLen,dummy) then
      Result := False
    else
    begin
      reply := infoBuffer;
      Result := (reply = '200') or (reply = '401') or (reply = '404');
    end;
    InternetCloseHandle(hConnect);
  end;
end;

constructor TMyThread.Create(aUrl: string);
begin
  FhInet := InternetOpen(PChar('My Application'), INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY,nil,nil,0);
  FUrl := aUrl;
  FCheckResult := False;
  inherited Create(True);
//  Priority := tpHigher;
  FreeOnTerminate := True;
end;

destructor TMyThread.Destroy;
begin
  if Assigned(FhInet) then InternetCloseHandle(hInet);
end;

procedure TMyThread.Execute;
begin
  FCheckResult := CheckUrl(FUrl);
  Synchronize(UpdateLabel);
end;

procedure TMyThread.UpdateLabel;
begin
  if FCheckResult then
    Form1.Label1.Caption := 'everything is fine'
  else
    Form1.Label1.Caption := 'something is wrong';
end;

end.

Open in new window

0
 
LVL 36

Expert Comment

by:Geert Gruwez
ID: 36525403
>>Vahac
2 problems in your code
1: you have circular unit reference
2: you are assuming Form1 actually wil be used
0
 
LVL 36

Expert Comment

by:Geert Gruwez
ID: 36525411
3: you have left the globel hInet variable allowing confusion to which one will be used
>> caused by the circular unit reference too
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 
LVL 3

Expert Comment

by:VahaC
ID: 36525695
Unit1.pas

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    StaticText1: TStaticText;
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    click1: TMenuItem;
    Item12: TMenuItem;
    Item22: TMenuItem;
    Item32: TMenuItem;
    Item42: TMenuItem;
    Item52: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Enabled := True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  with TMyThread.Create('goo1gle.com', StaticText1.Handle) do
    Start;
end;

end.

Open in new window


Unit2.pas

Unit1

Open in new window

0
 
LVL 3

Expert Comment

by:VahaC
ID: 36525702
Unit2.pas

unit Unit2;

interface

uses
  Classes, SysUtils, Windows, Dialogs, Messages, wininet;

type
  TMyThread = class (TThread)
  protected
    procedure UpdateLabel;
    procedure Execute; override;
  private
    FUrl: string;
    FLblHandle: THandle;
    FCheckResult: Boolean;
    FhInet: HINTERNET;
    function CheckUrl(url:string):boolean;
  public
    constructor Create(const aUrl: string; const aLblHandle: THandle);
    destructor Destroy;
  end;
implementation

{ TMyThread }

function TMyThread.CheckUrl(url:string):boolean;
var
  hConnect: HINTERNET;
  infoBuffer: array [0..512] of char;
  dummy: DWORD;
  bufLen: DWORD;
  reply: String;
begin
  if pos('http://', lowercase(url))=0 then
    url:= 'http://' + url;
  hConnect := InternetOpenUrl(FhInet, PChar(url), nil, 0, INTERNET_FLAG_NO_UI, 0);
  if not Assigned(hConnect) then
    Result := false
  else
  begin
    dummy := 0;
    bufLen := Length(infoBuffer);
    if not HttpQueryInfo(hConnect,HTTP_QUERY_STATUS_CODE, @infoBuffer[0],bufLen,dummy) then
      Result := False
    else
    begin
      reply := infoBuffer;
      Result := (reply = '200') or (reply = '401') or (reply = '404');
    end;
    InternetCloseHandle(hConnect);
  end;
end;

constructor TMyThread.Create(const aUrl: string; const aLblHandle: THandle);
begin
  FhInet := InternetOpen(PChar('My Application'), INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY,nil,nil,0);
  FUrl := aUrl;
  FLblHandle := aLblHandle;
  FCheckResult := False;
  inherited Create(True);
//  Priority := tpHigher;
  FreeOnTerminate := True;
end;

destructor TMyThread.Destroy;
begin
  if Assigned(FhInet) then InternetCloseHandle(FhInet);
end;

procedure TMyThread.Execute;
begin
  FCheckResult := CheckUrl(FUrl);
  Synchronize(UpdateLabel);
end;

procedure TMyThread.UpdateLabel;
var
  str: String;
begin
  if FCheckResult then
    str := 'everything is fine'
  else
    str := 'something is wrong';
  SendMessage(FLblHandle, WM_SETTEXT, 0, Integer(@str[1]))
end;

end.

Open in new window

0
 
LVL 32

Expert Comment

by:ewangoya
ID: 36526704

This is a good question, I'll jump in, in a few minutes.

Nice article Geert, you get my vote
0
 
LVL 32

Assisted Solution

by:ewangoya
ewangoya earned 200 total points
ID: 36526823

Here is my approach, I would prefer to use the post message instead of the procedure but thats just my preference

There is no need for having the timer at all since everything can be handled in the thread

1. Thread Unit
 
unit uURLCheck;

interface

uses
  Windows, Classes, Messages, WinInet;

const
  UM_DONECHECK = WM_USER + 100;

type
  TURLCheckEvent = procedure(const AStatus: Boolean) of object;

  TURLThread = class(TThread)
  private
    FCurrentStatus: Boolean;
    FNotifyHandle: THandle;
    FSession: HINTERNET;
    FURL: string;
    FURLCheckEvent: TURLCheckEvent;
    procedure DoneCheckEvent;
  public
    procedure Execute; override;
    constructor Create(const AHandle: THandle; const AURL: string; AEvent: TURLCheckEvent);
    destructor Destroy; override;
    property URL: string read FURL write FURL;
  end;

implementation

uses Math;

{ TURLThread }

constructor TURLThread.Create(const AHandle: THandle; const AURL: string;
  AEvent: TURLCheckEvent);
begin
  FNotifyHandle := AHandle;
  FURL := AURL;
  if Pos('http://', FURL) <= 0 then
    FURL := 'http://' + FURL;
  FURLCheckEvent := AEvent;
  inherited Create(False);
end;

destructor TURLThread.Destroy;
begin
  if Assigned(FSession) then
    InternetCloseHandle(FSession);
  inherited Destroy;
end;

procedure TURLThread.DoneCheckEvent;
begin
  if Assigned(FURLCheckEvent) then
    FURLCheckEvent(FCurrentStatus);
end;

procedure TURLThread.Execute;
var
  Code: PChar;
  NewStatus: Boolean;
  DWIndex, DWCodeLen: DWORD;
  DWCode: array[0..31] of Char;
  HRequest: HINTERNET;
begin
  repeat
    if not Assigned(FSession) then
      FSession := InternetOpen('InetURL:/1.0', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

    if Assigned(FSession) then
    begin
      HRequest := InternetOpenUrl(FSession, PChar(FUrl), nil, 0, INTERNET_FLAG_RELOAD, 0);
      if Assigned(HRequest) then
      try
        DWIndex := 0;
        DWCodeLen := 32;
        if HttpQueryInfo(HRequest, HTTP_QUERY_STATUS_CODE, @DWCode, DWCodeLen, DWIndex) then
        begin
          Code := PChar(@DWCode);
          NewStatus := (Code = '200') or (Code = '302'); //HTTP_STATUS_OK-200, HTTP_STATUS_REDIRECT-302;
          if NewStatus <> FCurrentStatus then
          begin
            FCurrentStatus := NewStatus;
            //you can use either doneevent procedure
            Synchronize(DoneCheckEvent);
            //or postmessage to the main form
            PostMessage(FNotifyHandle, UM_DONECHECK, 0, IfThen(FCurrentStatus, 0, 1));
          end;
        end;
      finally
        InternetCloseHandle(HRequest);
      end;
    end;

    Sleep(60 * 1000); //wait a minute before checking again
  until Terminated;
end;

end.

Open in new window


2. Main form
 
unit Main;

interface

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

type
  TForm1 = class(TForm)
    lblStatus: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FURLThread: TURLThread;
    procedure CheckedURL(const AStatus: Boolean);
    procedure UMDoneCheck(var Message: TMessage); Message UM_DONECHECK;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  StrUtils;

procedure TForm1.CheckedURL(const AStatus: Boolean);
begin
  lblStatus.Caption := IfThen(AStatus, 'everything is fine', 'something is wrong');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FURLThread := TURLThread.Create(Handle, 'google.com', CheckedURL);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FURLThread.Terminate;
  FURLThread.WaitFor;
  FURLThread.Free;
end;

procedure TForm1.UMDoneCheck(var Message: TMessage);
begin
  if Message.LParam = 0 then
    lblStatus.Caption := 'everything is fine'
  else
    lblStatus.Caption := 'something is wrong'
end;

end.

Open in new window


3. Dfm
 
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 202
  ClientWidth = 447
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object lblStatus: TLabel
    Left = 56
    Top = 48
    Width = 41
    Height = 13
    Caption = 'lblStatus'
  end
end

Open in new window

0
 
LVL 32

Expert Comment

by:ewangoya
ID: 36526847
Change the Execute procedure to
procedure TURLThread.Execute;
var
  Code: PChar;
  NewStatus: Boolean;
  DWIndex, DWCodeLen: DWORD;
  DWCode: array[0..31] of Char;
  HRequest: HINTERNET;
begin
  repeat
    if not Assigned(FSession) then
      FSession := InternetOpen('InetURL:/1.0', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

    NewStatus := False;
    if Assigned(FSession) then
    begin
      HRequest := InternetOpenUrl(FSession, PChar(FUrl), nil, 0, INTERNET_FLAG_RELOAD, 0);
      if Assigned(HRequest) then
      try
        DWIndex := 0;
        DWCodeLen := 32;
        if HttpQueryInfo(HRequest, HTTP_QUERY_STATUS_CODE, @DWCode, DWCodeLen, DWIndex) then
        begin
          Code := PChar(@DWCode);
          NewStatus := (Code = '200') or (Code = '302'); //HTTP_STATUS_OK-200, HTTP_STATUS_REDIRECT-302;
        end;
      finally
        InternetCloseHandle(HRequest);
      end;
    end;

    if NewStatus <> FCurrentStatus then
    begin
      FCurrentStatus := NewStatus;
      //you can use either doneevent procedure
      Synchronize(DoneCheckEvent);
      //or postmessage to the main form
      PostMessage(FNotifyHandle, UM_DONECHECK, 0, IfThen(FCurrentStatus, 0, 1));
    end;

    Sleep(60 * 1000); //you should probably wait more minutes here
  until Terminated;
end;

Open in new window

0
 

Author Closing Comment

by:3axap
ID: 36528456
2 Gruwez
Your article is great but I didn't read it before posting my question.
Your code is working as needed.
Thank you.


2 VahaC
I use D7. So, I changed 'Start' to 'Resume' (I don't know if it is the only change should be made) but still it shows warning: Method 'Destroy' hides virtual method of base type 'TThread'. I'm not sure whether it is serious one.
Thank you.

2 ewangoya
I like your approach the most (don't know yet why). The only issue, it is not indicating that server is down if application started when server is down.


Maybe all those issues don't even worth mentioning but I'm noob.
Thanks again to everyone responded.
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

759 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now