srvmain.~pas

更新希网动态域名(8866.org)的服务程序

unit SrvMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
  ExtCtrls, Contnrs, IniFiles;

type
  TSiteInfo=class
    name:string;
    user:string;
    pass:string;
  end;

  TDynDNS = class(TService)
    Timer1: TTimer;
    http: TIdHTTP;
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    FTimeInterval:integer;//更新周期，单位分钟
    FLogFlag:boolean;//是否记录日志
    FSiteList:TObjectList;
    procedure LoadIni;
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  DynDNS: TDynDNS;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  DynDNS.Controller(CtrlCode);
end;

function TDynDNS.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TDynDNS.LoadIni;
var
  ini:TIniFile;
  sites:TStrings;
  i:integer;
  si:TSiteInfo;
begin
  FSiteList.Clear;
  ini := TIniFile.Create('dyndns3322.ini');
  try
    FTimeInterval := ini.ReadInteger('system','TimeInterval',5);
    if FTimeInterval<1 then FTimeInterval := 3;

    FLogFlag := ini.ReadInteger('system', 'Log', 0)=1;

    sites := TStringList.Create;
    ini.ReadSections(sites);
    for i:= 0 to sites.Count-1 do
    begin
      if (sites[i]<>'system') and (Pos('.',sites[i])>2) then
      begin
        si := TSiteInfo.Create;
        si.name := sites[i];
        si.user := ini.ReadString(si.name, 'username', '');
        si.pass := ini.ReadString(si.name, 'password', '');

        if FLogFlag then
          LogMessage(si.name+'(' + si.user + ':' + si.pass+')', EVENTLOG_INFORMATION_TYPE);
        FSiteList.Add(si);
      end;
    end;

    sites.Free;
  finally
    ini.Free;
  end;
end;

procedure TDynDNS.ServiceStart(Sender: TService; var Started: Boolean);
begin
  LoadIni;
  timer1.Interval := FTimeInterval * 60 * 1000;
  timer1.Enabled := true;
  Started := true;
end;

procedure TDynDNS.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  timer1.Enabled := false;
  Stopped := true;
end;

procedure TDynDNS.ServiceCreate(Sender: TObject);
begin
  FSiteList := TObjectList.Create;
  FSiteList.OwnsObjects := true;
end;

procedure TDynDNS.Timer1Timer(Sender: TObject);
var
  i:integer;
  si:TSiteInfo;
  s:string;
begin
  timer1.Enabled := false;
  try
    try
      for i:= 0 to FSiteList.Count-1 do
      begin
        si := TSiteInfo(FSiteList.Items[i]);
        http.Request.BasicAuthentication := true;
        http.Request.Username := si.user;
        http.Request.Password := si.pass;
        s := http.Get('http://www.3322.org/dyndns/update?system=dyndns&hostname='+si.name);
        if FLogFlag then LogMessage(si.name+'->'+s, EVENTLOG_INFORMATION_TYPE);
      end;
    except
      on E:Exception do
        LogMessage(e.Message, EVENTLOG_ERROR_TYPE);
    end;
  finally
    timer1.Enabled := true;
  end;
end;

end.