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.
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.
Code:
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.