ABACOM - ELECTRONIC SOFTWARE

Code: Alles auswählen

library Wetter;

// Google Wetter XML API
// Beispiel: http://www.google.com/ig/api?weather=Berlin';

uses
  SysUtils,
  Windows,
  Classes,
  VCL.controls, VCL.Forms,
  idHttp, Xml.xmldom, Xml.XMLIntf, Xml.Win.msxmldom, Xml.XMLDoc,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient;


{$R *.RES}

Const  Server = 'http://www.google.com/ig/api?weather=';

       Inputs = 3;  // number of inputs
       Outputs = 12; // number of outputs

       {INPUTS}
       LocationInPin   = 0;   // $PLZ oder ORT
       LanguageInPin   = 1;   // DE, UK, ...
       CLKPin   = 2;   // Clock
       {USER}
       DLLIndex = 100;       // DLL No. set by ProfiLab

Type TDLLParams = array[0..100] of extended;   // Type of ProfiLab DLL parameters
     PDLLParams = ^TDLLParams;                 // Pointer to ProfiLab DLL parameters

     TStringParams = array[0..100] of PAnsiChar;   // Additional string parameters for CalculateEx
     PStringParams = ^TStringParams;               // Pointer to string parameters


var XMLDoc: TXMLDocument;
    DataList: array[0..100] of TStringList;
    Location: String;
    Language: String;

function NumInputs: Byte;
begin
  result:=Inputs; //Define number of component input pins
end;

function NumOutputs: Byte;
begin
  result:=Outputs; //Define number of component output pins
end;

Function InputName(Channel: Byte): ShortString; // Return name for each component input pin
begin
   // string inputs must be named with leading '$' character
   case Channel of
   LocationInPin:  result:='$LOC';   //  Location: PLZ oder Ort
   LanguageInPin:  result:='$LAN';   //  Language de, uk, ...
   ClkPin:         result:='CLK';    //  Update Clk
   end;
end;

Function OutputName(Channel: Byte): ShortString; // Return name for each component output pin
begin
   // string outputs must be named with leading '$' character!
   case Channel of
   0: result:='$LOC'; // Ort
   1: result:='$ZIP'; // PLZ
   2: result:='$DTE'; // Datum
   3: result:='$CDN'; // aktuelle Wetterbdingung
   4: result:='$ °F'; // Aktuelle Temperatur F
   5: result:='$ °C'; // Aktuelle Temperatur C
   6: result:='$HUM'; // Luftfeuchtigkeit %
   7: result:='$WND'; // Wind
   8: result:='$FC1'; // Vorhersage heute + 1 Tag
   9: result:='$FC2'; // Vorhersage heute + 2 Tag
   10: result:='$FC3'; // Vorhersage heute + 3 Tag
   11: result:='$FC4'; // Vorhersage heute + 4 Tag
   end;
end;

// ###########################  XML PARSING #########################

function GetNodeData(aNode: IXMLNode): String;
begin
   result:='';
   if aNode=nil then exit;
   result:=aNode.LocalName;
   try
      result:=aNode.Attributes['data'];
   except
   end;
end;

procedure GetNodeChildren(aNode: IXMLNode);
var i: Integer;
    ChildNode: IXMLNode;
    aString: String;
begin
   if aNode=nil then exit;
   for i:=0 to aNode.ChildNodes.Count-1 do
   begin
      ChildNode:=aNode.ChildNodes[i];
      DataList[0].add(GetNodeData(ChildNode));
      GetNodeChildren(ChildNode);
   end;
end;

function NodeByLocalName(aNode: IXMLNode; aLocalName: String; var Appear: Integer): IXMLNode;
var ChildNode: IXMLNode;
   i: Integer;
begin
   result:=nil;
   if aNode=nil then exit;
   if aNode.LocalName=aLocalName then
   begin
      dec(Appear);
      if appear<=0 then
      begin
         result:=aNode;
         exit;
      end;
   end;
   for i:=0 to aNode.ChildNodes.Count-1 do
   begin
      ChildNode:=aNode.ChildNodes[i];
      result:=NodeByLocalName(ChildNode, aLocalName, Appear);
      if result<>nil then exit;
   end;
end;

function StreamToString(Stream : TStream) : String;
var ms : TMemoryStream;
begin
  Result := '';
  ms := TMemoryStream.Create;
  try
    ms.LoadFromStream(Stream);
    SetString(Result,PAnsiChar(ms.memory),ms.Size);
  finally
    ms.free;
  end;
end;

function ReadSite(URI: string): String; // Request mit Indy 10 componenten
 var
   idClient: TIdHTTP;
   msData: TMemoryStream;
   ResultString: String;
begin
     ResultString:='';
     idClient := TIdHTTP.Create(Application);
     idClient.Request.AcceptLanguage:=Language;
     msData := TMemoryStream.Create;
     try
       idClient.Get(URI, msData);
       msData.Seek(0, soFromBeginning);
       ResultString := StreamToString(msData);
     finally
        idClient.Free;
        msData.Free;
     end;

   result := ResultString;
end;

procedure GetDataList; // XML PARSER
var InfoNode: IXMLNode;
    ConditionsNode: IXMLNode;
    ForecastNode: IXMLNode;
    aNode: IXMLNode;
    ForeCastString, UnitSystem: String;
    Appear,i: Integer;
begin
   xmldoc.XML.Add(ReadSite('http://www.google.com/ig/api?weather='+Location));

   xmldoc.Active:=true;

   //General Info
   Appear:=1;
   InfoNode:=NodeByLocalName(xmldoc.DocumentElement, 'forecast_information', Appear);
   Appear:=1;
   aNode:=NodeByLocalName(InfoNode, 'city', Appear);
   DataList[0].Add(GetNodeData(aNode));
   Appear:=1;
   aNode:=NodeByLocalName(InfoNode, 'postal_code', Appear);
   DataList[0].Add(GetNodeData(aNode));
   Appear:=1;
   aNode:=NodeByLocalName(InfoNode, 'forecast_date', Appear);
   DataList[0].Add(GetNodeData(aNode));
   Appear:=1;
   aNode:=NodeByLocalName(InfoNode, 'unit_system', Appear);
   UnitSystem:=GetNodeData(aNode);

   // Current condition
   Appear:=1;
   ConditionsNode:=NodeByLocalName(xmldoc.DocumentElement, 'current_conditions', Appear);
   Appear:=1;
   aNode:=NodeByLocalName(ConditionsNode, 'condition', Appear);
   DataList[0].Add(GetNodeData(aNode));
   Appear:=1;
   aNode:=NodeByLocalName(ConditionsNode, 'temp_f', Appear);
   DataList[0].Add(GetNodeData(aNode)+' °F');
   Appear:=1;
   aNode:=NodeByLocalName(ConditionsNode, 'temp_c', Appear);
   Appear:=1;
   DataList[0].Add(GetNodeData(aNode)+' °C');
   Appear:=1;
   aNode:=NodeByLocalName(ConditionsNode, 'humidity', Appear);
   DataList[0].Add(GetNodeData(aNode));
   Appear:=1;
   aNode:=NodeByLocalName(ConditionsNode, 'wind_condition', Appear);
   DataList[0].Add(GetNodeData(aNode));

   //4x Forcast
   for i:=1 to 4 do
   begin
      Appear:=i;
      ForeCastNode:=NodeByLocalName(xmldoc.DocumentElement, 'forecast_conditions', Appear);
      Appear:=1;
      aNode:=NodeByLocalName(ForecastNode, 'day_of_week', Appear);
      ForeCastString:=GetNodeData(aNode)+';';
      Appear:=1;
      aNode:=NodeByLocalName(ForecastNode, 'condition', Appear);
      ForeCastString:=ForeCastString+GetNodeData(aNode)+';';
      Appear:=1;
      aNode:=NodeByLocalName(ForecastNode, 'low', Appear);
      ForeCastString:=ForeCastString+GetNodeData(aNode)+';';
      Appear:=1;
      aNode:=NodeByLocalName(ForecastNode, 'high', Appear);
      ForeCastString:=ForeCastString+GetNodeData(aNode)+';'+UnitSystem;
      DataList[0].Add(ForeCastString);
   end;

   xmldoc.Active:=false;
end;


// ##################

// New CalculateEx method now allows string parameters...
Procedure CalculateEx(PInput,POutput,PUser: PDLLParams; PStrings: PStringParams); //called regularly from ProfiLab
var aString: AnsiString;
    aWord: Word;
    aChar: AnsiChar;
    aExtended: extended;
    Hour, Min, Sec, MSec: Word;
    i: integer;
    DLLNo: Integer;
begin
   DLLNo:=round(PUser^[DLLIndex]); // Die ProfiLab DLL Nummer
   if Datalist[0]=nil then DataList[0]:=TStringlist.Create; // Templiste zum Daten holen
   if Datalist[DllNo]=nil then DataList[DllNo]:=TStringlist.Create; // Listen für bis zu 100 DLL-Import (Wetter für 100 Orte)

   if (PInput^[ClkPin]<2.5) and (PUser^[ClkPin]>=2.5) then // Abfrage Taktsignal
   begin
      Location:=strPas(PStrings[LocationInPin]);  // Der Ort
      while pos('  ',location)>0 do location:=StringReplace(Location,'  ',' ',[rfReplaceAll]);
      location:=StringReplace(Location,' ','+',[rfReplaceAll]);
      Language:=strPas(PStrings[LanguageInPin]);  // Die Sprache

      Datalist[0].Clear; // Templiste leeren
      XMLDoc:=TXMLDocument.Create(Application); // XML vorbereiten
      GetDataList; // Daten holen und XML parsen => Ergebnis in Datalist[0]
      DataList[DLLno].Assign(Datalist[0]); // Tempdaten der passenden DLL zuordnen
      XMLDoc.Free; // Daten fertig
   end;

   PUser^[ClkPin]:=PInput^[ClkPin]; // Alten Clock merken

   // Ausgangswerte (aus passender Datenliste) ausgeben
   for i:=0 to 11 do
   begin
      if DataList[DllNo].count>i then strPCopy(PStrings[i], DataList[DLLNo][i])
                          else strPCopy(PStrings[i], '');
   end;
end;


//export methods for ProfiLab
exports NumInputs,
        NumOutputs,
        CalculateEx,
        InputName,
        OutputName;

begin

end.