unit weather;

interface

Uses
	xmldom, XMLIntf, msxmldom, XMLDoc;

Type
	TBar = record
		r: string;
		d: string;
	end;
	TWind = record
		s: String;
		gust: string;
		d: string;
		t: string;
		arrow: String;
	end;
	TUV = record
		i: string;
		t: string;
	end;
	TMoon = record
		icon: string;
		t: string;
	end;
	TPart = record
		p: string;
		icon: string;
		t: string;
		Wind: TWind;
		bt: string;
		ppcp: string;
		hmid: string;
	end;
	TDay = record
		d: string;
		t: string;
		dt: String;
		hi: string;
		low: string;
		sunr: string;
		suns: string;
		partD: TPart;
		partN: TPart;
	end;
	TLink = record
		pos: string;
		l: string;
		t:string;
	end;
	TDayF = Record
		lsup: String;
		Day: array [0 .. 9] of TDay;
		DayCount: Integer;
	end;
	TCC = record
		lsup: String;
		obst: string;
		tmp: String;
		flik: String;
		t: string;
		icon: String;
		hmid: String;
		vis: string;
		dewp: String;
		UV: TUV;
		Bar: TBar;
		Wind: TWind;
		Moon: TMoon;
	end;
	TLoc = record
		id: String;
		dnam: string;
		tm: String;
		lat: string;
		lon: string;
		sunr: string;
		suns: string;
		zone: String;
	end;
	THead = record
		Locale: string;
		form: String;
		ut: string;
		ud: string;
		us: string;
		up: String;
		ur: string;
	end;
	TLnks = record
		ltype: string;
		link: array[1 .. 4] of TLink;
	end;
	TWeatherRec = record
		CC: TCC;
		DayF: TDayF;
		Head: THead;
		Loc: TLoc;
		Lnks: TLnks;
		Version: String;
	end;
	TLocRec = Record
		ID: String;
		City: string;
	end;
	TOnError = Procedure(Sender: TObject; ErrorCode: Integer; ErrorDes: String) of object;
	TWeather = class(TObject)
	private
		Error: boolean;
		FOnError: TOnError;
		Procedure LoadWeather(FromNode: IXMLNode);
		Procedure LoadHead(FromNode: IXMLNode);
		Procedure LoadLoc(FromNode: IXMLNode);
		Procedure LoadLnks(FromNode: IXMLNode);
		Procedure LoadLink(FromNode: IXMLNode; var Link: TLink);
		Procedure LoadCC(FromNode: IXMLNode);
		Procedure LoadBar(FromNode: IXMLNode; var Bar: TBar);
		Procedure LoadWind(FromNode: IXMLNode; var Wind: TWind);
		Procedure LoadUV(FromNode: IXMLNode; var UV: TUV);
		Procedure LoadMoon(FromNode: IXMLNode; Var Moon: TMoon);
		Procedure LoadDayf(FromNode: IXMLNode);
		Procedure LoadDay(FromNode: IXMLNode; Var Day: TDay);
		Procedure LoadPart(FromNode: IXMLNode; Var Part: TPart);
		Procedure _OnError(Sender: TObject; ErrorCode: integer);
		procedure SetOnError(const Value: TOnError);
	public
		WeatherRec: TWeatherRec;
		Constructor Create;
		Destructor Destroy; override;
		Property OnError: TOnError read FOnError write SetOnError;
		Function DownloadAndResolve(URL: String): boolean;
	end;
	TWeatherLoc = Class(TObject)
	private
		Error: boolean;
		fList: array of TLocRec;
		fOnError: TOnError;
		fVersion: String;
		fCity: String;
		function GETCOUNT: cardinal;
		function GETLOC(Index: Integer): TLocRec;
		Procedure _OnError(Sender: TObject; ErrorCode: integer);
	public
		constructor Create(City: String; ErrorProc: TOnError);
		Function DownloadAndResolve: boolean;
		Property Count: cardinal read GETCOUNT;
		Property Location[Index: Integer]: TLocRec read GETLOC; default;
		Property OnError: TOnError read fOnError write fOnError;
		Property Version: String read fVersion;
		Property City: string read fCity write fCity;
	end;

implementation

Uses
	Forms, SysUtils, lplDownload;

{ TWeather }

Constructor TWeather.Create;
begin
	// blank.
end;

function TWeather.DownloadAndResolve(URL: String): boolean;
Var
	XML: TXMLDocument;
	Form: TForm;
	I: Integer;
	DL: TlplDownload;
begin
	Result := true;
	Error := false;
	DL := TlplDownload.Create(nil);
	DL.Agent := 'TWeather';
	DL.AllowRedirect := true;
	dl.Filename := 'weather.xml';
	dl.URL := URL;
	dl.OnError := _OnError;
	dl.DownloadFile;
	If Error then
	begin
		Result := False;
		dl.Free;
		exit;
	end;
	If not FileExists('weather.xml') then
	begin
		Result := false;
		dl.Free;
		exit;
	end;
	Form := TForm.Create(nil);
	XML := TXMLDocument.Create(form);
	XML.LoadFromFile('weather.xml');
	XML.Active := true;
	For I := 0 to XML.ChildNodes.Count - 1 do
	begin
		if xml.ChildNodes[I].NodeName = 'weather' then
			LoadWeather(xml.ChildNodes[I]);
	end;
	XML.Active := false;
	XML.Free;
	Form.Free;
	DL.Free;
	DeleteFile('weather.xml');
end;

destructor TWeather.Destroy;
begin
	inherited;
end;

procedure TWeather.LoadBar(FromNode: IXMLNode; var Bar: TBar);
begin
	bar.r := fromNode.ChildValues['r'];
	bar.d := fromNode.ChildValues['d'];
end;

procedure TWeather.LoadCC(FromNode: IXMLNode);
Var
	I: Integer;
begin
	WeatherRec.CC.lsup := FromNode.ChildValues['lsup'];
	WeatherRec.CC.obst := FromNode.ChildValues['obst'];
	WeatherRec.CC.tmp := FromNode.ChildValues['tmp'];
	WeatherRec.CC.flik := FromNode.ChildValues['flik'];
	WeatherRec.CC.t := FromNode.ChildValues['t'];
	WeatherRec.CC.icon := FromNode.ChildValues['icon'];
	WeatherRec.CC.hmid := FromNode.ChildValues['hmid'];
	WeatherRec.CC.vis := FromNode.ChildValues['vis'];
	WeatherRec.CC.dewp := FromNode.ChildValues['dewp'];
	For I := 0 to FromNode.ChildNodes.Count - 1 do
	begin
		If uppercase(fromNode.ChildNodes[I].NodeName) = 'BAR' then
		begin
			LoadBar(FromNode.Childnodes[I], WeatherRec.CC.Bar);
			continue;
		end;
		If uppercase(fromNode.ChildNodes[I].NodeName) = 'WIND' then
		begin
			LoadWind(FromNode.Childnodes[I], WeatherRec.CC.Wind);
			continue;
		end;
		If uppercase(fromNode.ChildNodes[I].NodeName) = 'UV' then
		begin
			LoadUV(FromNode.ChildNodes[I], WeatherRec.CC.Uv);
			continue;
		end;
		If uppercase(fromNode.ChildNodes[I].NodeName) = 'MOON' then
		begin
			LoadMoon(FromNode.ChildNodes[I], WeatherRec.CC.Moon);
			continue;
		end;
	end;
end;

procedure TWeather.LoadDay(FromNode: IXMLNode; var Day: TDay);
Var
	I: Integer;
begin
	Day.d := FromNode.Attributes['d'];
	Day.t := FromNode.Attributes['t'];
	Day.dt := FromNode.Attributes['dt'];
	Day.hi := FromNode.ChildValues['hi'];
	Day.low := FromNode.ChildValues['low'];
	Day.sunr := FromNode.ChildValues['sunr'];
	Day.suns := FromNode.ChildValues['suns'];
	For I := 0 to FromNode.ChildNodes.Count - 1 do begin
		If uppercase(FromNode.ChildNodes[I].NodeName) = 'PART' then
		begin
			If FromNode.ChildNodes[I].Attributes['p'] = 'd' then
			begin
				LoadPart(FromNode.ChildNodes[I], Day.partD);
			end
				else
			begin
				LoadPart(FromNode.ChildNodes[I], Day.partN);
			end;
		end;
	end;
end;

procedure TWeather.LoadDayf(FromNode: IXMLNode);
Var
	Index, I: Integer;
begin
	WeatherRec.DayF.lsup := FromNode.ChildValues['lsup'];
	WeatherRec.DayF.DayCount := 0;
	For I := 0 to FromNode.ChildNodes.Count - 1 do
	begin
		If uppercase(fromnode.childnodes[I].NodeName) = 'DAY' then
		begin
			Index := FromNode.ChildNodes[I].Attributes['d'];
			LoadDay(FromNode.ChildNodes[I], WeatherRec.DayF.Day[Index]);
			Inc(WeatherRec.DayF.DayCount);
		end;
	end;
end;

procedure TWeather.LoadHead(FromNode: IXMLNode);
begin
	WeatherRec.Head.Locale := FromNode.ChildValues['locale'];
	WeatherRec.Head.form := FromNode.ChildValues['form'];
	WeatherRec.Head.ut := FromNode.ChildValues['ut'];
	WeatherRec.Head.ud := FromNode.ChildValues['ud'];
	WeatherRec.Head.us := FromNode.ChildValues['us'];
	WeatherRec.Head.up := FromNode.ChildValues['up'];
end;

procedure TWeather.LoadLnks(FromNode: IXMLNode);//added this
var
	index, i: integer;
begin
	WeatherRec.Lnks.ltype := FromNode.Attributes['type'];
	for i := 0 to FromNode.ChildNodes.Count-1 do
	begin
		if UpperCase(FromNode.ChildNodes[i].NodeName) = 'LINK' then
		begin
			index := FromNode.ChildNodes[i].Attributes['pos'];
			LoadLink(FromNode.ChildNodes[i], WeatherRec.Lnks.link[index]);
		end;
	end;
end;

procedure TWeather.LoadLink(FromNode: IXMLNode; var Link: TLink);//added this
begin
	Link.pos := FromNode.Attributes['pos'];
	Link.l := FromNode.ChildValues['l'];
	Link.t := FromNode.ChildValues['t'];
end;

procedure TWeather.LoadLoc(FromNode: IXMLNode);
begin
	WeatherRec.Loc.id := FromNode.Attributes['id'];
	WeatherRec.Loc.dnam := FromNode.ChildValues['dnam'];
	WeatherRec.Loc.tm := FromNode.ChildValues['tm'];
	WeatherRec.Loc.lat := FromNode.ChildValues['lat'];
	WeatherRec.Loc.lon := FromNode.ChildValues['lon'];
	WeatherRec.Loc.sunr := FromNode.ChildValues['sunr'];
	WeatherRec.Loc.suns := FromNode.ChildValues['suns'];
	WeatherRec.Loc.zone := FromNode.ChildValues['zone'];
end;

procedure TWeather.LoadMoon(FromNode: IXMLNode; var Moon: TMoon);
begin
	Moon.icon := FromNode.Childvalues['icon'];
	Moon.t := FromNode.ChildValues['t'];
end;

procedure TWeather.LoadPart(FromNode: IXMLNode; var Part: TPart);
Var
	I: Integer;
begin
	Part.p := FromNode.Attributes['p'];
	Part.icon := FromNode.ChildValues['icon'];
	Part.t := FromNode.ChildValues['t'];
	Part.bt := FromNode.ChildValues['bt'];
	Part.ppcp := FromNode.ChildValues['ppcp'];
	Part.hmid := FromNode.ChildValues['hmid'];
	For I := 0 to FromNode.ChildNodes.Count - 1 do
	begin
		if uppercase(FromNode.ChildNodes[I].NodeName) = 'WIND' then
		begin
			LoadWind(FromNode.ChildNodes[I], Part.Wind);
		end;
	end;
end;

procedure TWeather.LoadUV(FromNode: IXMLNode; var UV: TUV);
begin
	uv.i := FromNode.ChildValues['i'];
	uv.t := FromNode.ChildValues['t'];
end;

procedure TWeather.LoadWeather(FromNode: IXMLNode);  //changed this
Var
	I: Integer;
begin
	WeatherRec.Version := FromNode.Attributes['ver'];
	For I := 0 to FromNode.ChildNodes.Count - 1 do
	begin
		if uppercase(fromnode.childnodes[I].NodeName) = 'HEAD' then
			LoadHead(fromNode.Childnodes[I])
		else if uppercase(fromnode.childnodes[I].nodename) = 'LOC' then
			LoadLoc(fromNode.ChildNodes[I])
		else if uppercase(fromnode.childnodes[I].nodename) = 'LNKS' then
			LoadLnks(fromNode.ChildNodes[I])
		else if uppercase(fromnode.ChildNodes[I].NodeName) = 'CC' then
			LoadCC(fromnode.ChildNodes[I])
		else If uppercase(FromNode.ChildNodes[I].NodeName) = 'DAYF' then
			LoadDayF(FromNode.Childnodes[I]);
	end;
end;

procedure TWeather.LoadWind(FromNode: IXMLNode; var Wind: TWind);
var
	Num: integer;
begin
	Wind.s := FromNode.ChildValues['s'];
	Wind.gust := FromNode.ChildValues['gust'];
	Wind.d := FromNode.ChildValues['d'];
	Wind.t := FromNode.ChildValues['t'];

	try
		Num := StrToInt(Wind.d);
	except
		Num := 500;
	end;

	Case Num of //45 deg range
		1..22, 338..360: Wind.arrow := 'ê';//south
		23..67: Wind.arrow := 'í';//'SouthWest';
		68..112: Wind.arrow := 'ç';//'West';
		113..157: Wind.arrow := 'ë';//'NorthWest';
		158..202: Wind.arrow := 'é';//'North';
		203..247: Wind.arrow := 'ì';//'NorthEast';
		248..292: Wind.arrow := 'è';//'East';
		293..337: Wind.arrow := 'î';//'SouthEast';
		else Wind.arrow := '[';//'Error';
	end;
end;

procedure TWeather._OnError(Sender: TObject; ErrorCode: integer);
begin
	If assigned(OnError) then
	begin
		OnError(Self, ErrorCode, (sender as TlplDownload).GetErrorCodeDes(ErrorCode));
	end;
	Error := true;
end;

procedure TWeather.SetOnError(const Value: TOnError);
begin
	FOnError := Value;
end;

{ TWeatherLoc }

constructor TWeatherLoc.Create(City: String; ErrorProc: TOnError);
begin
	FOnError := ErrorProc;
	fCity := City;
end;

function TWeatherLoc.DownloadAndResolve: boolean;
Var
	XML: TXMLDocument;
	Form: TForm;
	I, II: Integer;
	DL: TlplDownload;
	Node: IXMLNode;
begin
	Error := False;
	Result := true;
	DL := TlplDownload.Create(nil);
	DL.Agent := 'TWeather';
	DL.AllowRedirect := true;
	dl.Filename := 'weatherloc.xml';
	dl.URL := 'http://xoap.weather.com/search/search?where=' + City;
	dl.OnError := _OnError;
	dl.DownloadFile;
	If error then
	begin
		Result := False;
		exit;
	end;
	If not fileexists('weatherloc.xml') then
	begin
		Result := False;
		exit;
	end;
	Form := TForm.Create(nil);
	XML := TXMLDocument.Create(form);
	XML.LoadFromFile('weatherloc.xml');
	XML.Active := true;
	SetLength(fList, 0);
	For I := 0 to XML.ChildNodes.Count - 1 do
	begin
		if xml.ChildNodes[I].NodeName = 'search' then
		begin
			Node := xml.ChildNodes[I];
			fVersion := node.Attributes['ver'];
			For II := 0 to node.ChildNodes.Count - 1 do
			begin
				if node.ChildNodes[II].NodeName = 'loc' then
				begin
					SetLength(fList, count + 1);
					fList[Count-1].ID := node.ChildNodes[II].Attributes['id'];
					fList[count-1].City := node.ChildNodes[II].NodeValue;
				end;
			end;
		end;
	end;
	XML.Active := false;
	XML.Free;
	Form.Free;
	DL.Free;
	DeleteFile('weatherloc.xml');
end;

function TWeatherLoc.GETCOUNT: cardinal;
begin
	result := length(fList);
end;

function TWeatherLoc.GETLOC(Index: Integer): TLocRec;
begin
	Result := fList[Index];
end;

procedure TWeatherLoc._OnError(Sender: TObject; ErrorCode: integer);
begin
	If assigned(OnError) then
		OnError(Self, ErrorCode, (sender as TlplDownload).GetErrorCodeDes(ErrorCode));
	error := true;
end;

end.
