|
Registriert seit: 1. Feb 2018 3.691 Beiträge Delphi 11 Alexandria |
#1
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.
Gruß vom
![]() Geändert von KodeZwerg (30. Apr 2018 um 10:29 Uhr) |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |