ScriptEngine II (v. 0.6.1)

[littleDave]

Zitat von toms:

PS: http://www.delphipraxis.net/rdf.php existiert nicht mehr.

Oh, danke für den Hinweis. Ich habe das Beispiel lange nicht mehr angeschaut - ich habe daher mal eine aktuelle Version erstellt. Einfach kopieren und im Editor einfügen.

Delphi-Quellcode:

program Project1;

uses
  System.Threading,
  System.Xml,
  Net.Indy;

type
  { Feed Query Data }
  TFeedQuery = record
  private
    FURL      : string;
    FUsesUTF8 : boolean;
  public
    class function Create(URL: string; UsesUTF8: boolean): TFeedQuery;
  
    property URL      : string read FURL;
    property UsesUTF8 : boolean read FUsesUTF8;
  end;
  
class function TFeedQuery.Create(URL: string; UsesUTF8: boolean): TFeedQuery;
begin
  result.FURL := URL;
  result.FUsesUTF8 := UsesUTF8;
end;

type
  { Execution Thread }
  TMyExecution = class(TExecutionContext)
  private
    FData  : string;
    FError : boolean;
    FQuery : TFeedQuery;
  protected
    procedure Execute; override;
    function  ExtractTitles: string;
  public
    constructor Create(Query: TFeedQuery); virtual;
  end;
  
constructor TMyExecution.Create(Query: TFeedQuery);
begin  
  inherited Create;
  FQuery := Query;
end;

function   TMyExecution.ExtractTitles: string;
var s: string;
    iStart, iStop: integer;
    tmp : string;
begin
  s := Self.FData;
  iStart := s.IndexOf('<title>');
  while iStart > 0 do
  begin
    iStop := s.IndexOf('</title>');
    if iStop > 0 then
    begin
      tmp := XML.Decode(s.Copy(iStart + string('<title>').Length, iStop - iStart - string('<title>').Length));
      if Self.FQuery.UsesUTF8 then
         result := result + StringEncoding.ToString(StringEncoding.AsUTF8(tmp)) + #13#10 
      else
         result := result + tmp + #13#10;
      s := s.Copy(iStop + string('</title>').Length);  
      iStart := s.IndexOf('<title>');  
    end else
      iStart := 0;
  end;  
end;

procedure  TMyExecution.Execute;
var http: TIdHTTP;
begin
  http := TIdHTTP.Create;
  try
    http.HandleRedirects := True;
    try
      Self.FData := http.Get(Self.FQuery.URL);   
      Self.FData := Self.FData
                   .Replace(#10, #13#10);
    except
      on e: EException do
      begin
        Self.FError := True;
        Self.FData := e.ToString;
      end;
    end;  
    
  finally
    http.Free;
  end;
end;  

function SelectFeedSource(var Query: TFeedQuery): boolean;
begin
  result := True;
  Console.WriteLine('Press [d] for Delphi, [s] for Spiegel, [h] for Heise, [esc] to cancel');
  while true do
  begin
    case Console.ReadKey.ToUpper of
    'D' :
      begin
        Query := TFeedQuery.Create('http://www.delphipraxis.net/external.php?type=RSS2', False);
        break;
      end;
    'S' :
      begin                                                
        Query := TFeedQuery.Create('http://www.spiegel.de/schlagzeilen/tops/index.rss', False);
        break;
      end;
    'H' :
      begin                                       
        Query := TFeedQuery.Create('http://www.heise.de/newsticker/heise.rdf', True);
        break;
      end;   
    Strings.FromASCIIIndex(KeyCodes.Escape) :
      begin
        result := False;
        exit;
      end;
    end;
  end;
end;

{ Main APP }
var t     : TThread;
    c     : TMyExecution;
    Query : TFeedQuery;
begin      
  if not SelectFeedSource(Query) then
     exit;
     
  repeat
    Console.Clear;
    c := TMyExecution.Create(Query);
    try
      t := TThread.NewThread(c);
      try      
        t.Start;
        
        Console.WriteLine('Connecting ' + Query.URL);
        Console.Write('Waiting ');
        while (t.State <> ThreadState.Finished) do
        begin               
          Console.Write('.');
          TThread.Sleep(100); 
          TThread.Sleep(100);
          TThread.Sleep(50);
        end;
        Console.Clear;
        if c.FError then
        begin
          Console.ForegroundColor := Colors.Red;
          Console.WriteLine(c.FData);
          Console.ForegroundColor := Colors.White;
        end
        else
          Console.WriteLine(c.ExtractTitles);
      finally
        t.Free;
      end;
    finally
      c.Free;
    end;
    
    Console.WriteLine;       
    if not SelectFeedSource(Query) then
       exit;
       
  until False;
end.