{------------------------------------------------------------------------------}
{
   Unit Name: TimedRun
   Purpose  : Allow program to run only limited time period
   Author   : Vesa Lappalainen
   Date     : 10.12.2002
   Changed  :
   Usage:

   In your program do:
   1) Create one TTimedRun object somewhere in the begining
      of the program.  For ex. in the OnCreate of Main Form
   2) Component reads file TimedRun.ini from programs
      directory and checks the date and compared to selected
      date and time.  If time period is over, program halts
      with message box to tell the contact address

   To make the TimedRun.ini
   1) There is a program called TimedRunSet that is used
      to generate the file TimedRun.ini.
      One inputs exact computername and the name of
      the program with full path (no case sensitive)
      and the last time to use the prorgram.
      Also the date of last used time of program must be
      input.  This is to check if system clock is
      changed backwards.  So if system clock is less
      than last used time of the program, then something
      is wrong.
   2) Send the file TimedRun.ini to your customer
      and ask to copy it to programs directory.

   3) If the MessageBox tells about wrong CheckSum
      then maybe the computername is wrong, program
      path is wrong or somebody has changed the line
      Time= in TimedRun.ini (or the file is missing).   

}
unit TimedRun;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,ExtCtrls, StdCtrls, OptionButton, savepos, kEditPnl;

type
  TTimedRun = class;
  TTimedRunEvent = procedure (sender:TTimedRun;msg:string) of object;
  TTimedRun = class(TComponent)
  private
    FTimeToStop: TDateTime;
    FTimer : TTimer;
    FCompName: string;
    FProgName: string;
    FContactAddress: string;
    FOnError: TTimedRunEvent;
    FNowTime: TDateTime;
    procedure SetTimeToStop(const Value: TDateTime);
    procedure OnTimer(Sender:TObject);
    procedure DamageProgram(s: string);
    procedure SetOnError(const Value: TTimedRunEvent);
  public
    procedure WriteTime; virtual;
    procedure CheckTime; virtual;
    procedure ReadTime; virtual;

  published
    constructor Create(AOwner:TComponent); override;
    constructor Create2(AOwner:TComponent); virtual;
    destructor Destroy; override;
    property TimeToStop : TDateTime read FTimeToStop write SetTimeToStop;
    property NowTime : TDateTime read FNowTime;
    property CompName : string read FCompName;
    property ProgName : string read FProgName;
    property ContactAddress : string read FContactAddress;
    property OnError : TTimedRunEvent read FOnError write SetOnError;
  end;

  TFormTimedRun = class(TForm)
    SavePos1: TSavePos;
    Panel1: TPanel;
    Panel2: TPanel;
    ButtonOK: TOptionButton;
    ButtonCancel: TOptionButton;
    EditPanelProgName: TEditPanel;
    EditPanelProgNameEdit: TEdit;
    EditPanelContact: TEditPanel;
    EditPanelContactEdit: TEdit;
    EditPanelTimeToStop: TEditPanel;
    EditPanelTimeToStopEdit: TEdit;
    EditPanelComputerName: TEditPanel;
    EditPanelComputerNameEdit: TEdit;
    PanelTimeToStop: TPanel;
    EditPanelLastRunTime: TEditPanel;
    EditPanelLastRunTimeEdit: TEdit;
    ButtonTime: TOptionButton;
    procedure FormCreate(Sender: TObject);
    procedure ButtonOKClick(Sender: TObject);
    procedure EditPanelTimeToStopEditChange(Sender: TObject);
    procedure ButtonCancelClick(Sender: TObject);
    procedure ButtonTimeClick(Sender: TObject);
  private
    { Private declarations }
    TimedRun : TTimedRun;
  public
    { Public declarations }
  end;

var
  FormTimedRun: TFormTimedRun;

implementation

{$R *.dfm}

uses IniFiles,kstring,kdouble;

{ TTimedRun }

const NrFactors = 3;
const Factors:array [0..NrFactors-1] of integer = (1,-1,3);

function CheckSum(s:string):string;
var i,sum,f:integer;
begin
  sum := 0; f := 0;
  for i:=1 to Length(s) do begin
    sum := sum + Ord(s[i])*Factors[f];
    inc(f); if ( f >= NrFactors ) then f := 0;
  end;
  Result := IntToStr(sum);
end;

function Salt(s,s1,s2:string):string;
var i,i1,i2,x,x1,x2 : integer;
begin
  Result := s;
  i1 := 1; i2 := 1;
  if ( s1 = '' ) then s1 := #0;
  if ( s2 = '' ) then s2 := #0;
  for i := 1 to Length(s) do begin
    x1 := Ord(s1[i1]) and $3f; inc(i1); if ( i1 > Length(s1) ) then i1 := 1;
    x2 := Ord(s2[i2]) and $3f; inc(i2); if ( i2 > Length(s2) ) then i2 := 1;
    if ( s[i] = 'ä' ) then x := $7f else x := Ord(s[i]);
    x := x xor x1 xor x2;
    x := x xor $40;
    if ( x = $7f ) then x := Ord('ä');
    Result[i] := Chr(x);
  end;

end;

procedure TTimedRun.DamageProgram(s:string);
var cs : string;
begin
  cs := '';
  if ( FTimer <> nil ) then FTimer.Enabled := false;
  if ( ContactAddress <> '' ) then cs := #13#10 + 'Contact: ' + ContactAddress;
  if ( Assigned(OnError) ) then OnError(self,s + cs);
  ShowMessage(s + cs);
  Halt;
end;

procedure TTimedRun.CheckTime;
begin
  if ( TimeToStop = -2 ) then DamageProgram('Wrong checksum in TimedRun');
  if ( TimeToStop < 0 ) then DamageProgram('Do not play with the clock');
  if ( Now >= TimeToStop ) then DamageProgram('Time period to use the program has gone');
end;

constructor TTimedRun.Create(AOwner: TComponent);
begin
  inherited;
  FCompName := UpperCase(GetEnvVariable('COMPUTERNAME'));
  FProgName := UpperCase(ParamStr(0));
  ReadTime;
  CheckTime;
  FTimer := TTimer.Create(self);
  FTimer.Interval := 5000;
  FTimer.OnTimer := OnTimer;
end;

constructor TTimedRun.Create2(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TTimedRun.Destroy;
begin
  WriteTime;
  FTimer.Free;
  inherited;
end;

procedure TTimedRun.OnTimer(Sender: TObject);
begin
//
  CheckTime;
  FNowTime := now; 
  WriteTime;
end;

procedure TTimedRun.ReadTime;
var Ini : TIniFile;  sum,p,s : string; LastStart : TDateTime;
begin
  Ini := TIniFile.Create('.\TimedRun.ini');
  FContactAddress := Ini.ReadString('TimedRun','ContactAddress','');
  s := Ini.ReadString('TimedRun','Time','');
  s := Salt(s,CompName,ProgName);
  sum := Separate(s,';');
  if ( sum <> CheckSum(s) ) then begin
    TimeToStop := -2;
    WriteTime;
    CheckTime;
  end;
  p := Separate(s,';');
  TimeToStop := IniStrToDouble(p);
//  TimeToStop := Now + EncodeTime(0,1,0,0);
  p := Separate(s,';');
  LastStart := IniStrToDouble(p);
  if ( LastStart > Now ) then begin
    TimeToStop := -1;
    WriteTime;
  end;
  Ini.Free;
end;

procedure TTimedRun.SetTimeToStop(const Value: TDateTime);
begin
  FTimeToStop := Value;
end;

procedure TTimedRun.WriteTime;
var Ini : TIniFile;  s,sum : string;
begin
  if ( ProgName = '' ) then exit;
  Ini := TIniFile.Create('.\TimedRun.ini');
  s := DoubleToIniStr(TimeToStop,'%20.15f') + ';' + DoubleToIniStr(NowTime,'%20.15f');
//  Format('%20.15f;%20.15f',[TimeToStop,NowTime]);
  sum := CheckSum(s);
  s := sum + ';' + s;
  s := Salt(s,CompName,ProgName);
  Ini.WriteString('TimedRun','Time',s);
  Ini.WriteString('TimedRun','Compname',CompName);
  Ini.WriteString('TimedRun','Progname',ProgName);
  Ini.WriteString('TimedRun','ContactAddress',ContactAddress);
  Ini.Free;
end;

procedure TTimedRun.SetOnError(const Value: TTimedRunEvent);
begin
  FOnError := Value;
end;

{ TFormTimedRun }

procedure TFormTimedRun.FormCreate(Sender: TObject);
begin
  TimedRun := TTimedRun.Create2(self);
  
end;

procedure TFormTimedRun.ButtonOKClick(Sender: TObject);
begin
  TimedRun.FProgName := UpperCase(EditPanelProgName.Text);
  TimedRun.FCompName := UpperCase(EditPanelComputerName.Text);
  TimedRun.FContactAddress := EditPanelContact.Text;
  TimedRun.TimeToStop := StrToDateTime(EditPanelTimeToStop.Text);
  Close;
end;

procedure TFormTimedRun.EditPanelTimeToStopEditChange(Sender: TObject);
var d: TDateTime;
begin
  try
    d := StrToDateTime(EditPanelTimeToStop.Text);
    PanelTimeToStop.Caption :=
      DateTimeToStr(StrToDateTime(EditPanelLastRunTime.Text)) + '  =>  ' +
      DateTimeToStr(d);
  Except end;
end;

procedure TFormTimedRun.ButtonCancelClick(Sender: TObject);
begin
  Close;
end;


procedure TFormTimedRun.ButtonTimeClick(Sender: TObject);
begin
  EditPanelLastRunTime.Text := DateTimeToStr(now);
end;

end.