teeurl.pas

BCB第三方组件

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

interface

Uses {$IFNDEF LINUX}
     Windows,
     {$ENDIF}
     Classes, Chart, TeEngine;

type
  TCustomChartLink = class(TComponent)
  private
    { Private declarations }
    FChart : TCustomChart;
    procedure SetChart(const Value: TCustomChart);
  protected
    { Protected declarations }
    procedure Notification( AComponent: TComponent;
                            Operation: TOperation); override;
  public
    { Public declarations }
    property Chart:TCustomChart read FChart write SetChart;
  end;

  { Series Source with FileName property }
  TTeeSeriesSourceFile=class(TTeeSeriesSource)
  private
    FFileName : String;
    procedure SetFileName(const Value: String);
  public
    Procedure Load; override;
    Procedure LoadFromFile(Const AFileName:String);
    Procedure LoadFromStream(AStream:TStream); virtual;
    Procedure LoadFromURL(Const AURL:String);

    property FileName:String read FFileName write SetFileName;
  end;

  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;

  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);

Function DownloadURL(AURL:{$IFDEF CLR}string{$ELSE}PChar{$ENDIF}; ToStream:TStream): HResult;

// Returns True when St parameter contains a web address (http or ftp)
Function TeeIsURL(St: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;  { 5.01 }

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

implementation

Uses
  {$IFDEF CLX}
  Types,
  {$IFNDEF LINUX}
  IdHTTP,
  {$ENDIF}
  {$ENDIF}

  {$IFDEF CLX}
  QControls,
  {$ELSE}
  Controls,
  {$ENDIF}

  {$IFDEF CLR}
  System.Text, System.Net, System.IO,
  {$ENDIF}

  TeCanvas, TeeHtml, TeeProcs, SysUtils, TeeConst, TeeStore;

Procedure LoadChartFromURL(Var AChart:TCustomChart; Const URL:String);
var tmp    : Integer;
    R      : TRect;
    Stream : TMemoryStream;
    tmpURL : String;
begin
  Stream:=TMemoryStream.Create;
  try
    tmpURL:=URL;

    tmp:=DownloadURL({$IFNDEF CLR}PChar{$ENDIF}(tmpURL),Stream);

    if tmp=0 then
    begin
      R:=AChart.BoundsRect;
      Stream.Position:=0; { 5.01 }
      LoadChartFromStream(TCustomChart(AChart),Stream);

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

{$IFNDEF CLX}
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 }

type
  HINTERNET = Pointer;

{$IFNDEF CLR}
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;
{$ENDIF}

{$IFNDEF CLR}
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');
    end;
  end;
end;
{$ENDIF}

(*
function InternetSetStatusCallback(hInet: HINTERNET;
  lpfnInternetCallback: PFNInternetStatusCallback): PFNInternetStatusCallback; stdcall;
*)

Function DownloadURL(AURL:{$IFDEF CLR}string{$ELSE}PChar{$ENDIF}; ToStream:TStream): HResult;
Const MaxSize= 128*1024;

var
{$IFNDEF CLR}
    H1  : HINTERNET;
    H2  : HINTERNET;
    Buf : Pointer;
    tmp : Boolean;
    r   : DWord;
{$ELSE}
    tmpClient : WebClient;
    Buf       : Array of Byte;
{$ENDIF}
begin
  {$IFDEF CLR}

  tmpClient:=WebClient.Create;
  Buf:=tmpClient.DownloadData(AURL);
  if Length(Buf)>0 then
  begin
    ToStream.Write(Buf,Length(Buf));
    ToStream.Position:=0;
    result:=0;
  end
  else result:=-1;

  {$ELSE}
  {$IFDEF D5}
  result:=-1;
  {$ELSE}
  result:=$80000000;
  {$ENDIF}
  if TeeWinInetDLL=0 then InitWinInet;
  if TeeWinInetDLL<>0 then
  begin
    h1:=_InternetOpenA('Tee', INTERNET_OPEN_TYPE_PRECONFIG,
                              nil,nil,INTERNET_FLAG_RESYNCHRONIZE
                             {WININET_API_FLAG_SYNC INTERNET_FLAG_DONT_CACHE 5.02 });

    if h1<>nil then
    try
      h2:=_InternetOpenUrlA(h1, AURL, nil,$80000000,
                              { 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

                              ,
                              {INTERNET_FLAG_EXISTING_CONNECT}
                              0);


      if h2<>nil then
      try
        ToStream.Position:=0;
        Buf:=AllocMem(MaxSize);
        try
          Repeat
            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
    else result:=GetLastError;
  end
  else ShowMessageUser('Cannot load WinInet.dll to access TeeChart file: '+AURL);
  {$ENDIF}
end;

{$ELSE}

Function DownloadURL(AURL:PChar; ToStream:TStream): HResult;
begin
  {$IFDEF LINUX}
  result:=-1;
  {$ELSE}