unit PlugServ;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
	Windows, ActiveX, Classes, ComObj, SysUtils, ExtCtrls, Weather,
		CM2GenInterface, CM2AutoUpdateInterface, CM2EditorSupportInterface;

type
	TCM2WeatherDotCom = class(TComObject, ICM2GenPlug, ICM2AutoUpdate, ICM2EditorSupport10)
	private
		LastErrMsg: PChar;
		Weather: TWeather;
		LastUpdate: TDateTime;
		LastForecastUpdate: TDateTime;
		LastFullUpdate: TDateTime;
		UpdateTimer: TTimer;
		RetryTimer: TTimer;
		LocID: String;
		Units: String;
		UpdateInt: Integer;
		Forecast: String;
		ForecastInt: Integer;
		FirstRun: Boolean;
		Value: Integer;
		fLink: String;
		UpdateType: Integer;
		Procedure Parse(Param: String);
		procedure Retry(Sender: TObject); virtual;
		Procedure UpdateXML;
		procedure OnTimer(Sender: TObject); virtual;
		Procedure LoadReg;
		Function DaySensor(DayX: Integer) : String;
		Function fFirstRun: Boolean;
	protected
		Function Name(OUT Name: Pchar): HResult; stdcall;
		Function Version(OUT Version: word): HResult; stdcall;
		Function RequiredCoreVersion(OUT RCV: Word): HResult; stdcall;
		Function SetParentHandle(Handle: THandle): HResult; stdcall;
		Function GetLastErrorMsg(OUT Msg: PChar): HResult; stdcall;
		Function GetInfoCount(OUT InfoCount: Integer): HResult; stdcall;
		Function GetInfo(Index: Integer; OUT InfoName: PChar; OUT InfoVar: PChar): HResult; stdcall;
		Function GetSensorCount(OUT SensorCount: Integer): HResult; stdcall;
		Function GetSensorNameOnly(Index: Integer; OUT SensorName: PChar; OUT SensorStyle: Byte): HResult; stdcall;
		Function GetSensor(Index: Integer; Parameters: PChar; OUT SensorName: PChar; OUT SensorStyle: byte; OUT SensorString: PChar; OUT SensorValue: Double): HResult; stdcall;
		Function Init: HResult; stdcall;
		Function Terminating: HResult; stdcall;
		Function Setup: HResult; stdcall;
		Function GetDefaultCount(SensorIndex: Integer; OUT DefaultCount: Integer): HResult; stdcall;
		Function GetDefault(SensorIndex: Integer; Index: Integer; OUT Name: Pchar; OUT Value: PChar; OUT Description: PChar): HResult; stdcall;
		Function GetOptionalCount(SensorIndex: Integer; OUT OptionalCount: Integer): HResult; stdcall;
		Function GetOptional(SensorIndex: Integer; Index: Integer; OUT Name: Pchar; OUT Value: PChar; OUT Description: PChar): HResult; stdcall;
		Function UpdateFileURL(OUT URL: Pchar): HResult; stdcall;
		Function ShowSensor(Index: Integer; OUT ShowAt: Byte): HResult; stdcall;
		Function ObjIns(SensorIndex: Integer; ParameterName: PChar; OUT ValueType: Byte; OUT ValueRange: PChar): HResult; stdcall;
	End;

const
	Class_CM2WeatherDotCom: TGUID = '{A78848B6-01D2-4816-92B1-725BB9F43AC0}';

implementation

uses
	ComServ, WeatherSetup, Filter, EasyReg;

{ TCM2WeatherDotCom }

function TCM2WeatherDotCom.Name(out Name: PChar): HResult;
begin
	Name := 'WeatherDotCom';
	Result := S_OK;
end;

function TCM2WeatherDotCom.Version(out Version: Word): HResult;
begin
	Version := 0122;
	Result := S_OK;
end;

function TCM2WeatherDotCom.UpdateFileURL(out URL: PChar): HResult;
begin
	URL := 'http://www.morbidmetal.org/cm2/Gen_WeatherDotCom.upd';
	Result := S_OK;
end;

function TCM2WeatherDotCom.RequiredCoreVersion(out RCV: Word): HResult;
begin
	RCV := 0500;
	Result := S_OK;
end;

function TCM2WeatherDotCom.GetInfo(Index: Integer; out InfoName, InfoVar: PChar): HResult;
begin
	Result := S_OK;
	Case Index of
		0: Begin
			InfoName := 'Programmed By';
			InfoVar := 'Alch';
		End;
		1: Begin
			InfoName := 'Engine By';
			InfoVar := 'C. Aaangel';
		End;
		2: Begin
			InfoName := 'Created';
			Infovar := 'May 2, 2006';
		End;
		3: Begin
			Infoname := 'Last Update';
			Infovar := 'October 30, 2006';
		End;
		4: Begin
			Infoname := 'Copyrights';
			Infovar := 'All Weather Data Property of weather.comŽ';
		End;
		else begin
			Result := E_FAIL;
			LastErrMsg := 'Index out of bounds';
		End;
	End;
end;

function TCM2WeatherDotCom.GetInfoCount(out InfoCount: Integer): HResult;
begin
	InfoCount := 5;
	Result := S_OK;
end;

function TCM2WeatherDotCom.GetLastErrorMsg(OUT Msg: PChar): HResult;
begin
	If LastErrMsg = '' then
		LastErrMsg := 'No Errors';
	Msg := LastErrMsg;
	Result := S_OK;
end;

procedure TCM2WeatherDotCom.OnTimer(Sender: TObject);
begin
	if (Now - LastFullUpdate) * 24 >= 11.9 then
		UpdateType := 1
	else if (Now - LastForecastUpdate) * 24 >= ForecastInt - 0.1 then
		UpdateType := 2
	else
		UpdateType := 3;
	UpdateXML;
end;

procedure TCM2WeatherDotCom.UpdateXML;
var
	Xoap: String;
begin
	Xoap := 'http://xoap.weather.com/weather/local/' +LocID;
	Case UpdateType of
		1: fLink := Xoap+'?cc=*&dayf='+Forecast+'&link=xoap&prod=xoap&par=1021561135&key=dc80cc202c7647ac&unit='+Units;
		2: fLink := Xoap+'?cc=*&dayf='+Forecast+'&prod=xoap&par=1021561135&key=dc80cc202c7647ac&unit='+Units;
		3: fLink := Xoap+'?cc=*&prod=xoap&par=1021561135&key=dc80cc202c7647ac&unit='+Units;
	end;
	if Weather.DownloadAndResolve(fLink) then
	begin
		if UpdateType = 1 then
			LastFullUpdate := Now;
		if (UpdateType = 1) or (UpdateType = 2) then
			LastForecastUpdate := Now;
		LastUpdate := Now;
	end
		else
	begin                  
		UpdateTimer.Enabled := False;
		RetryTimer := TTimer.Create(nil);
		RetryTimer.Interval := 60 * 1000;
		RetryTimer.OnTimer := Retry;
		RetryTimer.Enabled := True;
	end;
end;

procedure TCM2WeatherDotCom.Retry(Sender: TObject);
begin
	RetryTimer.Enabled := False;
	FreeAndNil(RetryTimer);

	try
		if Weather.DownloadAndResolve(fLink) then
		begin
			if UpdateType = 1 then
				LastFullUpdate := Now;
			if (UpdateType = 1) or (UpdateType = 2) then
				LastForecastUpdate := Now;
			LastUpdate := Now;
		end;
	finally
		UpdateTimer.Enabled := True;
	end;
end;

function TCM2WeatherDotCom.GetSensorNameOnly(Index: Integer; OUT SensorName: PChar; OUT SensorStyle: Byte): HResult;
begin
	Result := S_OK;
	SensorStyle := 1;
	Case Index of
		0: SensorName := 'Display Name';
		1: SensorName := 'Latitude';
		2: SensorName := 'Longitude';
		3: SensorName := 'Sunrise';
		4: SensorName := 'Sunset';
		5: SensorName := 'Last Update';
		6: SensorName := 'Observation Station';
		7: SensorName := 'Temperature';
		8: SensorName := 'Feels Like';
		9: SensorName := 'Description/Text';
		10: SensorName := 'Icon';
		11: SensorName := 'Humidity';
		12: SensorName := 'Visibility';
		13: SensorName := 'Dew Point';
		14: SensorName := 'UV Index';
		15: SensorName := 'UV Level';
		16: SensorName := 'Barometer Reading';
		17: SensorName := 'Barometer Direction';
		18: SensorName := 'Wind Speed';
		19: SensorName := 'Wind Gust';
		20: SensorName := 'Wind Direction/Degrees';
		21: SensorName := 'Wind Direction/Text';
		22: SensorName := 'Wind Direction/Arrow';
		23: SensorName := 'Moon Icon';
		24: SensorName := 'Moon Phase';
		25: SensorName := 'Last Forecast Update';
		26: SensorName := 'Day0';
		27: SensorName := 'Day1';
		28: SensorName := 'Day2';
		29: SensorName := 'Day3';
		30: SensorName := 'Day4';
		31: SensorName := 'Day5';
		32: SensorName := 'Day6';
		33: SensorName := 'Day7';
		34: SensorName := 'Day8';
		35: SensorName := 'Day9';
		36: SensorName := 'Link1';
		37: SensorName := 'Link2';
		38: SensorName := 'Link3';
		39: SensorName := 'Link4';
		40: SensorName := 'weather.com';
		else begin
			Result := E_FAIL;
			LastErrMsg := 'Sensor Name Index Out of Bounds';
		End;
	End;
end;    

Function TCM2WeatherDotCom.fFirstRun: Boolean;
begin
	Result := True;
	LoadReg;
	try
		Weather := TWeather.Create;
	except
		LastErrMsg := 'Could not Create Weather';
		Result := False;
		Exit;
	end;
	UpdateType := 1;
	UpdateXML;
	try
		UpdateTimer := TTimer.Create(nil);
		UpdateTimer.Interval := UpdateInt{20} * 60000;
		UpdateTimer.OnTimer := OnTimer;
		UpdateTimer.Enabled := true;
	except
		LastErrMsg := 'Timer Error';
		Result := False;
	end;
end;

function TCM2WeatherDotCom.GetSensor(Index: Integer; Parameters: PChar; out SensorName: PChar;
	out Sensorstyle: byte; out SensorString: PChar; out SensorValue: Double): HResult;
begin
	Result := S_OK;
	if not FirstRun then
	begin
		FirstRun := True;
		if not fFirstRun then
		begin
			Result := E_FAIL;
			exit;
		end;
	end;

	Value := 2;
	if Parameters <> '' then
		Parse(Parameters);
	SensorStyle := 1;
	SensorValue := 0;

	Case Index of
		0: begin SensorName := 'Display Name'; SensorString := PChar(Weather.WeatherRec.Loc.dnam); end;
		1: begin SensorName := 'Latitude'; SensorString := PChar(Weather.WeatherRec.Loc.lat); end;
		2: begin SensorName := 'Longitude'; SensorString := PChar(Weather.WeatherRec.Loc.lon); end;
		3: begin SensorName := 'Sunrise'; SensorString := PChar(Weather.WeatherRec.Loc.sunr); end;
		4: begin SensorName := 'Sunset'; SensorString := PChar(Weather.WeatherRec.Loc.suns); end;
		5: begin SensorName := 'Last Update'; SensorString := PChar(Weather.WeatherRec.CC.lsup); end;
		6: begin SensorName := 'Observation Station'; SensorString := PChar(Weather.WeatherRec.CC.obst); end;
		7: begin SensorName := 'Temperature'; SensorString := PChar(Weather.WeatherRec.CC.tmp); end;
		8: begin SensorName := 'Feels Like'; SensorString := PChar(Weather.WeatherRec.CC.flik); end;
		9: begin SensorName := 'Description/Text'; SensorString := PChar(Weather.WeatherRec.CC.t); end;
		10: begin SensorName := 'Icon'; SensorString := PChar(Weather.WeatherRec.CC.icon); end;
		11: begin SensorName := 'Humidity'; SensorString := PChar(Weather.WeatherRec.CC.hmid); end;
		12: begin SensorName := 'Visibility'; SensorString := PChar(Weather.WeatherRec.CC.vis); end;
		13: begin SensorName := 'Dew Point'; SensorString := PChar(Weather.WeatherRec.CC.dewp); end;
		14: begin SensorName := 'UV Index'; SensorString := PChar(Weather.WeatherRec.CC.UV.i); end;
		15: begin SensorName := 'UV Level'; SensorString := PChar(Weather.WeatherRec.CC.UV.t); end;
		16: begin SensorName := 'Barometer Reading'; SensorString := PChar(Weather.WeatherRec.CC.Bar.r); end;
		17: begin SensorName := 'Barometer Direction'; SensorString := PChar(Weather.WeatherRec.CC.Bar.d); end;
		18: begin SensorName := 'Wind Speed'; SensorString := PChar(Weather.WeatherRec.CC.Wind.s); end;
		19: begin SensorName := 'Wind Gust'; SensorString := PChar(Weather.WeatherRec.CC.Wind.gust); end;
		20: begin SensorName := 'Wind Direction/Degrees'; SensorString := PChar(Weather.WeatherRec.CC.Wind.d); end;
		21: begin SensorName := 'Wind Direction/Text'; SensorString := PChar(Weather.WeatherRec.CC.Wind.t); end;
		22: begin SensorName := 'Wind Direction/Arrow'; SensorString := PChar(Weather.WeatherRec.CC.Wind.arrow); end;
		23: begin SensorName := 'Moon Icon'; SensorString := PChar(Weather.WeatherRec.CC.Moon.icon); end;
		24: begin SensorName := 'Moon Phase'; SensorString := PChar(Weather.WeatherRec.CC.Moon.t); end;
		25: begin SensorName := 'Last Forecast Update'; SensorString := PChar(Weather.WeatherRec.DayF.lsup); end;
		26: begin SensorName := 'Day0'; SensorString := PChar(DaySensor(0)); end;
		27: begin SensorName := 'Day1'; SensorString := PChar(DaySensor(1)); end;
		28: begin SensorName := 'Day2'; SensorString := PChar(DaySensor(2)); end;
		29: begin SensorName := 'Day3'; SensorString := PChar(DaySensor(3)); end;
		30: begin SensorName := 'Day4'; SensorString := PChar(DaySensor(4)); end;
		31: begin SensorName := 'Day5'; SensorString := PChar(DaySensor(5)); end;
		32: begin SensorName := 'Day6'; SensorString := PChar(DaySensor(6)); end;
		33: begin SensorName := 'Day7'; SensorString := PChar(DaySensor(7)); end;
		34: begin SensorName := 'Day8'; SensorString := PChar(DaySensor(8)); end;
		35: begin SensorName := 'Day9'; SensorString := PChar(DaySensor(9)); end;
		36: begin SensorName := 'Link1'; SensorString := PChar(Weather.WeatherRec.Lnks.link[1].l+'&par=1021561135'); end;
		37: begin SensorName := 'Link2'; SensorString := PChar(Weather.WeatherRec.Lnks.link[2].l+'&par=1021561135'); end;
		38: begin SensorName := 'Link3'; SensorString := PChar(Weather.WeatherRec.Lnks.link[3].l+'&par=1021561135'); end;
		39: begin SensorName := 'Link4'; SensorString := PChar(Weather.WeatherRec.Lnks.link[4].l+'&par=1021561135'); end;
		40: begin SensorName := 'weather.com'; SensorString := 'http://www.weather.com/?prod=xoap&par=1021561135'; end;
		else begin
			Result := E_FAIL;
			LastErrMsg := 'Sensor Index Out of Bounds';
		end;
	end;
end;   

function TCM2WeatherDotCom.GetSensorCount(out SensorCount: Integer): HResult;
begin
	SensorCount := 41;
	Result := S_OK;
end;

function TCM2WeatherDotCom.DaySensor(DayX: Integer) : String;
begin
	Case Value of
		0: Result := Weather.WeatherRec.DayF.Day[DayX].t;
		1: Result := Weather.WeatherRec.DayF.Day[DayX].dt;
		2: Result := Weather.WeatherRec.DayF.Day[DayX].hi;
		3: Result := Weather.WeatherRec.DayF.Day[DayX].low;
		4: Result := Weather.WeatherRec.DayF.Day[DayX].sunr;
		5: Result := Weather.WeatherRec.DayF.Day[DayX].suns;
		6: Result := Weather.WeatherRec.DayF.Day[DayX].partD.icon;
		7: Result := Weather.WeatherRec.DayF.Day[DayX].partD.t;
		8: Result := Weather.WeatherRec.DayF.Day[DayX].partD.Wind.s;
		9: Result := Weather.WeatherRec.DayF.Day[DayX].partD.Wind.gust;
		10: Result := Weather.WeatherRec.DayF.Day[DayX].partD.Wind.d;
		11: Result := Weather.WeatherRec.DayF.Day[DayX].partD.Wind.t;
		12: Result := Weather.WeatherRec.DayF.Day[DayX].partD.bt;
		13: Result := Weather.WeatherRec.DayF.Day[DayX].partD.ppcp;
		14: Result := Weather.WeatherRec.DayF.Day[DayX].partD.hmid;
		15: Result := Weather.WeatherRec.DayF.Day[DayX].partN.icon;
		16: Result := Weather.WeatherRec.DayF.Day[DayX].partN.t;
		17: Result := Weather.WeatherRec.DayF.Day[DayX].partN.Wind.s;
		18: Result := Weather.WeatherRec.DayF.Day[DayX].partN.Wind.gust;
		19: Result := Weather.WeatherRec.DayF.Day[DayX].partN.Wind.d;
		20: Result := Weather.WeatherRec.DayF.Day[DayX].partN.Wind.t;
		21: Result := Weather.WeatherRec.DayF.Day[DayX].partN.bt;
		22: Result := Weather.WeatherRec.DayF.Day[DayX].partN.ppcp;
		23: Result := Weather.WeatherRec.DayF.Day[DayX].partN.hmid;
	end;
end;

function TCM2WeatherDotCom.Init: HResult;
begin
	LocId := 'DAXX0009';
	Units := 'm';
	UpdateInt := 30;
	Forecast := '2';
	ForecastInt := 2;
	Result := S_OK;
end;

procedure TCM2WeatherDotCom.LoadReg;
var
	Reg: TEasyReg;
	num: Integer;
begin
	Reg := TEasyReg.Create(nil);
	try
		Reg.HKEY := CURRENT_USER;
		Reg.Path := '\Software\The Coolmon Project\WeatherDotCom';
		Reg.LeaveOpen := True;

		Reg.Read('LocID', LocID);
		Reg.Read('Units', Units);
		if Reg.Read('UpdateInt', UpdateInt) then
		begin
			if UpdateInt < 30 then
				UpdateInt := 30;
		end;
		if Reg.Read('Forecast', num) then
		begin
			if num > 10 then
				Forecast := '10'
			else if num < 0 then
				Forecast := '0'
			else
				Forecast := IntToStr(num);
		end;
		if Reg.Read('ForecastInt', ForecastInt) then
		begin
			if ForecastInt < 2 then
				ForecastInt := 2;
		end;
	finally
		Reg.Close;
		FreeAndNil(Reg);
	end;
end;

function TCM2WeatherDotCom.SetParentHandle(Handle: THandle): HResult;
begin
	Result := S_OK;
end;

function TCM2WeatherDotCom.Setup: HResult;
var
	WeatherSetup: TfrmWeatherSetup;
begin              
	Result := S_OK;
	WeatherSetup := TfrmWeatherSetup.Create(nil);
	try
		try
			WeatherSetup.Execute;
		except
			LastErrMsg := 'Setup Error';
			Result := E_FAIL;
		end;
	finally
		FreeAndNil(WeatherSetup);
	end;
end;

function TCM2WeatherDotCom.Terminating: HResult;
begin
	Result := S_OK;
	try
		UpdateTimer.Free;
	except
		LastErrMsg := 'Could not Free Timer';
		Result := E_FAIL;
	end;
	try
		Weather.Free;
	except
		LastErrMsg := 'Could not Free Weather';
		Result := E_FAIL;
	end;
end;

function TCM2WeatherDotCom.GetDefault(SensorIndex, Index: Integer; out Name, Value, Description: PChar): HResult;
begin
	Result := S_OK;
	Name := 'Value';
	Value := 'High';
	Case SensorIndex of
		26: Description := 'Choose Day0 Sensor';
		27: Description := 'Choose Day1 Sensor';
		28: Description := 'Choose Day2 Sensor';
		29: Description := 'Choose Day3 Sensor';
		30: Description := 'Choose Day4 Sensor';
		31: Description := 'Choose Day5 Sensor';
		32: Description := 'Choose Day6 Sensor';
		33: Description := 'Choose Day7 Sensor';
		34: Description := 'Choose Day8 Sensor';
		35: Description := 'Choose Day9 Sensor';
	end;
end;

function TCM2WeatherDotCom.GetDefaultCount(SensorIndex: Integer; out DefaultCount: Integer): HResult;
begin
	Case SensorIndex of
		26..35: DefaultCount := 1;
		else
			DefaultCount := 0;
	end;
	Result := S_OK;
end;

function TCM2WeatherDotCom.GetOptional(SensorIndex, Index: Integer;
	out Name, Value, Description: PChar): HResult;
begin
	Result := S_OK;
end;

function TCM2WeatherDotCom.GetOptionalCount(SensorIndex: Integer; out OptionalCount: Integer): HResult;
begin
	OptionalCount := 0;
	Result := S_OK;
end;

procedure TCM2WeatherDotCom.Parse(Param: String);
const
	StrArray: Array [0 .. 23] of String = ('DAY', 'DATE', 'HIGH', 'LOW', 'SUNRISE', 'SUNSET',
		'DAY ICON', 'DAY FORECAST/TEXT', 'DAY WIND SPEED', 'DAY WIND GUST', 'DAY WIND DIRECTION/DEGREES', 'DAY WIND DIRECTION/TEXT', 'DAY SHORT FORECAST/TEXT', 'DAY PRECIPITATION', 'DAY HUMIDITY',
		'NIGHT ICON', 'NIGHT FORECAST/TEXT', 'NIGHT WIND SPEED', 'NIGHT WIND GUST', 'NIGHT WIND DIRECTION/DEGREES', 'NIGHT WIND DIRECTION/TEXT', 'NIGHT SHORT FORECAST/TEXT', 'NIGHT PRECIPITATION', 'NIGHT HUMIDITY'
	);
var
	i, j: Integer;
	S, N, V: String;
begin
	For i := 1 to CountFilt(Param, '|') do
	begin
		S := UpperCase(GetFilt(Param, i, '|')); 
		N := GetFilt(S, 1, '=');
		V := GetFilt(S, 2, '=');
		If N = 'VALUE' then
		begin
			For j := 0 to 23 do
			begin
				If V = StrArray[j] then
				begin
					Value := j;
					exit;
				end;
			end;
		end;
	end;
end;

function TCM2WeatherDotCom.ObjIns(SensorIndex: Integer; ParameterName: PChar;
	out ValueType: Byte; out ValueRange: PChar): HResult;
const
	Day = '|Day Icon|Day Forecast/Text|Day Wind Speed|Day Wind Gust|Day Wind Direction/Degrees|Day Wind Direction/Text|Day Short Forecast/Text|Day Precipitation|Day Humidity';
	Night = '|Night Icon|Night Forecast/Text|Night Wind Speed|Night Wind Gust|Night Wind Direction/Degrees|Night Wind Direction/Text|Night Short Forecast/Text|Night Precipitation|Night Humidity';
begin
	Result := S_OK;
	ValueType := vtUnknown;
	ValueRange := '';
	Case SensorIndex of
		26..35: Begin
			If UpperCase(ParameterName) = 'VALUE' then
			begin
				ValueType := vtFixed;
				ValueRange := PChar('Day|Date|High|Low|Sunrise|Sunset' + Day + Night);
			end;
		end;
	end;
end;

function TCM2WeatherDotCom.ShowSensor(Index: Integer; out ShowAt: Byte): HResult;
begin
	Result := S_OK;
	ShowAt := saDesignTime;
end;

initialization
	TComObjectFactory.Create(ComServer, TCM2WeatherDotCom, Class_CM2WeatherDotCom,
		'CM2Gen_WeatherDotCom', 'CoolMon 2 WeatherDotCom Plugin', ciMultiInstance, tmApartment);
end.
