lina-components/Source/uWebCtrls.pas

unit uWebCtrls;

//////////////////////////////////////
///  Lina Web Controls Unit        ///
///  ****************************  ///
///  (c) 2014 Dennis G�hlert a.o.  ///
//////////////////////////////////////

interface

uses
  { Standard-Units }
  SysUtils, Classes,
  { Indy-Units }
  idHTTP, idSSLOpenSSL, idComponent,
  { Andere Package-Units }
  uBase;

type
  { Ereignisse }
  TDownloadWorkEvent = procedure(Sender: TObject; AWorkMode: TWorkMode) of object;
  TDownloadWorkBeginEvent = procedure(Sender: TObject; AWorkMode: TWorkMode) of object;
  TDownloadWorkEndEvent = procedure(Sender: TObject; AWorkMode: TWorkMode) of object;

type
  { Hauptklassen }
  TDownload = class(TComponent)
  private
    { Private-Deklarationen }
    idHTTPObject: TidHTTP;
    SSLHandler: TIdSSLIOHandlerSocketOpenSSL;
    FAbout: TComponentAbout;
    FAddress: String;
    FProgress: Int64;
    FProgressMax: Int64;
    FSSL: Boolean;
    { Ereignisse }
    FWorkEvent: TDownloadWorkEvent;
    FWorkBeginEvent: TDownloadWorkBeginEvent;
    FWorkEndEvent: TDownloadWorkEndEvent;
    { Methoden }
    procedure idHTTPObjectWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
    procedure idHTTPObjectWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
    procedure idHTTPObjectWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  protected
    { Protected-Deklarationen }
    procedure Prepare;
  public
    { Public-Deklarationen }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Fortschritt }
    function GetProgress: Int64;
    function GetProgressMax: Int64;
    function GetProgressPercent: Byte;
    { Herunterladen }
    function GetText: String;
    procedure SaveToFile(FileName: TFileName);
    procedure SaveToStream(Stream: TStream);
  published
    { Published-Deklarationen }
    { Ereignisse }
    property OnWork: TDownloadWorkEvent read FWorkEvent write FWorkEvent;
    property OnWorkBegin: TDownloadWorkBeginEvent read FWorkBeginEvent write FWorkBeginEvent;
    property OnWorkEnd: TDownloadWorkEndEvent read FWorkEndEvent write FWorkEndEvent;
    { Eigenschaften }
    property About: TComponentAbout read FAbout;
    property Address: String read FAddress write FAddress;
    property SSL: Boolean read FSSL write FSSL default False;
  end;

  procedure Register;

const
  { Meta-Daten }
  DownloadComponent_Name = 'Download';
  DownloadComponent_Version = 1.0;
  DownloadComponent_Copyright = 'Copyright � 2014';
  DownloadComponent_Author = 'Dennis G�hlert a.o.';

implementation

procedure Register;
begin
  RegisterComponents(ComponentsPage,[TDownload]);
end;

constructor TDownload.Create(AOwner: TComponent);
begin
  inherited;
  FAbout := TComponentAbout.Create(DownloadComponent_Name,DownloadComponent_Version,DownloadComponent_Copyright,DownloadComponent_Author);
  idHTTPObject := TidHTTP.Create(Self);
  idHTTPObject.HandleRedirects := True;
  idHTTPObject.OnWork := idHTTPObjectWork;
  idHTTPObject.OnWorkBegin := idHTTPObjectWorkBegin;
  idHTTPObject.OnWorkEnd := idHTTPObjectWorkEnd;
  SSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(Self);
  SSL := False;
end;

procedure TDownload.idHTTPObjectWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
  FProgress := AWorkCount;
  if Assigned(OnWork) then
  begin
    OnWork(Self,AWorkMode);
  end;
end;

procedure TDownload.idHTTPObjectWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
begin
  FProgressMax := AWorkCountMax;
  if Assigned(OnWorkBegin) then
  begin
    OnWorkBegin(Self,AWorkMode);
  end;
end;

procedure TDownload.idHTTPObjectWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  if Assigned(OnWorkEnd) then
  begin
    OnWorkEnd(Self,AWorkMode);
  end;
end;

destructor TDownload.Destroy;
begin
  FAbout.Free;
  inherited;
end;

function TDownload.GetProgress: Int64;
begin
  Result := FProgress;
end;

function TDownload.GetProgressMax: Int64;
begin
  Result := FProgressMax;
end;

function TDownload.GetProgressPercent: Byte;
begin
  if FProgressMax > 0 then
  begin
    Result := (FProgress div FProgressMax) * 100;
  end else
  begin
    { Bei aktivierter SSL-Verschl�sselung wird keine insgesamte Dateigr��e
      �bermittelt. Deshalb wird hier eine 0 angegeben, um das Ergebnis nicht
      undefiniert zu lassen. }
    Result := 0;
  end;
end;

function TDownload.GetText: String;
begin
  Prepare;
  Result := idHTTPObject.Get(Address);
end;

procedure TDownload.SaveToFile(FileName: TFileName);
var
  FS: TFileStream;
begin
  Prepare;
  FS := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
  try
    idHTTPObject.Get(Address,FS);
  finally
    FS.Free;
  end;
end;

procedure TDownload.SaveToStream(Stream: TStream);
begin
  Prepare;
  idHTTPObject.Get(Address,Stream);
end;

procedure TDownload.Prepare;
begin
  if SSL = True then
  begin
    idHTTPObject.IOHandler := SSLHandler;
  end else
  begin
    idHTTPObject := nil;
  end;
end;

end.