Program gets stuck after clicking button? 3

[ug505]

Hello,

I've built a page viewing program. Everything is working except for when I press the View button. I have the program set to load a list of URLs off a server and view each URL individually. When you click the View button it turns a TTimer on. The TTimer is set to navigate to each URL in the list, load the page, refresh, then add 1 to the Gauge I have. Why does it get stuck? What is wrong with my code:

ViewerTimer is where it gets stuck.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, WinInet, StdCtrls, ComCtrls, OleCtrls, SHDocVw, ExtCtrls, Gauges, MMSystem, ShellApi,
  Menus;

type
  TForm1 = class(TForm)
    List: TMemo;
    DownloadL: TButton;
    Status: TLabel;
    View: TButton;
    Gauge1: TGauge;
    Stop: TButton;
    ChatLink: TLabel;
    Users: TLabel;
    Users_Handler: TMemo;
    WebBrowser2: TWebBrowser;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Options1: TMenuItem;
    Advanced1: TMenuItem;
    Help1: TMenuItem;
    ReadMe1: TMenuItem;
    Viewer: TTimer;
    procedure DownloadLClick(Sender: TObject);
    procedure ViewClick(Sender: TObject);
    procedure StopClick(Sender: TObject);
    procedure ChatLinkClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Advanced1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure ReadMe1Click(Sender: TObject);
    procedure ViewerTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2, Unit3;

{$R *.dfm}

function GetInetFile (const fileURL, FileName: String): boolean;
 const
   BufferSize = 1024;
 var
   hSession, hURL: HInternet;
   Buffer: array[1..BufferSize] of Byte;
   BufferLen: DWORD;
   f: File;
   sAppName: string;
 begin
  result := false;
  sAppName := ExtractFileName(Application.ExeName) ;
  hSession := InternetOpen(PChar(sAppName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0) ;
  try
   hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, 0, 0) ;
   try
    AssignFile(f, FileName) ;
    Rewrite(f,1) ;
    repeat
     InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen) ;
     BlockWrite(f, Buffer, BufferLen)
    until BufferLen = 0;
    CloseFile(f) ;
    result := True;
   finally
    InternetCloseHandle(hURL)
   end
  finally
   InternetCloseHandle(hSession)
  end
 end;

procedure TForm1.DownloadLClick(Sender: TObject);
var
   internetFile,
   localFileName: string;
 begin
  Status.Caption:='Downloading...';
  internetFile := '[URL unfurl="true"]http://skysthelimitco.webs.com/URLList.txt';[/URL]
  localFileName := 'URLList.txt';

  if GetInetFile(internetFile, localFileName) then begin
    ShowMessage('Download successful.');
    List.Lines.LoadFromFile(localFileName);
    View.Enabled:=True;
    Status.Caption:='Idle...';
    end
  else
    ShowMessage('Error in file download.') ;
    Status.Caption:='Idle...';
end;

procedure TForm1.ViewClick(Sender: TObject);
begin
if FileExists('URLList.txt') then begin
  Form3.Show;
  Stop.Enabled:=True;
  View.Enabled:=False;
  DownloadL.Enabled:=False;
  Gauge1.Progress:=0;
  Gauge1.MaxValue:=List.Lines.Count;
  Viewer.Enabled:=True;
  end
else ShowMessage('Error! List does not exist!');
end;

procedure TForm1.StopClick(Sender: TObject);
begin
Status.Caption:='Stopping...';
Viewer.Enabled:=False;
while Form3.WebBrowser1.Busy=True do Application.ProcessMessages;
DownloadL.Enabled:=True;
View.Enabled:=True;
Form3.WebBrowser1.Navigate('about:blank');
Gauge1.Progress:=0;
Status.Caption:='Idle...';
end;

procedure TForm1.ChatLinkClick(Sender: TObject);
begin
ShellExecute(Handle, 'open', '[URL unfurl="true"]http://skysthelimitco.webs.com/chatroom.htm',[/URL] nil, nil, SW_SHOWNORMAL);
end;

procedure TForm1.FormShow(Sender: TObject);
var
   internetFile2,
   localFileName2: string;
   TimeNow : LongInt;
begin
WebBrowser2.Navigate('[URL unfurl="true"]http://skysthelimitco.zzl.org/user_online.php');[/URL]
TimeNow := timeGetTime;
  while (TimeNow + 5000) > timeGetTime do Application.ProcessMessages;
  internetFile2 := '[URL unfurl="true"]http://skysthelimitco.zzl.org/users.txt';[/URL]
  localFileName2 := 'users.txt';
  DownloadL.Enabled:=True;
  if GetInetFile(internetFile2, localFileName2) then begin
    Users_Handler.Lines.Clear;
    Users_Handler.Lines.LoadFromFile(localFileName2);
    Users.Caption:='Users Online: ' +Users_Handler.Text;
    end
  else
    ShowMessage('Error! Cannot download users online text file!') ;
end;

procedure TForm1.Advanced1Click(Sender: TObject);
begin
Form2.Show;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.ReadMe1Click(Sender: TObject);
begin
ShellExecute(Handle, 'open', 'README.txt', nil, nil, SW_SHOWNORMAL);
end;

procedure TForm1.ViewerTimer(Sender: TObject);
var
MyFile : TextFile;
Buffer : String;
TimeNow : LongInt;
begin
AssignFile(MyFile, 'URLList.txt') ;
Reset(MyFile) ;
while not EOF(MyFile) do
  begin
  ReadLn(MyFile, Buffer) ;
  Form3.WebBrowser1.Navigate(Buffer);
  Status.Caption:='Loading...';
  TimeNow := timeGetTime;
  while (TimeNow + 5000) > timeGetTime do Application.ProcessMessages;
  Status.Caption:='Viewing ' +Buffer +'...';
  Form3.WebBrowser1.Refresh;
  Gauge1.Progress:=Gauge1.Progress+1;
  end;
CloseFile(MyFile);
end;

end.

 

[djjd47130]

This is all a matter of windows messages. Whenever you do something in the program which requires a large amount of work, basically consider your application **frozen** until that task is completed. In many cases, this can not be overcome, such as loading a large image into a TImage component.

What I do when I have this problem is below. This is only in extreme conditions, is very sensitive, and still not recommended (although it saves me sometimes). It's also not necessarily guaranteed, but it will make your program respond more appropriately...

Create a Timer in your form, designated for this and this alone. Make this timer Disabled by default, and with interval of 1. Of course create a procedure for this timer's event. Make sure when your form creates, this timer gets Enabled at the END of the create event handler.

Next, declare a private bool variable in your form named fProcessing. This will determine whether or not your form is doing any processing. When your form creates, make sure you set this to False by default.

I know there are other ways of doing it, but in Whosrdaddy's words, this is the "poor man's way" of making your program respond.

type
  TMyForm = class(TForm)
    MyTimer: TTimer;
    procedure MyTimerOnTimer(Sender: TObject);
    procedure MyFormCreate(Sender: TObject);
  private
    fProcessing: Bool;
  end;


implementation


TMyForm.MyFormCreate(Sender: TObject);
begin
  try

    //Do whatever stuff you need here

  finally
    fProcessing:= False; //Set this BEFORE enabling the timer
    MyTimer.Enabled:= True;
  end;
end;

//This timer is made like this to prevent from overlapping its self - thus freezing your program even worse.
//  Some people say this overlap is not possible, but I've proved it is.
//  If Application.ProcessMessages takes 5 milliseconds to complete, and the timer is set
//  to just 1 millisecond, it will overlap 5 times and multiply as long as it keeps going.
TMyForm.MyTimerOnTimer(Sender: TObject);
begin
  if not fProcessing then begin //Make sure procedure is not already being executed
    fProcessing:= True;
    try
      Application.ProcessMessages; //Magical procedure to make program respond - but very sensitive
    finally
      fProcessing:= False;
    end;
  end;
end;

JD Solutions

 

[majlumbo]

I think the problem you have is that you are doing to much in the timer event. What you may want to do instead is in the viewclick event, cycle through and navigate to all the urls, and in the timer event, simply refresh them. There's no need to actually do a while loop in the timer, since it will fire off repeatedly, at whatever interval you have selected. so it will refresh every url, every time it is fired off.

 

[Glenn9999]

Agreed basically with all the above. You are having a message problem and deadlocking the main thread. One problem is that you are doing too much in the timer event.

But at the same time, you don't show us the value of Viewer1.Interval. It must be greater than zero for the timer to even fire. On Delphi 3 it defaults to 1000 in design time. You don't indicate that you have set it to anything. As well, you don't shut it off within the timer event, so it seems likely you are firing that TTimer multiple times, too.

I wouldn't even consider using the TTimer for anything other than to "tap" on the main loop to proceed. Assuming the last example I posted in response to this general issue as a basis:

relevant additions to the TForm:
  CycleTimer: TTimer;
  procedure CycleTimerTimer(Sender: TObject);
  public
    CycleEvent: THandle;
  end;

And code:
procedure TForm1.Button3Click(Sender: TObject);
var
  i: integer;
  empty: OleVariant;
begin
  Empty := '';
  CycleTimer.Interval := 5000;
  CycleEvent := CreateEvent(nil, True, False, nil);
  for i := 0 to (Memo1.Lines.Count - 1) do
    begin
      if Copy(Memo1.Lines.Strings[i], 1, 7) = '[URL unfurl="true"]http://'[/URL] then
        begin
          button2.caption := 'Visit URL ' + IntToStr(i);
          WebBrowser1.Navigate(WideString(Memo1.Lines.Strings[i]),
                  Empty, Empty, Empty, Empty);
          repeat
            Application.ProcessMessages;
          until WebBrowser1.Busy = false;
          CycleTimer.Enabled := true;
          repeat
            Application.ProcessMessages;
          until WaitForSingleObject(CycleEvent, 20) = WAIT_OBJECT_0;
          ResetEvent(CycleEvent);
        end;
    end;
end;

procedure TForm1.CycleTimerTimer(Sender: TObject);
begin
  SetEvent(CycleEvent);
  CycleTimer.Enabled := false;
end;

As was said, this is a poor man's way of doing it, and would be much better off as a thread. But you get the main idea from above.

It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.

 

[whosrdaddy]

ah not again!

people do NOT use application.processmessages in a TTimer event.

It messes up the order of the events:

I explained the reason in here:
thread102-1650140

CPU consuming processes should not live on the main thread, there is a reason why we have threads in this world....

PS: Glenn's code is good attempt at solving this issue but threads just make more sense in these kind of scenario's.
PS1: ignore djjd47130's code snippet, it is EVIL (and he knows it )

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

 

[djjd47130]

PS1: ignore djjd47130's code snippet, it is EVIL (and he knows it )

Hence the reason I boldly stated this is not recommended and is not guaranteed. One slip will make things even worse. It has helped in certain situations, and is very quick and easy to put together. For a larger project, especially one which you may publish, you need another approach.

JD Solutions

 

[whosrdaddy]

JD,

you still don't get it eh?
just don't do it. never. ever.

It is like saying that cocaine can help in certain situations...

my 2$

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

 

[Glenn9999]

you still don't get it eh?
just don't do it. never. ever.

I definitely can understand a reluctance. I'm finding threads add a certain complexity both to development and to testing, that I haven't gotten over. I realize threads are best, but am still trying to get around the whole issue to be able to be comfortable with them.

Like with the code above, I mainly did it in such a way to incorporate the timer, but I wanted quick and easy that I could get working in 15 minutes (with the note that yes it needs a thread).

Speaking of which, my latest debugging problem for this app I'm working on is a strange one. I recoded this thread I'm using to directly call events instead of passing them to the main thread, trying to reduce some of the latency for the downloads (I have it going slow and hanging up in some cases).

It works great (except for the above, still, probably a server issue somewhere), but I have strings that are defined in a const section in a ShowMessage call being bigger than their character length. In some cases, it fills up the entire screen and then some. It may be that I need to message to the main thread for the VCL to work properly.

I really just don't know.

It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.

 

[whosrdaddy]

My rant is about using application.processmessages in a timer event, just don't do it.

I can understand that people find threading difficult. It is all about using the right tool for the job at hand. As a coder you need to learn how to use these tools. A timer is sometimes not enough...

About your problem, if I understand it correctly, you are doing showmessage from a thread different from the main thread?

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

 

[Glenn9999]

About your problem, if I understand it correctly, you are doing showmessage from a thread different from the main thread?

Yes I am, that's probably it. I was thinking it probably would be best to just stick with the message passing and forget directly calling the events.

It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.

 

[whosrdaddy]

you can't do GUI stuff except from the main VCL thread. It's a simple but hard rule

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

 

[Glenn9999]

you can't do GUI stuff except from the main VCL thread. It's a simple but hard rule

Thanks again. FWIW, if nothing else shows up I'll post this code in question very soon.

It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.

 

[ug505]

majlumbo was right. I had too many things going on at once. Thanks for that tip.

 

[Glenn9999]

As another exercise in learning, I just tried this as a thread:

const
  WM_NAVIGATE = WM_USER + $1599;
type
  TBrowserMonitor = class(TThread)
    private
      { Private declarations }
       procedure CycleTimerTimer(Sender: TObject);
    public
      Lines: TStrings;
      CycleEvent: THandle;
      CycleTimer: TTimer;
    protected
      procedure Execute; override;
    end;
  TForm1 = class(TForm)
...
  protected
     procedure BrowserNav(var WinMsg: TMessage); message WM_NAVIGATE;
  end;

procedure TBrowserMonitor.Execute;
var
  i: integer;
begin
  for i := 0 to (Lines.Count - 1) do
    begin
      if Copy(Lines.Strings[i], 1, 7) = '[URL unfurl="true"]http://'[/URL] then
        begin
          SendMessage(Form1.Handle, WM_NAVIGATE, i, 0);
          CycleTimer.Enabled := true;
          WaitForSingleObject(CycleEvent, INFINITE);
          ResetEvent(CycleEvent);
        end;
    end;
end;

procedure TBrowserMonitor.CycleTimerTimer(Sender: TObject);
begin
  SetEvent(CycleEvent);
  CycleTimer.Enabled := false;
end;

procedure TForm1.BrowserNav(var WinMsg: TMessage);
  const
    READYSTATE_UNINITIALIZED = 0; // Default initialisation state.
    READYSTATE_LOADING = 1; // Object is currently loading data.
    READYSTATE_LOADED = 2; // Object has been initialised.
    READYSTATE_INTERACTIVE = 3; // User can interact with the object but loading has not yet finished.
    READYSTATE_COMPLETE = 4; // All of the object's data has been loaded.
  var
    empty: OleVariant;
  begin
    Empty := '';
    WebBrowser1.Navigate(Widestring(Memo1.Lines[WinMsg.WParam]) , Empty, Empty, Empty, Empty);
    repeat
      Application.ProcessMessages;
    until WebBrowser1.ReadyState = READYSTATE_COMPLETE;
  end;

procedure TForm1.Button3Click(Sender: TObject);
var
  Monitor: TBrowserMonitor;
begin
  Monitor := TBrowserMonitor.Create(true);
  Monitor.Lines := Memo1.Lines;
  Monitor.CycleEvent := CreateEvent(nil, True, False, nil);
  Monitor.CycleTimer := TTimer.Create(self);
  Monitor.CycleTimer.Interval := 5000;
  Monitor.CycleTimer.OnTimer := Monitor.CycleTimerTimer;
  Monitor.FreeOnTerminate := true;
  Monitor.Resume;
end;

Seems to be working. Probably not the best way to handle some of it. The main thing to notice is that the way above is perhaps the more recommended way to see whether TWebBrowser is done.

But I couldn't find a way to avoid that loop, unless it's using the OnNavigateComplete2 event and communicating back to the thread, but I'm not sure if that is entirely the best way.

Thoughts?

It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.

 

[Glenn9999]

Realized I didn't free the timer. How that's done: Add this before the "Resume" call.

Monitor.OnTerminate := Monitor.MonitorTerminate;

Then define the following:

procedure TBrowserMonitor.MonitorTerminate(Sender: TObject);
begin
  CycleTimer.Free;
end;

It should do the job...I think.

It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.

 

[djjd47130]

Whosrdaddy,
I do get it, I am familiar with the issue, but just as Glenn mentioned, threading is difficult to come by. You may be used to it and comfortable with threads, but not everyone. All the threads I've built have issues, and yet I still keep trying to get the subject down. I'm building one thread right now, for example, which is the most difficult one I've ever attempted. It requires accessing a component on the main service (running inside a windows service application). I will be posting a thread soon asking for help with this specific issue, as I know threads cannot easily access components from the main service thread.

(PS - obviously Application.ProcessMessages is not even an option in a service, so don't worry, it won't be about that )



JD Solutions