unit rwhod1;

{ rwhod1 - mainunit of rwhodwin

RWhod for Windows
Version 0.30
Copyright (c) 2000 by Ward van Wanrooij <ward@ward.nu>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

For more information regarding this license or this program
visit http://www.ward.nu/ or mailto:ward@ward.nu .

Do not remove the above message.

This unit requires TSock by Tom Bradford/Ward van Wanrooij (http://www.ward.nu/computer/tsock)
and antTaskbarIcon by Karpolan (http://karpolan.i.am) in order to compile
successfully.
}

interface

uses
  WinTypes, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, IniFiles, ExtCtrls, Registry, WinSock, Menus,
  antTaskbarIcon, Sock;

type
  TAboutForm = class(TForm)
    MyTimer: TTimer;
    AboutLabel1: TLabel;
    AboutLabel2: TLabel;
    AboutLabel3: TLabel;
    RWhodLogo: TImage;
    TaskbarIcon: TantTaskbarIcon;
    TaskbarMenu: TPopupMenu;
    Broadcast1: TMenuItem;
    N1: TMenuItem;
    About1: TMenuItem;
    Exit1: TMenuItem;
    AboutLabel4: TLabel;
    AboutLabel5: TLabel;
    OK: TButton;
    Socket: TSock;
    procedure TransmitUptimeData(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MyTimerTimer(Sender: TObject);
    procedure OKClick(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
  end;

type
  Toutmp = record
    out_line: array[0..7] of char;
    out_name: array[0..7] of char;
    out_time: cardinal;
  end;
  Twhoent = record
    we_utmp: Toutmp;
    we_idle: cardinal;
  end;
  Twhod = record
    wd_vers: char;
    wd_type: char;
    wd_fill: array[0..1] of char;
    wd_sendtime: cardinal;
    wd_recvtime: cardinal;
    wd_hostname: array[0..31] of char;
    wd_loadav: array[0..2] of cardinal;
    wd_boottime: cardinal;
    wd_we: array[0..41] of Twhoent;
  end;

var
  AboutForm: TAboutForm;
  Whod: Twhod;
  Whoent: Twhoent;
  Outtmp: Toutmp;
  MyRegistry: TRegistry;
  CpuUsage: array[0..89] of array[0..3] of Char;
  Subnetmask, Port: string;
  NumberOfUsers: Integer;

implementation

{$R *.DFM}

procedure TAboutForm.TransmitUptimeData(Sender: TObject);
var
  I, TempInt: Integer;
  CurrentTime: Int64;
  TimeZoneInfo: TTimeZoneInformation;
begin
  // Original version:
  // CurrentTime:=Trunc(((Double(Now)-Double(EncodeDate(1970,1,1)))*24*60+TimeZoneInfo.Bias)*60);
  TempInt:=0;
  for I:=0 to 4 do
    TempInt:=TempInt+Integer(CpuUsage[I+85]);
  Whod.wd_loadav[0]:=HToNL(Trunc(TempInt/5));
  TempInt:=0;
  for I:=0 to 29 do
    TempInt:=TempInt+Integer(CpuUsage[I+60]);
  Whod.wd_loadav[1]:=HToNL(Trunc(TempInt/30));
  TempInt:=0;
  for I:=0 to 89 do
    TempInt:=TempInt+Integer(CpuUsage[I]);
  Whod.wd_loadav[2]:=HToNL(Trunc(TempInt/90));
  GetTimeZoneInformation(TimeZoneInfo);
  CurrentTime:=Trunc(((Double(Now)-25569)*1440+TimeZoneInfo.Bias)*60);
  Whod.wd_sendtime:=HToNL(CurrentTime);
  Socket.HostName:=SubnetMask;
  Socket.PortName:=Port;
  Socket.Open;
  Socket.Stream.Write(Whod, 60+NumberOfUsers*24);
  Socket.Close;
end;

procedure TAboutForm.FormCreate(Sender: TObject);
var
  I: Integer;
  CurrentTime: Int64;
  BootTime: Int64;
  HostName: array[0..31] of Char;
  TimeZoneInfo: TTimeZoneInformation;
begin
  NumberOfUsers:=1;
  GetTimeZoneInformation(TimeZoneInfo);
  CurrentTime:=Trunc(((Double(Now)-25569)*1440+TimeZoneInfo.Bias)*60);
  BootTime:=Trunc(CurrentTime-GetTickCount()/1000);
  Whod.wd_boottime:=HToNL(BootTime);
  Outtmp.out_time:=HToNL(BootTime);
  for I:=0 to 31 do
    HostName[I]:=Chr(0);
  GetHostname(@HostName,32);
  StrMove(Whod.wd_hostname,HostName,Length(HostName));
  Outtmp.out_line:='pts/0';
  Outtmp.out_name:='windows';
  Whoent.we_utmp:=Outtmp;
  Whoent.we_idle:=HToNL(3660);               // 1 hour, 1 minute
  Whod.wd_vers:=Chr(1);                      // who protocol version
  Whod.wd_type:=Chr(1);                      // status: 1=up
  Whod.wd_fill[0]:=Chr(0);
  Whod.wd_fill[1]:=Chr(0);
  Whod.wd_recvtime:=0;
  Whod.wd_we[0]:=Whoent;
  MyRegistry:=TRegistry.Create;
  MyRegistry.RootKey:=HKEY_LOCAL_MACHINE;
  try
    MyRegistry.OpenKey('Software\Ward\rwhodwin',False);
    Subnetmask:=MyRegistry.ReadString('Subnetmask');
    Port:=MyRegistry.ReadString('Port');
  except
    Application.MessageBox('The configuration entries could not be found. For more information visit http://www.ward.nu/ .','Fatal error', MB_OK);
    TaskbarIcon.Visible:=False;
    MyRegistry.Free;
    Application.ProcessMessages;
    Halt;
  end;
  MyRegistry.CloseKey;
  MyRegistry.RootKey:=HKEY_DYN_DATA;
  MyRegistry.OpenKey('PerfStats\StartStat',False);  // Why Microsoft, why? Why do we have to open a registrykey in order to trigger a VxD?
  MyRegistry.ReadBinaryData('KERNEL\CPUUsage',CpuUsage[0],4); // CpuUsage serves as a temporary variable here.
  MyRegistry.CloseKey;
  MyRegistry.OpenKey('PerfStats\StatData',False);
  for I:=0 to 89 do
    MyRegistry.ReadBinaryData('KERNEL\CPUUsage',CpuUsage[I],4);
  TransmitUptimeData(Self);
  MyTimer.Enabled:=True;
end;

procedure TAboutForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  MyRegistry.CloseKey;
  MyRegistry.OpenKey('PerfStats\StopStat',False);  // Why #2
  MyRegistry.ReadBinaryData('KERNEL\CPUUsage',CpuUsage[0],4);
  MyRegistry<