{********************************************}
{   TeeChart Pro  - URL files retrieval      }
{ Copyright (c) 1995-2020 by Steema Software }
{    All Rights Reserved                     }
{********************************************}
unit TeeURL;
{$I TeeDefs.inc}

interface

Uses {$IFNDEF LINUX}
     {$IFNDEF FMX}
     Windows,
     {$ENDIF}
     {$ENDIF}

     {$IFDEF D18}
     System.Generics.Collections,
     {$ENDIF}

     {$IFDEF FMX}
     FMX.Types,
     {$ENDIF}
     Classes,
     {$IFDEF FMX}
     FMXTee.Canvas, FMXTee.Procs, FMXTee.Engine, FMXTee.Chart
     {$ELSE}
     TeeProcs, TeEngine, Chart
     {$ENDIF};

type
  { Series Source with FileName property }
  TTeeSeriesSourceFile=class(TTeeSeriesSource)
  private
    FChart    : TCustomChart;
    FFileName : String;

    procedure SetChart(const Value: TCustomChart);
    procedure SetFileName(const Value:String);
  protected
    procedure Notification(AComponent: TComponent;
                           Operation: TOperation); override;
  public
    Procedure Load; override;
    Procedure LoadFromFile(Const AFileName:String);
    Procedure LoadFromStream(AStream:TStream); virtual;
    Procedure LoadFromURL(const URL:String);

    property Chart:TCustomChart read FChart write SetChart;
    property FileName:String read FFileName write SetFileName;
  end;

  {$IFDEF D16}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32 {$IFDEF D26}or pidOSX64{$ENDIF})]
  {$ENDIF}
  TImportChart=class(TCustomChartLink)
  private
    { Private declarations }
    FKeepPosition : Boolean;
    FKeepSize     : Boolean;

    FOnLoaded     : TNotifyEvent;
    FOnLoading    : TNotifyEvent;

    procedure CheckChart;
    procedure CheckPosition(const Rect:TRect);
  public
    { Public declarations }
    Constructor Create(AOwner:TComponent); override;

    procedure LoadFromFile(const FileName:String);
    procedure LoadFromStream(const Stream:TStream);
    procedure LoadFromURL(const URL:String);
  published
    { Published declarations }
    property Chart;
    property KeepPosition:Boolean read FKeepPosition write FKeepPosition default True;
    property KeepSize:Boolean read FKeepSize write FKeepSize default True;

    { Events }
    property OnLoaded:TNotifyEvent read FOnLoaded write FOnLoaded;
    property OnLoading:TNotifyEvent read FOnLoading write FOnLoading;
  end;

  {$IFDEF D16}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32 {$IFDEF D26}or pidOSX64{$ENDIF})]
  {$ENDIF}
  TChartWebSource = class(TImportChart)
  private
    FURL : String;
  public
    { Public declarations }
    Constructor Create(AOwner:TComponent); override;
    Procedure Execute;
  published
    { Published declarations }
    property URL:String read FURL write FURL;
  end;


{ Read a Chart from a file (ie: Chart1,'http://www.steema.com/demo.tee' ) }
Procedure LoadChartFromURL(var AChart:TCustomChart; const URL:String); overload;
Procedure LoadChartFromURL(var AChart:TCustomChart; const URL:String; AStream:TStream); overload;

Function DownloadURL(const URL:String; const ToStream:TStream
                     {$IFNDEF FMX}
                     ; OnCallback:TDownloadURLCallBack=nil
                     {$ENDIF}
                     ; UseCache:Boolean=False
                     ): {$IFDEF FMX}Integer{$ELSE}HResult{$ENDIF}
                     ;

// Returns True when St parameter contains a web address (http or ftp)
Function TeeIsURL(St:String):Boolean;

// Returns True if the URL parameter exists (without downloading it from the server)
function TeeURLExists(URL:String):Boolean;

{ Returns a string with the error message from WinInet.dll.
  The Parameter ErrorCode is the result of the DownloadURL function. }
function TeeURLErrorMessage(ErrorCode: Integer): string;

{$IFNDEF FMX}
{ The Windows Handle to WinInet.dll. 0=not opened yet. }
var TeeWinInetDLL:THandle=0;
{$ENDIF}

implementation

Uses
  {$IFDEF FMX}

  {$IFNDEF IOS}
  IdHTTP,
  {$ENDIF}

  {$ELSE}
  Controls,
  {$ENDIF}

  SysUtils,

  {$IFDEF FMX}
  FMXTee.Html, FMXTee.Constants, FMXTee.Store
  {$ELSE}
  TeCanvas, TeeHtml, TeeConst, TeeStore
  {$ENDIF}
  ;

procedure LoadChartFromURL(var AChart:TCustomChart; const URL:String);
var Stream : TMemoryStream;
begin
  Stream:=TMemoryStream.Create;
  try
    LoadChartFromURL(AChart,URL,Stream);
  finally
    Stream.Free;
  end;
end;

Procedure LoadChartFromURL(var AChart:TCustomChart; const URL:String; AStream:TStream);
var tmp : Integer;
    R   : TRect;
begin
  tmp:=DownloadURL(URL,AStream);

  if tmp=0 then
  begin
    R:=AChart.BoundsRect;
    AStream.Position:=0;
    LoadChartFromStream(TCustomChart(AChart),AStream);

    if csDesigning in AChart.ComponentState then
       AChart.BoundsRect:=R;
  end
  else
    Raise ChartException.CreateFmt(TeeMsg_CannotLoadChartFromURL,
                                 [tmp,#13+String(URL)+#13+TeeURLErrorMessage(tmp)]);
end;

{$IFNDEF FMX}

Const INTERNET_OPEN_TYPE_PRECONFIG = 0;
      // INTERNET_FLAG_RAW_DATA       = $40000000;  { receive the item as raw data }
      INTERNET_FLAG_NO_CACHE_WRITE = $04000000;  { do not write this item to the cache }
      // INTERNET_FLAG_DONT_CACHE     = INTERNET_FLAG_NO_CACHE_WRITE;
      // WININET_API_FLAG_SYNC        = $00000004;  { force sync operation }
      INTERNET_FLAG_RELOAD         = $80000000;  { retrieve the original item }
      INTERNET_FLAG_HYPERLINK      = $00000400;  { asking wininet to do hyperlinking semantic which works right for scripts }
      INTERNET_FLAG_PRAGMA_NOCACHE = $00000100;  { asking wininet to add "pragma: no-cache" }
      INTERNET_FLAG_RESYNCHRONIZE  = $00000800;  { Reloads HTTP resources if the resource has been modified since the last time it was downloaded. All FTP and Gopher resources are reloaded }

      // HTTP_QUERY_CONTENT_LENGTH    = 5;
      // HTTP_QUERY_FLAG_NUMBER       = $20000000;
      HTTP_QUERY_STATUS_CODE       = 19;
      // INTERNET_DEFAULT_HTTP_PORT   = 80;
      // INTERNET_SERVICE_HTTP        = 3;

type
  HINTERNET = Pointer;
  // INTERNET_PORT = Word;

var
   _InternetOpenA:function(lpszAgent: PAnsiChar; dwAccessType: DWORD;
                          lpszProxy, lpszProxyBypass: PAnsiChar;
                          dwFlags: DWORD): HINTERNET; stdcall;

   _InternetOpenURLA:function(hInet: HINTERNET; lpszUrl: PAnsiChar;
                         lpszHeaders: PAnsiChar; dwHeadersLength: DWORD; dwFlags: DWORD;
                         dwContext: DWORD): HINTERNET; stdcall;

  _InternetReadFile:function(hFile: HINTERNET; lpBuffer: Pointer;
                         dwNumberOfBytesToRead: DWORD;
                         var lpdwNumberOfBytesRead: DWORD): BOOL; stdcall;

  _InternetCloseHandle:function(hInet: HINTERNET): BOOL; stdcall;

  _HttpQueryInfoA:function(hRequest: HINTERNET; dwInfoLevel: DWORD;
                         lpvBuffer: Pointer; var lpdwBufferLength: DWORD;
                         var lpdwReserved: DWORD): BOOL; stdcall;

procedure InitWinInet;
begin
  if TeeWinInetDLL=0 then
  begin
    TeeWinInetDLL:=TeeLoadLibrary('wininet.dll');

    if TeeWinInetDLL<>0 then
    begin
      @_InternetOpenA      :=GetProcAddress(TeeWinInetDLL,'InternetOpenA');
      @_InternetOpenURLA   :=GetProcAddress(TeeWinInetDLL,'InternetOpenUrlA');
      @_InternetReadFile   :=GetProcAddress(TeeWinInetDLL,'InternetReadFile');
      @_InternetCloseHandle:=GetProcAddress(TeeWinInetDLL,'InternetCloseHandle');
      @_HttpQueryInfoA     :=GetProcAddress(TeeWinInetDLL,'HttpQueryInfoA');
    end;
  end;
end;

function TeeOpenInternet:HINTERNET;
begin
  if TeeWinInetDLL=0 then
     InitWinInet;

  if TeeWinInetDLL<>0 then
     result:=_InternetOpenA('Tee', INTERNET_OPEN_TYPE_PRECONFIG,
                            nil,nil,INTERNET_FLAG_RESYNCHRONIZE)
  else
     result:=nil;
end;

Function DownloadURL(const URL:String; const ToStream:TStream;
                     OnCallback:TDownloadURLCallBack=nil;
                     UseCache:Boolean=False): HResult;

  function CallBack:Boolean;
  var DoCancel: Boolean;
  begin
    result:=True;

    if Assigned(OnCallback) then
    begin
      DoCancel:=False;
      OnCallback(ToStream.Size, DoCancel);

      if DoCancel then
      begin
        result:=False;
        Exit;
      end;
    end;
  end;

Const
  MaxSize= 128*1024;

var
    H1  : HINTERNET;
    H2  : HINTERNET;
    Buf : Pointer;
    tmp : Boolean;
    r   : DWord;
    AURL : PAnsiChar;
    tmpFlags : Cardinal;
begin
  result:=-1;

  h1:=TeeOpenInternet;

  if h1=nil then
     if TeeWinInetDLL=0 then
        ShowMessageUser('Cannot load WinInet.dll to access TeeChart URL file: '+URL)
     else
        result:=GetLastError

  else
  try
    if not CallBack then
       Exit;

    AURL:=PAnsiChar(AnsiString(URL));

    if UseCache then
       tmpFlags:=INTERNET_FLAG_RELOAD
    else
       tmpFlags:={ INTERNET_FLAG_DONT_CACHE or 5.02 }
                 INTERNET_FLAG_RELOAD or
                 INTERNET_FLAG_NO_CACHE_WRITE or
                 INTERNET_FLAG_HYPERLINK or
                 INTERNET_FLAG_PRAGMA_NOCACHE;

    h2:=_InternetOpenUrlA(h1, AURL, nil,$80000000,tmpFlags,
                            {INTERNET_FLAG_EXISTING_CONNECT}0);

    if h2<>nil then
    try
      ToStream.Position:=0;
      Buf:=AllocMem(MaxSize);

      try
        Repeat
          if not CallBack then
             Exit;

          r:=0;

          tmp:=_InternetReadFile(h2,Buf,MaxSize,r);

          if tmp then
          begin
            if r>0 then
               ToStream.WriteBuffer(Buf^,r)
            else
            begin
              ToStream.Position:=0;
              result:=0;
              break;
            end;
          end
          else result:=GetLastError;

        Until r=0;
      finally
        FreeMem(Buf,MaxSize);
      end;
    finally
      if not _InternetCloseHandle(h2) then
         result:=GetLastError;
    end
    else
      result:=GetLastError;

  finally
    if not _InternetCloseHandle(h1) then
       result:=GetLastError;
  end;
end;

{$ELSE}

Function DownloadURL(const URL:String; const ToStream:TStream;
                     UseCache:Boolean=False):Integer;
{$IFNDEF IOS}
var http : TIdHttp;
{$ENDIF}
begin
  {$IFDEF IOS}
  result:=0;
  {$ELSE}
  http:=TIdHttp.Create(nil);
  try
    http.Get(URL,ToStream);
    ToStream.Position:=0;
    result:=0;
  finally
    http.Free;
  end;
  {$ENDIF}
end;

{$ENDIF}

function TeeURLErrorMessage(ErrorCode: Integer): string;
{$IFDEF FMX}
begin
  result:='Error URL: '+IntToStr(ErrorCode);
end;
{$ELSE}

var
  Len    : Integer;
  Buffer : TeeString256;
begin
  Len := FormatMessage(FORMAT_MESSAGE_FROM_HMODULE or
                       FORMAT_MESSAGE_ARGUMENT_ARRAY,
                       Pointer(TeeWinInetDLL),
                       ErrorCode, 0, Buffer,
                       SizeOf(Buffer), nil);

  while (Len > 0) and
    (
         {$IFDEF D12}
         AnsiChar(Buffer[Len - 1]) in [#0..#32, '.'])
         {$ELSE}
         Buffer[Len - 1] in [#0..#32, '.'])
         {$ENDIF} do
             Dec(Len);

  SetString(result, Buffer, Len);
end;
{$ENDIF}

// Returns True when "St" is suspicious to contain a web address...
Function TeeIsURL(St:String):Boolean;
begin
  St:=UpperCase(Trim(St));
  result:=(Pos('HTTP://',St)>0) or (Pos('FTP://',St)>0);
end;

// Returns True if the URL parameter exists (without downloading it from the server).
function TeeURLExists(URL:String):Boolean;
{$IFDEF FMX}
begin
  result:=True; // ?
end;
{$ELSE}

// Code adapted from : http://www.delphipages.com/forum/showthread.php?t=194224
var
  hSession,
  hfile : HINTERNET;
  dwindex,
  dwcodelen : DWord;
  dwcode : Array[1..20] of AnsiChar;
  AURL,
  res : PAnsiChar;
  tmp : String;
begin
  tmp:=LowerCase(URL);

  if (Pos('http://',tmp)=0) and (Pos('https://',tmp)=0) then
     URL:='http://'+URL;

  result:=False;

  HSession:=TeeOpenInternet;

  if Assigned(HSession) then
  try
    AURL:=PAnsiChar(AnsiString(URL));

    hfile:=_InternetOpenURLA(hsession,AURL,nil,0,INTERNET_FLAG_RELOAD,0);

    if Assigned(hFile) then
    try
      dwIndex:=0;
      dwCodeLen:=10;

      if _HttpQueryInfoA(hfile,HTTP_QUERY_STATUS_CODE,@dwcode, dwcodeLen, dwIndex) then
      begin
        res:=PAnsiChar(@dwcode);
        result:=(res='200') or (res='302');
      end;

    finally
      if Assigned(HFile) then
         _InternetCloseHandle(hfile);
    end;
  finally
    if not _InternetCloseHandle(hSession) then
       //result:=GetLastError;
  end;
end;
{$ENDIF}

{ TTeeSeriesSourceFile }
Procedure TTeeSeriesSourceFile.Load;
begin
  if Assigned(Series) and (FileName<>'') then
     if TeeIsURL(FileName) then LoadFromURL(FileName)
                           else LoadFromFile(FileName);
end;

procedure TTeeSeriesSourceFile.SetChart(const Value: TCustomChart);
begin
  if FChart<>Value then
  begin
    if Assigned(FChart) then
       FChart.RemoveFreeNotification(Self);

    FChart:=Value;

    if Assigned(FChart) then
       FChart.FreeNotification(Self);
  end;
end;

procedure TTeeSeriesSourceFile.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;

  if (Operation=opRemove) and Assigned(FChart) and (AComponent=FChart) then
     Chart:=nil;
end;

procedure TTeeSeriesSourceFile.SetFileName(const Value: String);
begin
  if FFileName<>Value then
  begin
    Close;
    FFileName:=Value;
  end;
end;

procedure TTeeSeriesSourceFile.LoadFromFile(const AFileName: String);
var tmp : TFileStream;
begin
  tmp:=TFileStream.Create(AFileName,fmOpenRead);
  try
    LoadFromStream(tmp);
  finally
    tmp.Free;
  end;
end;

procedure TTeeSeriesSourceFile.LoadFromURL(const URL:String);
var Stream : TMemoryStream;
    tmp    : Integer;
begin
  Stream:=TMemoryStream.Create;
  try
    tmp:=DownloadURL(URL,Stream);

    if tmp=0 then LoadFromStream(Stream)
    else
       raise ChartException.CreateFmt(TeeMsg_CannotLoadSeriesDataFromURL,
                                      [tmp,URL+' '+TeeURLErrorMessage(tmp)]);
  finally
    Stream.Free;
  end;
end;

procedure TTeeSeriesSourceFile.LoadFromStream(AStream: TStream);
begin
end;

{ TChartWebSource }

Constructor TChartWebSource.Create(AOwner: TComponent);
begin
  inherited;
  FURL:=TeeMsg_DefaultDemoTee;
end;

procedure TChartWebSource.Execute;
begin
  if FURL<>'' then
     LoadFromURL(FURL);
end;

type
  TCachedStream=class
  public
    URL : String;
    Stream : TMemoryStream;
    Constructor Create;
    Destructor Destroy; override;
  end;

var
  Cached : TThreadList{$IFDEF D18}<TCachedStream>{$ENDIF};

{ TCachedImage }

Constructor TCachedStream.Create;
begin
  inherited;
  Stream:=TMemoryStream.Create;
end;

Destructor TCachedStream.Destroy;
begin
  Stream.Free;
  inherited;
end;

{$IFNDEF IOS}
{$IFNDEF ANDROID}
procedure DestroyCachedStreams;
var t : Integer;
begin
  with Cached,LockList do
  try
    for t:=0 to Count-1 do
        TCachedStream(Items[t]).Free;
  finally
    UnlockList;
  end;
end;
{$ENDIF}
{$ENDIF}

Function CacheDownload(const URL:String; St:TStream):Integer;
var tmpUrl : String;
    t      : Integer;
    NewCached : TCachedStream;
    AUrl   : String;
begin
  result:=0;

  tmpUrl:=UpperCase(url);
  AUrl:=URL;

  with Cached,LockList do
  try
    for t:=0 to Count-1 do
    if UpperCase({$IFNDEF D18}TCachedStream{$ENDIF}(Items[t]).URL)=tmpUrl then
    begin
      {$IFNDEF D18}TCachedStream{$ENDIF}(Items[t]).Stream.SaveToStream(St);
      Exit;
    end;
  finally
    UnlockList;
  end;

  NewCached:=TCachedStream.Create;

  try
    NewCached.URL:=tmpUrl;

    if (Copy(URL,0,4) <> 'http') then
      NewCached.Stream.LoadFromFile(URL)
    else
      result:=DownloadURL(AUrl,NewCached.Stream);

    if result=0 then
    begin
      NewCached.Stream.Position:=0;
      NewCached.Stream.SaveToStream(St);

      with Cached,LockList do
      try
        Add(NewCached);
      finally
        UnlockList;
      end;
    end
    else
      NewCached.Free;

  except
    on Exception do
    begin
      NewCached.Free;
      raise;
    end;
  end;
end;

{ TImportChart }
Constructor TImportChart.Create(AOwner: TComponent);
begin
  inherited;
  FKeepPosition:=True;
  FKeepSize:=True;
end;

procedure TImportChart.LoadFromFile(const FileName: String);
var f : TFileStream;
begin
  f:=TFileStream.Create(FileName,fmOpenRead);
  try
    LoadFromStream(f);
  finally
    f.Free;
  end;
end;

procedure TImportChart.CheckChart;
begin
  if Chart=nil then
     Raise ChartException.Create('Chart not assigned. Cannot import.');
end;

procedure TImportChart.CheckPosition(const Rect:TRect);
begin
  if KeepPosition or KeepSize then
     Chart.Align:={$IFDEF FMX}TAlignLayout.{$IFDEF D20}None{$ELSE}alNone{$ENDIF}{$ELSE}alNone{$ENDIF};

  if KeepPosition then
  begin
    {$IFDEF FMX}
    Chart.Position.X:=Rect.Left;
    Chart.Position.Y:=Rect.Top;
    {$ELSE}
    Chart.Left:=Rect.Left;
    Chart.Top:=Rect.Top;
    {$ENDIF}
  end;

  if KeepSize then
  begin
    Chart.Width:=(Rect.Right-Rect.Left);
    Chart.Height:=(Rect.Bottom-Rect.Top);
  end;
end;

// Just a helper internal function to centralize VCL and FMX:
function ChartRect(const AChart:TCustomChart):TRect;
begin
  result:=AChart.{$IFDEF FMX}{$IFDEF D22}BoundsRect{$ELSE}ParentedRect{$ENDIF}{$ELSE}BoundsRect{$ENDIF};
end;

procedure TImportChart.LoadFromStream(const Stream: TStream);
var tmpR : TRect;
begin
  CheckChart;

  if Assigned(FOnLoading) then
     FOnLoading(Self);

  tmpR:=ChartRect(Chart);
  try
    LoadChartFromStream(Chart,Stream);
  finally
    CheckPosition(tmpR);
  end;

  if Assigned(FOnLoaded) then
     FOnLoaded(Self);
end;

procedure TImportChart.LoadFromURL(const URL: String);
var tmpR : TRect;
begin
  CheckChart;

  if Assigned(FOnLoading) then
     FOnLoading(Self);

  tmpR:=ChartRect(Chart);
  try
    LoadChartFromURL(FChart,URL);
  finally
    CheckPosition(tmpR);
  end;

  if Assigned(FOnLoaded) then
     FOnLoaded(Self);
end;

initialization
  {$IFDEF C3}
  TeeWinInetDLL:=0;
  {$ENDIF}

  Cached:=TThreadList{$IFDEF D18}<TCachedStream>{$ENDIF}.Create;
  {$IFDEF FMX}FMXTee.Html{$ELSE}TeeHtml{$ENDIF}.GraphicDownload:=CacheDownload;

  TeeDownloadURLProc:=DownloadURL;
finalization
  TeeDownloadURLProc:=nil;

  {$IFNDEF FMX}
  if TeeWinInetDLL<>0 then
     TeeFreeLibrary(TeeWinInetDLL);
  {$ENDIF}

  {$IFNDEF IOS}
  {$IFNDEF ANDROID}
  DestroyCachedStreams;
  {$ENDIF}
  {$ENDIF}

  Cached.Free;
end.

