B
bsense
Unregistered / Unconfirmed
GUEST, unregistred user!
各位大大,我做了一个NT服务程序,想定时刷新某个网页,程序如下,但是为什么只能执行
一次?请教
unit AutoDDNS;
interface
uses
Sysutils, Classes, InetFileUtils;
type
TDDNS = class(TThread)
private
{ Private declarations }
protected
procedure Execute;
override;
public
constructor Create(CreateSuspended: Boolean);
end;
implementation
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure DDNS.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end;
}
{ DDNS }
constructor TDDNS.Create(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
Priority := tpIdle;
end;
procedure TDDNS.Execute;
var FileOnNet: string;
begin
while Truedo
begin
FileOnNet := 'http://www.google.com';
GetInetFile(FileOnNet);
sleep(5000);
//是否这句的问题?
end;
end;
end.
========================
unit InetFileUtils;
interface
uses windows,Wininet;
function GetInetFile(const fileURL): boolean;
implementation
function GetInetFile(const fileURL): boolean;
const BufferSize = 1024;
var
hSession, hURL: HInternet;
Buffer: array[1..BufferSize] of Byte;
BufferLen: DWORD;
f: File;
sAppName: string;
begin
Result:=False;
hSession := InternetOpen(PChar(sAppName),INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0);
try
hURL := InternetOpenURL(hSession,PChar(fileURL),nil,0,0,0);
try
repeat
InternetReadFile(hURL, @Buffer,SizeOf(Buffer), BufferLen);
until BufferLen = 0;
Result:=True;
finally
InternetCloseHandle(hURL)
end
finally
InternetCloseHandle(hSession)
end
end;
end.
===============================
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, AutoDDNS,
ExtCtrls;
type
TZYDDNS = class(TService)
Timer1: TTimer;
procedure ServiceContinue(Sender: TService;
var Continued: Boolean);
procedure ServicePause(Sender: TService;
var Paused: Boolean);
procedure ServiceStart(Sender: TService;
var Started: Boolean);
procedure ServiceStop(Sender: TService;
var Stopped: Boolean);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
function GetServiceController: TServiceController;
override;
{ Public declarations }
end;
var
ZYDDNS: TZYDDNS;
DataThread: TDDNS;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord);
stdcall;
begin
ZYDDNS.Controller(CtrlCode);
end;
function TZYDDNS.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TZYDDNS.ServiceStart(Sender: TService;
var Started: Boolean);
begin
DataThread := TDDNS.Create(true);
Started := True;
end;
procedure TZYDDNS.ServiceStop(Sender: TService;
var Stopped: Boolean);
begin
DataThread.Terminate;
Stopped := True;
end;
procedure TZYDDNS.ServicePause(Sender: TService;
var Paused: Boolean);
begin
DataThread.Suspend;
Paused := True;
end;
procedure TZYDDNS.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
DataThread.Resume;
Continued := True;
end;
procedure TZYDDNS.Timer1Timer(Sender: TObject);
begin
if DataThread.Suspended then
DataThread.Resume;
end;
end.
======================
program Project2;
uses
SvcMgr,
Unit1 in 'Unit1.pas' {ZYDDNS: TService},
InetFileUtils in 'InetFileUtils.pas',
AutoDDNS in 'AutoDDNS.pas';
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TZYDDNS, ZYDDNS);
Application.Run;
end.
==============================
一次?请教
unit AutoDDNS;
interface
uses
Sysutils, Classes, InetFileUtils;
type
TDDNS = class(TThread)
private
{ Private declarations }
protected
procedure Execute;
override;
public
constructor Create(CreateSuspended: Boolean);
end;
implementation
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure DDNS.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end;
}
{ DDNS }
constructor TDDNS.Create(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
Priority := tpIdle;
end;
procedure TDDNS.Execute;
var FileOnNet: string;
begin
while Truedo
begin
FileOnNet := 'http://www.google.com';
GetInetFile(FileOnNet);
sleep(5000);
//是否这句的问题?
end;
end;
end.
========================
unit InetFileUtils;
interface
uses windows,Wininet;
function GetInetFile(const fileURL): boolean;
implementation
function GetInetFile(const fileURL): boolean;
const BufferSize = 1024;
var
hSession, hURL: HInternet;
Buffer: array[1..BufferSize] of Byte;
BufferLen: DWORD;
f: File;
sAppName: string;
begin
Result:=False;
hSession := InternetOpen(PChar(sAppName),INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0);
try
hURL := InternetOpenURL(hSession,PChar(fileURL),nil,0,0,0);
try
repeat
InternetReadFile(hURL, @Buffer,SizeOf(Buffer), BufferLen);
until BufferLen = 0;
Result:=True;
finally
InternetCloseHandle(hURL)
end
finally
InternetCloseHandle(hSession)
end
end;
end.
===============================
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, AutoDDNS,
ExtCtrls;
type
TZYDDNS = class(TService)
Timer1: TTimer;
procedure ServiceContinue(Sender: TService;
var Continued: Boolean);
procedure ServicePause(Sender: TService;
var Paused: Boolean);
procedure ServiceStart(Sender: TService;
var Started: Boolean);
procedure ServiceStop(Sender: TService;
var Stopped: Boolean);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
function GetServiceController: TServiceController;
override;
{ Public declarations }
end;
var
ZYDDNS: TZYDDNS;
DataThread: TDDNS;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord);
stdcall;
begin
ZYDDNS.Controller(CtrlCode);
end;
function TZYDDNS.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TZYDDNS.ServiceStart(Sender: TService;
var Started: Boolean);
begin
DataThread := TDDNS.Create(true);
Started := True;
end;
procedure TZYDDNS.ServiceStop(Sender: TService;
var Stopped: Boolean);
begin
DataThread.Terminate;
Stopped := True;
end;
procedure TZYDDNS.ServicePause(Sender: TService;
var Paused: Boolean);
begin
DataThread.Suspend;
Paused := True;
end;
procedure TZYDDNS.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
DataThread.Resume;
Continued := True;
end;
procedure TZYDDNS.Timer1Timer(Sender: TObject);
begin
if DataThread.Suspended then
DataThread.Resume;
end;
end.
======================
program Project2;
uses
SvcMgr,
Unit1 in 'Unit1.pas' {ZYDDNS: TService},
InetFileUtils in 'InetFileUtils.pas',
AutoDDNS in 'AutoDDNS.pas';
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TZYDDNS, ZYDDNS);
Application.Run;
end.
==============================