source: trunk/UDialingService.pas

unit UDialingService;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  magrascon, magrasedt, ExtCtrls, UMainForm, magrasapi,
  UTextFileStream, Registry;

type
  TService1 = class(TService)
    MagRasEdt1: TMagRasEdt;
    MagRasCon1: TMagRasCon;
    Timer1: TTimer;
    Timer2: TTimer;
    procedure ServiceExecute(Sender: TService);
    procedure Timer1Timer(Sender: TObject);
    procedure MagRasCon1StateChanged(Sender: TObject);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure Timer2Timer(Sender: TObject);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
  private
    Connecting: Boolean;
    DialHandle: Cardinal;
    function GetLogFileEnabled: Boolean;
    procedure SetLogFileEnabled(const Value: Boolean);
    function GetLogFileName: string;
    procedure SetLogFileName(const Value: string);
    function GetConnectionName: string;
    procedure SetConnectionName(const Value: string);
    function GetLogClearOnStart: Boolean;
    procedure SetLogClearOnStart(const Value: Boolean);
  public
    LastState: Word;

    procedure Dial;
    procedure DialLog(Message: string);
    function GetServiceController: TServiceController; override;
    property LogFileEnabled: Boolean read GetLogFileEnabled
      write SetLogFileEnabled;
    property LogFileName: string read GetLogFileName
      write SetLogFileName;
    property ConnectionName: string read GetConnectionName
      write SetConnectionName;
    property LogClearOnStart: Boolean read GetLogClearOnStart
      write SetLogClearOnStart;
  end;

var
  Service1: TService1;

implementation

{$R *.DFM}

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

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

procedure TService1.ServiceExecute(Sender: TService);
begin
  try
    while not Terminated do begin
      Sleep(1000);
      //DialLog('.');
      ServiceThread.ProcessRequests(True);
    end;
  finally
  end;
  DialLog('Konec');
end;

procedure TService1.DialLog(Message: string);
var
  LogFile: TTextFileStream;
begin
  if LogFileEnabled then
  try
    if FileExists(LogFileName) then LogFile := TTextFileStream.Create(LogFileName, fmOpenReadWrite)
      else LogFile := TTextFileStream.Create(LogFileName, fmCreate);
    LogFile.Seek(0, soFromEnd);
    LogFile.WriteLn(Message);
  finally
    LogFile.Free;
  end;
end;

procedure TService1.Dial;
var
  I: Integer;
begin
    if MagRasCon1.ConnectState = RASCS_Connected then
      MagRasCon1.DisconnectEx(DialHandle, 0, 3000, False);

    DialLog('');
    DialLog(DateTimeToStr(Now) + ': Vytáèím pøípojení');
        with MagRasCon1 do begin
      GetConnections;
      I := 0;
      while (I < Connections.Count) and (Connections.EntryName(I) <> ConnectionName) do I := I + 1;
      if not (I < Connections.Count) then begin
        EntryName := ConnectionName;
              PhoneNumber :=    '';
            DialHandle := 0;
        if AutoConnectEx(DialHandle) <> 0 then
          DialLog('Dialling Failed - ' + MagRasCon1.StatusStr);
      end;
    end;
end;

procedure TService1.Timer1Timer(Sender: TObject);
begin
  if MagRasCon1.ConnectState <> RASCS_Connected then begin
    Timer1.Enabled := False;
    Dial;
  end;
end;

function TService1.GetConnectionName: string;
begin
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey(RegistryPath, True);
      if ValueExists('ConnectionName') then Result := ReadString('ConnectionName')
        else Result := '';
  finally
    Free;
  end;
end;

procedure TService1.SetConnectionName(const Value: string);
begin
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey(RegistryPath, True);
    WriteString('ConnectionName', Value)
  finally
    Free;
  end;
end;

function TService1.GetLogFileEnabled: Boolean;
begin
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey(RegistryPath, True);
      if ValueExists('LogFileEnabled') then Result := ReadBool('LogFileEnabled')
        else Result := False;
  finally
    Free;
  end;
end;

procedure TService1.SetLogFileEnabled(const Value: Boolean);
begin
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey(RegistryPath, True);
    WriteBool('LogFileEnabled', Value)
  finally
    Free;
  end;
end;

function TService1.GetLogFileName: string;
begin
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey(RegistryPath, True);
    if ValueExists('LogFileName') then Result := ReadString('LogFileName')
      else Result := ApplicationDataFolder + '\' + DefaultLogFileName;
  finally
    Free;
  end;
end;

procedure TService1.SetLogFileName(const Value: string);
begin
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey(RegistryPath, True);
    WriteString('LogFileName', Value)
  finally
    Free;
  end;
end;

procedure TService1.MagRasCon1StateChanged(Sender: TObject);
var
        Info: string;
begin
        if LastState = MagRasCon1.ConnectState then Exit;

  // check type of event
        Info := '';
  case MagRasCon1.StateEventSource of
        SourceDial: Info := ' Dial: ';
        SourceStatus: begin
      Info := ' Status: ';
      Timer1.Enabled := True;
    end;
        SourceHangup: Info := ' Hangup: ';
        end;

  // see if new event, else display it
  LastState := MagRasCon1.ConnectState ;
  DialLog(Info + MagRasCon1.StatusStr
    +   ' (' + IntToStr(LastState) + ')');

  // if dialling need to see what's happened
        if DialHandle <> 0 then begin
        // online OK, restart timer
                if (MagRasCon1.ConnectState = RASCS_Connected) then begin
//      ConnHandle := DialHandle
//      DialHandle := 0;
//      TimerStatus.Enabled := True;
                end;

          // dialling failed, either an error or disconnected
                if ((MagRasCon1.ConnectState > RASBase) and
            (MagRasCon1.ConnectState < RASCS_Paused)) or
            (MagRasCon1.ConnectState = RASCS_Disconnected) then begin
        // disconnect, returns when done or after three seconds, no StateChanged
        //ConnHandle := DialHandle;
                          //DialHandle := 0;
                        MagRasCon1.DisconnectEx(DialHandle, 0, 3000, False);
        Timer1.Enabled := True;
        // reset is done in timer event
                  end;
        end;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
  Timer1.Enabled := True;
  if LogClearOnStart and FileExists(LogFileName) then DeleteFile(LogFileName);
  DialLog('Služba spuštìna v ' + DateTimeToStr(Now));
end;

procedure TService1.Timer2Timer(Sender: TObject);
begin
  MagRasCon1.CurrentStatusEx(DialHandle, 0);
end;

function TService1.GetLogClearOnStart: Boolean;
begin
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey(RegistryPath, True);
    if ValueExists('LogClearOnStart') then Result := ReadBool('LogClearOnStart')
      else Result := False;
  finally
    Free;
  end;
end;

procedure TService1.SetLogClearOnStart(const Value: Boolean);
begin
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey(RegistryPath, True);
    WriteBool('LogClearOnStart', Value)
  finally
    Free;
  end;
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  DialLog('Služba zastavena v ' + DateTimeToStr(Now));
end;

end.