این هم سورس برنامه:
unit untMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs,
Data.DB, Data.Win.ADODB, Vcl.ExtCtrls,FunUnit,System.Win.Registry,IdBaseCom ponent,ActiveX,
IdComponent, IdRawBase, IdRawClient, IdIcmpClient;
type
TPingServ = class(TService)
ADOConnection1: TADOConnection;
tmrDBConnection: TTimer;
tmrRefreshSettingFromDB: TTimer;
procedure RefreshSettingFromDB;
procedure tmrRefreshSettingFromDBTimer(Sender: TObject);
procedure tmrDBConnectionTimer(Sender: TObject);
procedure ServiceAfterInstall(Sender: TService);
procedure ServiceExecute(Sender: TService);
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceCreate(Sender: TObject);
private
{ Private declarations }
public
procedure ReadIPList;
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
type
TPingThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
procedure Pinging;
public
mIP:string;
mId:Integer;
constructor Create(Suspend:Boolean;Id:Integer;ip:string);
destructor Destroy; override;
end;
var
PingServ: TPingServ;
TikTime:Cardinal;
MyThread:array of TPingThread;
PingInterval:Integer;
const
MachineId=0;
implementation
{$R *.dfm}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
PingServ.Controller(CtrlCode);
end;
function TPingServ.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TPingThread.Pinging;
var
Client:TIdIcmpClient;
ADOCon:TADOConnection;
mQuery:TADOQuery;
DBServer,UserID,Password:string;
begin
WriteLog('**'+IntToStr(mId)+' '+mIP);
Client:=TIdIcmpClient.Create(nil);
Client.Host:=mIP;
Client.ReceiveTimeout:=5000;
Client.Ping;
ADOCon:=TADOConnection.Create(nil);
ReadCryptedUserIDAndPasswordToIni(AppPath+'setting s.ini',DBServer,UserID,Password);
ADOCon.ConnectionString:='Provider=SQLOLEDB.1;Pass word='+Password+';Persist Security Info=True;User ID='+UserID+';Initial Catalog=Smart Factory;Data Source='+DBServer+';Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Use Encryption for Data=False;Tag with column collation when possible=False';
ADOCon.LoginPrompt:=False;
mQuery:=TADOQuery.Create(nil);
mQuery.Connection:=ADOCon;
try
ADOCon.Connected:=True;
if Client.ReplyStatus.BytesReceived <= 0 then begin
mQuery.SQL.Add('INSERT INTO tblIPPingLog(DT,Id,[Reply],[Time])VALUES(SYSDATETIME(),');
mQuery.SQL.Add(IntToStr(mId)+',0,50000)');
end else begin
mQuery.SQL.Add('INSERT INTO tblIPPingLog(DT,Id,[Reply],[Time])VALUES(SYSDATETIME(),');
mQuery.SQL.Add(IntToStr(mId)+',1,'+IntToStr(Client .ReplyStatus.MsRoundTripTime)+')');
end;
if mQuery.SQL.Count>0 then
mQuery.ExecSQL;
except
On E:Exception Do
WriteLog(e.Message,'TPingThread.Pinging');
end;
mQuery.Free;
ADOCon.Free;
Client.Free;
WriteLog('**++'+IntToStr(mId)+' '+mIP);
end;
procedure TPingServ.ReadIPList;
var
mQuery:TADOQuery;
i:Integer;
ss:string;
begin
ADOConnection1.Connected:=True;
mQuery:=TADOQuery.Create(Self);
mQuery.Connection:=ADOConnection1;
mQuery.SQL.Add('SELECT top(1) Id,IP FROM tblIPList ORDER BY Id');
mQuery.Open;
if mQuery.RecordCount>0 then begin
WriteLog(IntToStr(mQuery.RecordCount));
SetLength(MyThread,mQuery.RecordCount);
for I := 0 to mQuery.RecordCount-1 do begin
MyThread[i] := TPingThread.Create(True,mQuery.FieldByName('Id').A sInteger,mQuery.FieldByName('IP').AsString);
MyThread[i].Start;
mQuery.Next;
end;
//for I := 0 to mQuery.RecordCount-1 do
// MyThread[i].Start;
end;
mQuery.Free;
end;
procedure TPingServ.RefreshSettingFromDB;
var
mQuery:TADOQuery;
begin
if not ADOConnection1.Connected then begin
tmrDBConnection.Enabled:=True;
exit;
end;
mQuery:=TADOQuery.Create(Self);
mQuery.Connection:=ADOConnection1;
try
mQuery.Connection:=ADOConnection1;
mQuery.SQL.Text:='SELECT id,Value FROM tblSettings WHERE MachineId='+IntToStr(MachineId);
mQuery.Open;
tmrDBConnection.Interval:=VariantToInteger(mQuery. Lookup('Id','20','Value'),10)*1000;
tmrRefreshSettingFromDB.Interval:=VariantToInteger (mQuery.Lookup('Id','21','Value'),10)*1000;
PingInterval:=VariantToInteger(mQuery.Lookup('Id', '22','Value'),10)*1000;
except
WriteLog('Database Connection Error','TPingServ.RefreshSettingFromDB',True);
tmrDBConnection.Enabled:=True;
end;
mQuery.Free;
//ReadIPList;
//tmrRefreshSettingFromDB.Enabled:=True;
end;
procedure TPingServ.ServiceAfterInstall(Sender: TService);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create(KEY_READ or KEY_WRITE);
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('\SYSTEM\CurrentControlSet\Services\' + Name, false) then
begin
Reg.WriteString('Description', 'Insert IP Ping Log to Database');
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;
procedure TPingServ.ServiceCreate(Sender: TObject);
var
mQuery:TADOQuery;
i:Integer;
begin
PingInterval:=30000;
tmrDBConnectionTimer(Self);
RefreshSettingFromDB;
end;
procedure TPingServ.ServiceExecute(Sender: TService);
var
i:Integer;
ss:string;
begin
CoInitialize(nil);
//RefreshSettingFromDB;
ReadIPList;
tmrDBConnection.Enabled:=True;
//tmrRefreshSettingFromDB.Enabled:=True;
while not Terminated do begin
sleep(1000);
ss:='!!!';
for I := Low(MyThread) to High(MyThread) do
ss:=ss+IntToStr(MyThread[i].mId)+' ';
WriteLog(ss);
//for I := Low(MyThread) to High(MyThread) do
// MyThread.Start;
ServiceThread.ProcessRequests(False);// wait for termination
end;
CoUninitialize;
end;
procedure TPingServ.ServiceStart(Sender: TService; var Started: Boolean);
begin
WriteLog('Service Started','Service',True);
TikTime:=GetTickCount;
end;
procedure TPingServ.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
WriteLog('Service Stoped','Service',True);
end;
procedure TPingServ.tmrDBConnectionTimer(Sender: TObject);
var
DBServer,UserID,Password:string;
begin
tmrDBConnection.Enabled:=False;
if ADOConnection1.Connected then
ADOConnection1.Close;
ReadCryptedUserIDAndPasswordToIni(AppPath+'setting s.ini',DBServer,UserID,Password);
ADOConnection1.ConnectionString:='Provider=SQLOLED B.1;Password='+Password+';Persist Security Info=True;User ID='+UserID+';Initial Catalog=Smart Factory;Data Source='+DBServer+';Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Use Encryption for Data=False;Tag with column collation when possible=False';
try
ADOConnection1.Connected:=True;
except
WriteLog('Database Connection Error','TPingServ.tmrDBConnectionTimer',True);
tmrDBConnection.Enabled:=True;
end;
end;
procedure TPingServ.tmrRefreshSettingFromDBTimer(Sender: TObject);
begin
RefreshSettingFromDB;
end;
{ TPingThread }
constructor TPingThread.Create(Suspend: Boolean; Id: Integer; ip: string);
begin
inherited Create(true);
FreeOnTerminate := True;
mIP:=ip;
mId:=Id;
end;
destructor TPingThread.Destroy;
begin
inherited;
end;
procedure TPingThread.Execute;
begin
while not Terminated do begin
WriteLog('Start Pinging Id='+IntToStr(mId)+mIP);
Pinging;
WriteLog('End Pinging Id='+IntToStr(mId)+mIP+'Interval='+IntToStr(PingIn terval));
Sleep(PingInterval);
end;
end;
end.
اگر خط 116 را به صورت زیر تغییر بدهم نتایج عجیب و غریبی به دست می آید:
mQuery.SQL.Add('SELECT Id,IP FROM tblIPList ORDER BY Id');
