Einzelnen Beitrag anzeigen

Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
3.691 Beiträge
 
Delphi 11 Alexandria
 
#1

Internet Downloads verschiedene Get() Varianten

  Alt 29. Apr 2018, 11:53
Hallo Leute,

in diesem Beispiel Projekt stelle ich euch 3 verschiedene Get( URL ) Möglichkeiten vor die keine speziellen Komponenten erfordern, alles arbeitet bei Laufzeit.
Es wird HTTP und HTTPS unterstützt.
Es wird Unicode unterstützt.
Man kann auf zwei Arten speichern, entweder das Original oder die Memo-Kopie.
Es ist nicht perfekt, aber zeigt einem wie einfach man an dieses Ziel gelangen kann.
Es wird entweder eine Datei empfangen oder der HTML Sourcecode.
internetdownloader.jpg
In der zweiten Uses Klausel ist für jede der 4 Download Varianten chronologisch die Unit enthalten die diese Funktion ermöglicht.
Bei Bedarf einfach nur die entsprechende Funktion herauskopieren und in euer Projekt bereitstellen, Uses anpassen, fertig.
Die TDownloadURL Methode springt dabei etwas aus der Reihe, dabei muss im Vorfeld ein Dateiname zum speichern angegeben werden.

Hier der Projekt Quell-Code, im Anhang das fertige Demo Projekt.

Update
- HTTP Api ActiveX hinzugefügt vs "COM nicht initialisiert" Fehler
- Zeitmessung inkl. Auswertung, momentan werden 4 Zeilen angezeigt, die ungewollten rauskommentieren/löschen
- simple Benchmark-Konfiguration hinzugefügt
- ClassNames verteilt

Delphi-Quellcode:
unit uMain;

interface

uses
  Winapi.Windows, Vcl.Controls, Vcl.StdCtrls, Vcl.Dialogs, System.Classes,
  Vcl.ExtCtrls, Vcl.Forms, System.SysUtils, System.Diagnostics;

type
  TFormMain = class(TForm)
    PanelTop: TPanel;
    PanelClient: TPanel;
    Memo1: TMemo;
    EditURL: TEdit;
    ButtonDownload: TButton;
    ButtonSaveOriginal: TButton;
    FileSaveDialog1: TFileSaveDialog;
    ButtonSaveMemo: TButton;
    ComboBoxApi: TComboBox;
    PanelBenchmark: TPanel;
    CheckBoxBenchmark: TCheckBox;
    GroupBoxBenchConfig: TGroupBox;
    ComboBoxBitsBytes: TComboBox;
    ComboBoxByteCalc: TComboBox;
    procedure ButtonDownloadClick(Sender: TObject);
    procedure ButtonSaveOriginalClick(Sender: TObject);
    procedure ButtonSaveMemoClick(Sender: TObject);
    procedure CheckBoxBenchmarkClick(Sender: TObject);
  private
    { Private declarations }
    DataString: String;
    Function GetWinInet ( Const xURL : String ) : UTF8String;
    Function GetHttpApi ( Const xURL : String ) : String;
    Function GetTDownloadURL ( Const xURL : String ) : String;
    function GetTHTTPClient ( Const xURL : String ) : String;
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

Uses
  WinApi.WinInet,
  System.Variants, WinApi.ActiveX, System.Win.ComObj,
  Vcl.ExtActns,
  System.Net.HttpClient
  ;

{$R *.dfm}

function TFormMain.GetWinInet ( Const xURL : String ) : UTF8String;
var
  NetHandle: HINTERNET;
  UrlHandle: HINTERNET;
  Buffer: array[0..1023] of byte;
  BytesRead: dWord;
  StrBuffer: UTF8String;
begin
  Result := '';
  NetHandle := InternetOpen('Delphi-PRAXiS RockZ', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if Assigned(NetHandle) then
    try
      UrlHandle := InternetOpenUrl(NetHandle, PChar(xURL), nil, 0, INTERNET_FLAG_RELOAD, 0);
      if Assigned(UrlHandle) then
        try
          repeat
            InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);
            SetString(StrBuffer, PAnsiChar(@Buffer[0]), BytesRead);
            Result := Result + StrBuffer;
          until BytesRead = 0;
        finally
          InternetCloseHandle(UrlHandle);
        end
      else
        raise Exception.CreateFmt('Cannot open URL %s', [xURL]);
    finally
      InternetCloseHandle(NetHandle);
    end
  else
    raise Exception.Create('Unable to initialize Wininet');
end;

Function TFormMain.GetHttpApi ( Const xURL : String ) : String;
var
  HTTP: OleVariant;
begin
  Result := '';
  CoInitialize(nil);
  try
    HTTP := CreateOleObject('WinHttp.WinHttpRequest.5.1');
    HTTP.Open('GET', xURL, False);
    HTTP.Send;
    Result := HTTP.ResponseText;
  finally
    HTTP := Unassigned;
    CoUninitialize;
  end;
end;

Function TFormMain.GetTDownloadURL ( Const xURL : String ) : String;
var
  dl: TDownloadURL;
  iFileHandle: Integer;
  iFileLength: Integer;
  iBytesRead: Integer;
  Buffer: PAnsiChar;
  i: Integer;
begin
  Result := '';
  if FileSaveDialog1.Execute then
  begin
    dl := TDownloadURL.Create(Self);
    try
      dl.URL := xURL;
      dl.FileName := FileSaveDialog1.FileName;
      dl.ExecuteTarget(nil);
    finally
      dl.Free;
      try
        iFileHandle := System.SysUtils.FileOpen(FileSaveDialog1.FileName, fmOpenRead);
        iFileLength := System.SysUtils.FileSeek(iFileHandle,0,2);
        System.SysUtils.FileSeek(iFileHandle,0,0);
        Buffer := System.AllocMem(iFileLength + 1);
        iBytesRead := System.SysUtils.FileRead(iFileHandle, Buffer^, iFileLength);
        Result := Buffer;
      finally
        System.SysUtils.FileClose(iFileHandle);
        System.FreeMem(Buffer);
      end;
    end;
  end;
end;

function TFormMain.GetTHTTPClient ( Const xURL : String ) : String;
var
  HttpClient: THttpClient;
  HttpResponse: IHttpResponse;
begin
  Result := '';
  HttpClient := THTTPClient.Create;
  try
    HttpResponse := HttpClient.Get( xURL );
    Result := HttpResponse.ContentAsString();
  finally
    HttpClient.Free;
  end;
end;

procedure TFormMain.ButtonDownloadClick(Sender: TObject);
var
  temp1, temp2: String;
  i : Integer;
  Watch: TStopWatch;
begin
  Memo1.Clear;
  ButtonDownload.Enabled := False;
  ButtonSaveOriginal.Enabled := False;
  ButtonSaveMemo.Enabled := False;
  PanelBenchmark.Enabled := False;
  Temp1 := EditURL.Text; Temp2 := ''; DataString := '';
  Memo1.Refresh;
  Memo1.Lines.Add('Downloading Data from ' +Temp1);
  Memo1.Lines.Add('Please Wait...');
  if CheckBoxBenchmark.Checked then
  begin
    Watch := TStopWatch.Create();
    Watch.Start;
  end;
  if Length(Temp1) > 0 then
   case ComboBoxApi.ItemIndex of
    0: DataString := GetWinInet( Temp1 );
    1: DataString := GetHttpApi( Temp1 );
    2: DataString := GetTDownloadURL( Temp1 );
    3: DataString := GetTHTTPClient( Temp1 );
   end;
  if CheckBoxBenchmark.Checked then Watch.Stop;
  if Length(DataString) > 0 then
  begin
    Memo1.Lines.Text := DataString;
    i := Length(Memo1.Lines.Text) ;
    Memo1.Lines.Add('');
    Memo1.Lines.Add('HTTP/S HTML Source from: '+Temp1);
    if Length(DataString)-i < 0 then temp2 := 'Additional added '+IntToStr(i-Length(DataString))+' extra Unicode bytes.';
    if Length(DataString)-i = 0 then temp2 := 'Plain Ascii detected.';
    if Length(DataString)-i > 0 then temp2 := 'Warning! '+IntToStr(Length(DataString)-i)+' bytes missing in Display!';
    Memo1.Lines.Add('Downloaded: '+IntToStr(Length(DataString)) +' bytes, displaying: ' +IntToStr(i)+ ' chars. '+temp2);
    if CheckBoxBenchmark.Checked then
    begin
      if (((ComboBoxBitsBytes.ItemIndex = 0)or(ComboBoxBitsBytes.ItemIndex = 1))and((ComboBoxByteCalc.ItemIndex = 0) or (ComboBoxByteCalc.ItemIndex = 1))) then
        Memo1.Lines.Add('Downloaded needed '+IntToStr(Watch.ElapsedMilliseconds)+' ms, that is '+FloatToStrF(Length(DataString) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' bytes/second <-> '+FloatToStrF((Length(DataString) / 1024) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' kbyte/s <-> '+FloatToStrF((Length(DataString) / 1024 / 1024) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' mbyte/s.');
      if (((ComboBoxBitsBytes.ItemIndex = 0)or(ComboBoxBitsBytes.ItemIndex = 2))and((ComboBoxByteCalc.ItemIndex = 0) or (ComboBoxByteCalc.ItemIndex = 1))) then
        Memo1.Lines.Add('Downloaded needed '+IntToStr(Watch.ElapsedMilliseconds)+' ms, that is '+FloatToStrF((Length(DataString)*8) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' bits/second <-> '+FloatToStrF(((Length(DataString)*8) / 1024) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' kbit/s <-> '+FloatToStrF(((Length(DataString)*8) / 1024 / 1024) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' mbit/s.');
      if (((ComboBoxBitsBytes.ItemIndex = 0)or(ComboBoxBitsBytes.ItemIndex = 1))and((ComboBoxByteCalc.ItemIndex = 0) or (ComboBoxByteCalc.ItemIndex = 2))) then
        Memo1.Lines.Add('Downloaded needed '+IntToStr(Watch.ElapsedMilliseconds)+' ms, that is '+FloatToStrF(Length(DataString) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' bytes/second <-> '+FloatToStrF((Length(DataString) / 1000) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' kbyte/s <-> '+FloatToStrF((Length(DataString) / 1000 / 1000) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' mbyte/s.');
      if (((ComboBoxBitsBytes.ItemIndex = 0)or(ComboBoxBitsBytes.ItemIndex = 2))and((ComboBoxByteCalc.ItemIndex = 0) or (ComboBoxByteCalc.ItemIndex = 2))) then
      Memo1.Lines.Add('Downloaded needed '+IntToStr(Watch.ElapsedMilliseconds)+' ms, that is '+FloatToStrF((Length(DataString)*8) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' bits/second <-> '+FloatToStrF(((Length(DataString)*8) / 1000) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' kbit/s <-> '+FloatToStrF(((Length(DataString)*8) / 1000 / 1000) / (Watch.ElapsedMilliseconds / 1000), ffFixed, 35, 2)+' mbit/s.');
{
      Memo1.Lines.Add('Above calculations based on 1024 byte = 1 kb for your pleasure 1000 byte = 1 kb follows.');
      }

    end;
    ButtonSaveOriginal.Enabled := True;
    ButtonSaveMemo.Enabled := True;
  end;
  PanelBenchmark.Enabled := True;
  ButtonDownload.Enabled := True;
end;

procedure TFormMain.ButtonSaveOriginalClick(Sender: TObject);
var
 FS: TFileStream;
 xBuf: TBytes;
 i: Integer;
begin
 if FileSaveDialog1.Execute then
 begin
   SetLength(xBuf, Length(DataString)-1);
   for i := 1 to Length(DataString) do
    xBuf[i-1] := Ord(DataString[i]);
   FS := TFileStream.Create(FileSaveDialog1.FileName, fmCreate);
   FS.WriteBuffer(xBuf, 0, Length(DataString));
   FS.Free;
 end;
end;

procedure TFormMain.ButtonSaveMemoClick(Sender: TObject);
begin
 if FileSaveDialog1.Execute then
 begin
   Memo1.Lines.SaveToFile(FileSaveDialog1.FileName);
 end;
end;

procedure TFormMain.CheckBoxBenchmarkClick(Sender: TObject);
begin
 GroupBoxBenchConfig.Enabled := CheckBoxBenchmark.Checked;
end;

end.
Angehängte Dateien
Dateityp: 7z Internet Download.7z (4,4 KB, 18x aufgerufen)
Gruß vom KodeZwerg

Geändert von KodeZwerg (30. Apr 2018 um 11:29 Uhr)
  Mit Zitat antworten Zitat