|
Registriert seit: 1. Feb 2018 3.691 Beiträge Delphi 11 Alexandria |
#19
Hier ist der komplette Source im "so ist es gerade in meiner IDE" Zustand.
Whookies Vorschlag ist gerade zum Test drinnen aber ich komme damit noch nicht ganz klar. Bei mir waren es halt Funktionen weil ich ja das Result abwarten muss. In Arbeit ist halt gerade "GetTHTTPClient" Funktion/Prozedur, als Prozedur bekomme ich es so noch nicht zum laufen.
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; MemoText: 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; MyThreadRun: Boolean; Function GetWinInet ( Const xURL : String ) : UTF8String; Function GetHttpApi ( Const xURL : String ) : String; Function GetTDownloadURL ( Const xURL : String ) : String; // function GetTHTTPClient( Const xURL : String ) : String; Procedure GetTHTTPClient( Const xURL : String ); procedure DoneWithIt ( Const Data: 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 tmp : String; threadrun: boolean; begin tmp := ''; threadrun := True; TThread.CreateAnonymousThread( procedure var NetHandle: HINTERNET; UrlHandle: HINTERNET; Buffer: array[0..1023] of byte; BytesRead: dWord; StrBuffer: UTF8String; begin 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); tmp := tmp + StrBuffer; until BytesRead = 0; finally InternetCloseHandle(UrlHandle); end else raise Exception.CreateFmt('Cannot open URL %s', [xURL]); finally InternetCloseHandle(NetHandle); threadrun := False end else raise Exception.Create('Unable to initialize Wininet'); threadrun := False end ).Start; repeat sleep(5) until not threadrun; Result := tmp; end; Function TFormMain.GetHttpApi ( Const xURL : String ) : String; var tmp : String; threadrun: boolean; begin tmp := ''; threadrun := True; TThread.CreateAnonymousThread( procedure var HTTP: OleVariant; begin CoInitialize(nil); try HTTP := CreateOleObject('WinHttp.WinHttpRequest.5.1'); HTTP.Open('GET', xURL, False); HTTP.SetRequestHeader('User-Agent', 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0'); HTTP.Send; tmp := HTTP.ResponseText; finally HTTP := Unassigned; CoUninitialize; end; threadrun := False end ).Start; repeat sleep(5) until not threadrun; Result := tmp; 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 tmp : String; MyThread: TThread; begin tmp := ''; MyThread := TThread.CreateAnonymousThread( procedure var HttpClient: THttpClient; HttpResponse: IHttpResponse; begin tmp := ''; HttpClient := THTTPClient.Create; try HttpResponse := HttpClient.Get( xURL ); tmp := HttpResponse.ContentAsString(); finally HttpClient.Free; end; end ); MyThread.FreeOnTerminate := True; MyThread.Start; while WaitForSingleObject(MyThread.Handle, INFINITE) = WAIT_OBJECT_0 do Application.ProcessMessages; Result := tmp; end;} procedure TFormMain.GetTHTTPClient ( Const xURL : String ); begin TThread.CreateAnonymousThread( procedure var HttpClient: THttpClient; HttpResponse: IHttpResponse; LTmp: String; begin Ltmp := ''; MyThreadRun := True; HttpClient := THTTPClient.Create; try HttpResponse := HttpClient.Get( xURL ); Ltmp := HttpResponse.ContentAsString(); finally HttpClient.Free; TThread.Synchronize(TThread.Current, Procedure begin DoneWithIt(Ltmp); end ); end; end ).Start; end; procedure TFormMain.DoneWithIt ( Const Data: String ); begin DataString := Data; MyThreadRun := False; end; procedure TFormMain.ButtonDownloadClick(Sender: TObject); var temp1, temp2: String; i : Integer; Watch: TStopWatch; begin MemoText.Clear; ButtonDownload.Enabled := False; ButtonSaveOriginal.Enabled := False; ButtonSaveMemo.Enabled := False; PanelBenchmark.Enabled := False; Temp1 := EditURL.Text; Temp2 := ''; DataString := ''; MemoText.Refresh; MemoText.Lines.Add('Downloading Data from ' +Temp1); MemoText.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 ); 3: begin GetTHTTPClient( Temp1 ); while MyThreadRun do Application.ProcessMessages; end; end; // case if CheckBoxBenchmark.Checked then Watch.Stop; if Length(DataString) > 0 then begin MemoText.Lines.Text := DataString; i := Length(MemoText.Lines.Text) ; MemoText.Lines.Add(''); MemoText.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!'; MemoText.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 MemoText.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 MemoText.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) and (ComboBoxByteCalc.ItemIndex = 0)) then MemoText.Lines.Add('Above calculations based on 1024 byte = 1 kb for your pleasure 1000 byte = 1 kb follows.'); if (((ComboBoxBitsBytes.ItemIndex = 0)or(ComboBoxBitsBytes.ItemIndex = 1))and((ComboBoxByteCalc.ItemIndex = 0)or(ComboBoxByteCalc.ItemIndex = 2))) then MemoText.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 MemoText.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.'); 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 MemoText.Lines.SaveToFile(FileSaveDialog1.FileName); end; end; procedure TFormMain.CheckBoxBenchmarkClick(Sender: TObject); begin GroupBoxBenchConfig.Enabled := CheckBoxBenchmark.Checked; end; end.
Gruß vom
![]() |
![]() |
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 |
![]() |
![]() |