TIdHttp.Free takes 30 seconds - indy

Back on January 7th I updated to the latest version of Indy 10 (I know this is improper etiquette: but how can I tell in the source code the exact version I have?) I recently found a situation where TIDHttp.Free was taking 30 seconds to execute. I traced it to a situation where two TIDHttp objects were instantiated at the same time. It was taking 30 seconds to free one, and then another 30 seconds to free the other. I am pretty certain this was not occurring with the prior version of Indy 10. Once I rewrote my code to free the first object before creating the second, everything worked fine (i.e. no 30 second delay). The code below is a simplified example. Although when I run this there is no delay. Unfortunately I have the IdHttp objects embedded as member of other objects within my framework. And for this reason it has been difficult to simulate using a simple application.
In the code below, my fix was to move the idhttp1.free; call before the TIdHttp.Create for the 2nd instance.
Any ideas? I guess if need be I can try to simplify my implementation.
procedure TForm1.Button1Click(Sender: TObject);
var
idhttp1,idhttp2: TIDHttp;
IdSSLIOHandlerSocket1,IdSSLIOHandlerSocket2: TIdSSLIOHandlerSocketOpenSSL;
begin
idhttp1 := tidhttp.Create(nil);
IdHTTP1.reusesocket := rsTrue;
idhttp1.handleredirects := True;
IdSSLIOHandlerSocket1 := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
IdSSLIOHandlerSocket1.reusesocket := rsTrue;
IdHTTP1.IOHandler := IdSSLIOHandlerSocket1;
idhttp1.get('https://www.google.com');
idhttp2 := tidhttp.create(nil);
idhttp2.handleredirects := True;
IdHTTP2.reusesocket := rsTrue;
IdSSLIOHandlerSocket2 := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
IdSSLIOHandlerSocket2.reusesocket := rsTrue;
IdHTTP2.IOHandler := IdSSLIOHandlerSocket2;
idhttp2.get('https://www.google.com');
idhttp1.free;
idhttp2.free;
showmessage('done');
end;

Related

Problem with Delphi 10.3 Community PaintBox Repaint-Function

I am currently making a little Program in Delphi 10.3 Community Version 26.0.34749.6593. No additional components.
Essentially I draw on TPaintBox which is fitted in a Panel. Everything works fine so far, but when the objects are repainted via "PaintBox1.Repaint" the Objects got the wrong BrushStyle (bsSolid when they should have bsClear e.g.) Of course I tried to pin it down, but I got no luck. But I found out that at the following Point something doesn't work:
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
i: Integer;
fig : ^TFigure;
apen: TPenStyle;
abrush: TBrushStyle;
color1,color2: TColor;
begin
aPen := PaintBox1.Canvas.Pen.Style;
aBrush := bsStyle;
color1 := PaintBox1.Canvas.Brush.Color;
color2 := PaintBox1.Canvas.Pen.Color;
for I:=0 to List.Count-1 do
begin
fig := List.Items[i];
case fig.Typ of
f_Kreis : begin
with Paintbox1.Canvas do
begin
pen.Style := fig.Pen;
Brush.Style := fig.Brush;
pen.Color := fig.PenColor;
brush.Color := fig.BrushColor;
Ellipse(fig.X,fig.Y,fig.X2,fig.Y2);
end;
end;
f_Rechteck : begin
with PaintBox1.Canvas do
begin
Pen.Style := fig.Pen;
Brush.Style := fig.Brush;
Pen.Color := fig.PenColor;
Brush.Color := fig.BrushColor;
Rectangle(fig.X,fig.Y,fig.X2,fig.Y2);
end;
end;
f_Line : begin
with PaintBox1.Canvas do
begin
pen.Style := fig.Pen;
brush.Style := fig.Brush;
pen.Color := fig.PenColor;
brush.Color := fig.BrushColor;
MoveTo(fig.X,Fig.Y);
LineTo(fig.X2,fig.Y2);
end;
end;
end;
end;
PaintBox1.Canvas.Pen.Style := aPen;
bsStyle := aBrush;
PaintBox1.Canvas.Brush.Color := color1;
PaintBox1.Canvas.Pen.Color := color2;
end;
So when the "Brush.Style := fig.Brush;"-Line is called, nothing happens. I went step by step and after these Line "Brush.Style" is still "bsSolid" even when "fig.Brush" is "bsClear"
For explanation: TFigure is my own class. It houses information about a drawing, such as a rectangle. It is the parent class.
Do I miss something. I really am out of Ideas. Can anyone tell me, why nothing happens?
Edit:
For testing I added the lines:
if Brush.Style <> fig.Brush then
ShowMessage('Warnung!');
under
Brush.Style := fig.Brush;
and it actually wont set it on false, though Brush.Style is bsSolid and fig.Brush is bsClear.
You have declared fig : ^TFigure;, but class instances are already references (pointers). Thus you are creating a pointer to reference, and using that pointer as if it were the reference.
Remove the pointer operator and declare
fig: TFigure;
I can't verify whether there are other errors in your code

How to save and read records in a Delphi tClientDataset

Good day
I am a Delphi newb. I am trying to programmatically save a record to a tClientDataset and then read the record from the dataset. I think I seem to have managed to successfully save the record in the dataset, because after I appended data to a record and posted it, the recordcount of the dataset is 1.
However, when I try and read the values of the records, I get Null back.
I created the tclientdataset using the toolbar and manually setting the fields in the design window. the dataset's name is
dsUnitData
I am using Delphi RadStudio XE2.
Can anyone please help by indicating what I am doing wrong to read Null instead of the earlier populated values?
Here is my code:
procedure TfFeetRevenueByUnit.BitBtn1Click(Sender: TObject);
var test, theunitname : string;
count, feet, counter : integer;
revenue :currency;
begin
label3.Visible := false;
dsUnitData.Insert;
dsUnitData.FieldValues['Field_UnitName'] := 'test';
dsUnitData.FieldValues['Field_Feet'] := 10;
dsUnitData.FieldValues['Field_Revenue'] := 10.1;
dsUnitData.Post;
count := dsUnitData.RecordCount;
if not dsUnitData.Active then
dsUnitData.Open;
dsUnitData.First;
while not dsUnitData.EOF do
begin
theunitname := dsUnitData.FieldByName('Field_UnitName').Value;
feet := dsUnitData.FieldByName('Field_UnitName').Value;
revenue := dsUnitData.FieldByName('Field_Revenue').Value;
dsUnitData.Next;
end;
I found the problem. I had set the FieldKind of the Fields for the tClientDataset wrongly.
I set the FieldKind as fkCalculated but it should have been fkInternalCalc.

ResourceString VS Const for string literals

I have a couple of thousands string literals in a Delphi application. They have been isolated in a separate file and used for localization in the past.
Now I don't need localization any more.
Is there any performance penalty in using resourcestring compared to plain constants.
Should I change those to CONST instead?
The const string makes a call to _UStrLAsg and the resource string ends up in LoadResString.
Since the question is about speed there is nothing like doing a test.
resourcestring
str2 = 'str2';
const
str1 = 'str1';
function ConstStr1: string;
begin
result := str1;
end;
function ReceStr1: string;
begin
result := str2;
end;
function ConstStr2: string;
begin
result := str1;
end;
function ReceStr2: string;
begin
result := str2;
end;
procedure Test;
var
s1, s2, s3, s4: string;
begin
s1 := ConstStr1;
s2 := ReceStr1;
s3 := ConstStr2;
s4 := ReceStr2;
end;
For the first time I used AQTime added in DelphiXE to profile this code and here is the result. The time column show Machine Cycles.
I might have done a lot of rookie mistakes profiling this but as I see it there is a difference between const and resourcestring. If the difference is noticeable for a user depends on what you do with the string. In a loop with many iterations it can matter but used to display information to the users, not so much.
Since they are stored in a single file which presumably does little else (well done!), there's no reason not to try it out. I predict it won't make any discernible difference to performance, but I guess it depends on what else you are doing in your app.
Resource strings do incur overhead.
Compared to displaying such a string, or writing it to a file or database, the overhead is not much.
On the other hand it is just a switch from the resourcestring to const keyword (and back if you ever consider to to localization again).

Downloading a file in Delphi

A google search shows a few examples on how to download a file in Delphi but most are buggy and half of the time don't work in my experience.
I'm looking for a simple robust solution which will let me download a single exe (for updating my app) and will hold the execution of the current update thread until the download is done or errors out. The process is already threaded so the download code should hold execution until it's done (hopefully).
Here's two implementations, both seem very complicated
1. http://www.scalabium.com/faq/dct0116.htm
2. http://delphi.about.com/od/internetintranet/a/get_file_net.htm
Why not make use of Indy? If you use the TIdHTTP component, it's simple:
procedure TMyForm.DownloadFile;
var
IdHTTP1: TIdHTTP;
Stream: TMemoryStream;
Url, FileName: String;
begin
Url := 'http://www.rejbrand.se';
Filename := 'download.htm';
IdHTTP1 := TIdHTTP.Create(Self);
Stream := TMemoryStream.Create;
try
IdHTTP1.Get(Url, Stream);
Stream.SaveToFile(FileName);
finally
Stream.Free;
IdHTTP1.Free;
end;
end;
You can even add a progress bar by using the OnWork and OnWorkBegin events:
procedure TMyForm.IdHTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;AWorkCountMax: Int64);
begin
ProgressBar.Max := AWorkCountMax;
ProgressBar.Position := 0;
end;
procedure TMyForm.IdHTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
ProgressBar.Position := AWorkCount;
end;
procedure TMyForm.DownloadFile;
var
IdHTTP1: TIdHTTP;
Stream: TMemoryStream;
Url, FileName: String;
begin
Url := 'http://www.rejbrand.se';
Filename := 'download.htm';
IdHTTP1 := TIdHTTP.Create(Self);
Stream := TMemoryStream.Create;
try
IdHTTP1.OnWorkBegin := IdHTTPWorkBegin;
IdHTTP1.OnWork := IdHTTPWork;
IdHTTP1.Get(Url, Stream);
Stream.SaveToFile(FileName);
finally
Stream.Free;
IdHTTP1.Free;
end;
end;
I'm not sure if these events fire in the context of the main thread, so any updates done to VCL components may have to be done using the TIdNotify component to avoid threading issues. Maybe someone else can check that.
The second approach is the standard way of using Internet resources using WinINet, a part of Windows API. I have used it a lot, and it has always worked well. The first approach I have never tried. (Neither is "very complicated". There will always be a few additional steps when using the Windows API.)
If you want a very simple method, you could simply call UrlMon.URLDownloadToFile. You will not get any fine control (at all!) about the download, but it is very simple.
Example:
URLDownloadToFile(nil,
'http://www.rejbrand.se',
PChar(ExtractFilePath(Application.ExeName) + 'download.htm'),
0,
nil);
For people that has later version of delphi, you can use this:
var
http : TNetHTTPClient;
url : string;
stream: TMemoryStream;
begin
http := TNetHTTPClient.Create(nil);
stream := TMemoryStream.Create;
try
url := YOUR_URL_TO_DOWNLOAD;
http.Get(url, stream);
stream.SaveToFile('D:\Temporary\1.zip');
finally
stream.Free;
http.Free;
end;
end;
Using URLMon.
errcode := URLMon.URLDownloadToFile(nil,
PChar('http://www.vbforums.com/showthread.php?345726-DELPHI-Download-Files'),
PChar( 'a:\download.htm'),
0,
nil);
if errcode > 0 then
showmessage('Error while downloading: ' + inttostr(errcode));

create windows user using Delphi

I need to create new windows user as administrator using Delphi
Thanks
you can use the NetUserAdd and NetUserSetGroups functions declarated in the JEDI Headers.
see this simple sample.
program ProjectAddNewUser;
{$APPTYPE CONSOLE}
uses
JclWin32,//Jedi Library
Windows,
SysUtils;
function CreateWinUser(const wServer, wUsername, wPassword, wGroup:WideString): Boolean;
var
Buf : USER_INFO_2;//Buf for the new user info
Err : NET_API_STATUS;
ParmErr : DWORD;
GrpUsrInfo: USER_INFO_0;//Buf for the group
wDummyStr : WideString;
begin
wDummyStr:='';
FillChar (Buf, SizeOf(USER_INFO_2), 0);
with Buf do
begin
usri2_name := PWideChar(wUsername);
usri2_full_name := PWideChar(wUsername);//You can add a more descriptive name here
usri2_password := PWideChar(wPassword);
usri2_comment := PWideChar(wDummyStr);
usri2_priv := USER_PRIV_USER;
usri2_flags := UF_SCRIPT OR UF_DONT_EXPIRE_PASSWD;
usri2_script_path := PWideChar(wDummyStr);
usri2_home_dir := PWideChar(wDummyStr);
usri2_acct_expires:= TIMEQ_FOREVER;
end;
GrpUsrInfo.usri0_name:=PWideChar(wGroup);
Err := NetUserAdd(PWideChar(wServer), 1, #Buf, #ParmErr);
Result := (Err = NERR_SUCCESS);
if Result then //NOw you must set the group for the new user
begin
Err := NetUserSetGroups(PWideChar(wServer),PWideChar(wGroup),0,#GrpUsrInfo,1);
Result := (Err = NERR_SUCCESS);
end;
end;
begin
if CreateWinUser('localhost', 'MyNewUser','ThePassword','MyWindowsGroup') then
Writeln('Ok')
else
Writeln('False');
Readln;
end.
I think the API call you need is NetUserAdd.
First, check if Delphi provides a wrapper for this call. If not, you'll have to write your own. If you don't know how to make Windows API calls from Delphi, you have some more research to do.

Resources