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.