Please create a new FMX application, add a button and a memo to run this example. I have this code:
procedure TForm1.Button1Click(Sender: TObject);
begin
TTask.Run(procedure
var
client: TIdHTTP;
result: string;
begin
client := TIdHTTP.Create(nil);
try
try
client.ReadTimeout := 4000;
client.ConnectTimeout := 4000;
result := client.Get('a valid url here just as test');
TThread.Synchronize(nil, procedure
begin
Memo1.Lines.Add(result);
end);
except
on E: Exception do
begin
TThread.Synchronize(nil, procedure
begin
Memo1.Lines.Add(E.Message);
end);
end
end;
finally
client.Free;
end;
end);
end;
It works as I expect but the problem is in the IDE. If I place the cursor somewhere in the body of the anonymous function, I get the closing of the finally statement automatically.
How can I fix this?
First I am here
Then I press enter and I have this!
If you put the cursor at the beginning and not at the end of the line, you can add new spaces without the completion. How to solve this problem? Well, I have discovered that the issue happens because there is this code:
TThread.Synchronize(nil, procedure
begin
Memo1.Lines.Add(result);
end);
If you remove this code, the issue doens't happen anymore. Is this a bug in the IDE?
Is this a bug in the IDE?
Yes. This is a defect. Please submit a report to Quality Portal.
Is this a bug in the IDE?
Yes, this is a bug in the IDE. Your code is syntactically valid.
How can I fix this?
The best way to avoid this is to create your code and surround it with try...except... to handle any exception:
try
MyClass := TComponent.Create(Self);
try
finally
MyClass.Free;
end;
except on E: Exception do
end;
So your code will be:
TTask.Run(procedure
var
client: TIdHTTP;
result: string;
begin
try
Client := TIdHTTP.Create(nil);
try
client.ReadTimeout := 4000;
client.ConnectTimeout := 4000;
result := client.Get('a valid url here just as test');
TThread.Synchronize(nil, procedure
begin
Memo1.Lines.Add(result);
end);
finally
Client.Free;
end;
except on E: Exception do
begin
TThread.Synchronize(nil, procedure
begin
Memo1.Lines.Add(E.Message);
end);
end;
end;
end;
Related
I would like to know how to save the contents of a "variable" after program is closed and reopened.
for eg:
iCount:=0;
inc(iCount)=1;
when i close the program and reopen i want iCount to contain 1.
Thank you.
There are many ways to do this. You need to save the value somewhere: in a file, in the Windows registry, in the cloud, ...
File
Perhaps the easiest approach is to use an INI file. Try this:
Create a new VCL application.
Add a field FMyNumber: Integer to the main form.
To the main form, add the following methods (and make sure to include IniFiles and IOUtils in the implementation section's uses list):
function TForm1.GetSettingsFileName: TFileName;
begin
Result := TPath.GetHomePath + '\Fuzail\TestApp';
ForceDirectories(Result);
Result := Result + '\settings.ini';
end;
procedure TForm1.LoadSettings;
var
Ini: TMemIniFile;
begin
Ini := TMemIniFile.Create(GetSettingsFileName);
try
FMyNumber := Ini.ReadInteger('Settings', 'MyNumber', 0);
finally
Ini.Free;
end;
end;
procedure TForm1.SaveSettings;
var
Ini: TMemIniFile;
begin
Ini := TMemIniFile.Create(GetSettingsFileName);
try
Ini.WriteInteger('Settings', 'MyNumber', FMyNumber);
Ini.UpdateFile;
finally
Ini.Free;
end;
end;
Now make sure to call these when your application is starting and shutting down:
procedure TForm1.FormCreate(Sender: TObject);
begin
LoadSettings;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
SaveSettings;
end;
Now the value of FMyNumber is saved between the sessions!
Registry
Another common approach, probably, is to use the registry. Try this:
Create a new VCL application.
Add a field FMyNumber: Integer to the main form.
To the main form, add the following methods (and make sure to include Registry in the implementation section's uses list):
procedure TForm1.LoadSettings;
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('\Software\Fuzail\TestApp', False) then
try
if Reg.ValueExists('MyNumber') then
FMyNumber := Reg.ReadInteger('MyNumber')
finally
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;
procedure TForm1.SaveSettings;
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('\Software\Fuzail\TestApp', True) then
try
Reg.WriteInteger('MyNumber', FMyNumber);
finally
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;
Now make sure to call these when your application is starting and shutting down:
procedure TForm1.FormCreate(Sender: TObject);
begin
LoadSettings;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
SaveSettings;
end;
Again the value of FMyNumber is saved between the sessions!
When I execute this code without runtime packages, I have a 32 code error, that is correct.
But when I activite runtime packages (for exemple just with "FireDACASADriver;YmagControlDB") the error code is always "0"
procedure TForm1.Button1Click(Sender: TObject);
Var
Stream: TStream;
iError : integer;
begin
Stream := nil;
iError := -1;
try
try
Stream := TFileStream.Create('d:\toto.docx', fmOpenRead);
except
begin
iError := GetLastError;
end;
end;
finally
if Assigned(Stream) then
Stream.Free;
end;
showmessage('Erreur : ' + inttostr(iError));
end;
How I can fix the GetLastError with runtime packages ?
It is simply not appropriate to call GetLastError there. You are mixing two different error handling models.
Call GetLastError immediately after an API call fails, if the documentation says to do so. When you call it, something other function could very well have called SetLastError and reset the value.
So it is wrong to call GetLastError since you aren't using Win32 functions, and should remove the call to GetLastError. Your code should be:
procedure TForm1.Button1Click(Sender: TObject);
var
Stream: TStream;
begin
Stream := TFileStream.Create('d:\toto.docx', fmOpenRead);
try
// ....
finally
Stream.Free;
end;
end;
If there is an error, an exception will be raised which will be reported by the top level exception handler.
Runtime packages should have no bearing on how this code executes.
Possible causes of an error are that the file does not exist, or that it is locked.
You wrote:
if Assigned(Stream) then
Stream.Free;
That is always pointless since the Free method also checks for the object reference being nil. In fact your code is equivalent to:
if Assigned(Stream) then
if Assigned(Stream) then
Stream.Destroy;
So it is cleaner to rely on test inside Free and simply write:
Stream.Free;
In the comments you state that you actually want to test whether or not the file is locked. Don't use a file stream for that. Instead do the following:
Call CreateFile to open the file.
Check the returned handle against INVALID_HANDLE_VALUE to detect error.
In case of error use GetLastError to find out the cause of error.
Otherwise close the handle with CloseHandle.
However, this is not to be recommended. You might use this approach to determine that the file is not locked, but by the time you try to read it, it has been locked. There is an inherent race condition.
As a general guideline it is better to ask forgiveness than permission.
The act of raising an exception can reset the calling thread's error code. It is simply not appropriate to call GetLastError() inside an exception handler.
That being said, if TFileStream fails to open the file, an exception is raised that contains a system-provided error message (but not the actual error code), eg:
procedure TForm1.Button1Click(Sender: TObject);
var
Stream: TStream;
begin
try
Stream := TFileStream.Create('d:\toto.docx', fmOpenRead);
try
// use Stream as needed
finally
Stream.Free;
end;
except
on E: Exception do
ShowMessage('Erreur : ' + E.Message);
end;
end;
If you need access to the error code, you can't use TFileStream, you will have to use CreateFile() directly instead:
procedure TForm1.Button1Click(Sender: TObject);
var
hFile: THandle;
iError: DWORD;
begin
hFile := CreateFile('d:\toto.docx', GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
if hFile <> INVALID_HANDLE_VALUE then
begin
try
// use hFile as needed...
//
// if you need to access the file as a TStream, you can
// instantiate a THandleStream passing hFile to its constructor...
//
finally
CloseHandle(hFile);
end;
end else
begin
iError := GetLastError;
ShowMessage('Erreur : ' + IntToStr(iError));
if iError = ERROR_SHARING_VIOLATION then
begin
// do something...
end;
end;
end;
Alternatively:
procedure TForm1.Button1Click(Sender: TObject);
var
hFile: THandle;
begin
hFile := CreateFile('d:\toto.docx', GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
try
Win32Check(hFile <> INVALID_HANDLE_VALUE);
try
// use hFile as needed...
finally
CloseHandle(hFile);
end;
except
on E: EOSError do
begin
ShowMessage('Erreur : ' + IntToStr(E.ErrorCode));
if E.ErrorCode = ERROR_SHARING_VIOLATION then
begin
// do something...
end;
end;
end;
end;
I have components:
1 OpenPictureDialog (to open picture)
2 Edit (edtID & edtName)
1 Button (to save record)
I used UIBQuery to insert a new record, including picture in one section.
Here is my code:
with UIBQuery1 do
try
SQL.Clear;
SQL.Add('INSERT INTO EMPLOYEE');
SQL.Add('(ID, NAME, PIC)');
SQL.Add('VALUES');
SQL.Add('(:ID, :NAME, :PIC)');
params.AsInteger[0] := StrToInt(edtID.Text);
params.AsString[1] := edtName.Text;
// How to give a param for blob here?
Execute;
Transaction.Commit;
bsSkinMessage1.MessageDlg2('Has been saved.','New Record',mtInformation,[mbok],0);
except
Transaction.RollBack;
raise;
end;
I succeed show the record including picture from database, but I have no clue to store the picture into database in one click.
How to doing this? Is it possible to give parameter of picture in query?
Someone knows about UIB please..
I change my code but I get an access violation:
procedure TchfEmployee.btnSaveClick(Sender: TObject);
var
ms: TMemoryStream;
begin
ms := TMemoryStream.Create;
Image2.Picture.Bitmap.SaveToStream(ms);
ms.Position:=0;
begin
with UIBQuery1 do
try
SQL.Clear;
SQL.Add('INSERT INTO EMPLOYEE');
SQL.Add('(ID, NAME, PIC)');
SQL.Add('VALUES');
SQL.Add('(:ID, :NAME, :PIC)');
params.AsString[0] := edtID.Text;
params.AsString[1] := edtName.Text;
TBLOBField(Params.ByNameAsString['PIC']).LoadFromStream(ms);
Execute;
Transaction.Commit;
bsSkinMessage1.MessageDlg2('Has been saved.','New Record',mtInformation,[mbok],0);
except
Transaction.RollBack;
raise;
end;
try
UIBDataSet1.Close;
UIBDataSet1.Open;
except
raise;
end;
end;
end;
How's exactly save my TImage to BLOB using UIBQuery? I am really in a heavy stucked.
Try this:
...
ParamsSetBlob('PIC', ms);
Execute;
...
Take a look at UIB source code. Look for TUIBStatement class.
You need to do the following :-
Var
lStream : TMemoryStream;
Begin
lStream := TMemoryStream.Create;
Try
Image2.Picture.SaveToStream(lStream);
lStream.Position := 0;
Query.ParamSetBlob('Pic', lStream);
Finally
FreeAndNil(lStream);
End;
End;
I need to know if my program can write files to the disk (HDD, floppy, flash, CD) from where it is running.
I have tried something like:
{$I-}
Rewrite(myFile);
{$I+}
Result:= (IOResult = 0);
The problem is that if the disk is read-only, Windows gives me an error message telling me that
"appName.exe - Write Protect Error The disk cannot be written to because it is write protected. Please remove the write protection from the volume
USB_BOOT in drive D:. Cancel TryAgain Continue"
How can I test for write access without raising any error/warning messages?
Thanks.
Edit:
Ok. The "bug" has nothing to do with the above mentioned piece of code. I only thought that it appears there. I move the code to the read-only disk and ran it from there. The bug appears in a function called "CreateShortcutEx", on this line:
MyPFile.Save(PWChar(WFileName),False);
MyPFile is declared like this:
var
MyObject : IUnknown;
MySLink : IShellLink;
MyPFile : IPersistFile;
Directory : String;
WFileName : WideString;
MyReg : TRegIniFile;
begin
MyObject := CreateComObject(CLSID_ShellLink);
MySLink := MyObject as IShellLink;
MyPFile := MyObject as IPersistFile;
.....
end;
So, why is MyPFile trying to write to the application's drive (the one that is read-only) if the WFileName parameter is "C:\documents and settings\bla bla" ?
Call the Windows API SetErrorMode() function to disable the error message box.
Edit:
I just tried, and this:
procedure TForm1.Button1Click(Sender: TObject);
var
Str: TStream;
OldMode: Cardinal;
begin
OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
try
Str := TFileStream.Create('z:\foo.txt', fmOpenReadWrite);
try
finally
Str.Free;
end;
except end;
finally
SetErrorMode(OldMode);
end;
end;
works as expected.
Not really pretty but this seems to work for me.
function CanWrite(drive: string): boolean;
var
OldMode: Cardinal;
begin
OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
with TStringList.Create do
try
SaveToFile(drive + ':\file.txt');
result := true;
try
deletefile(drive + ':\file.txt');
except
end;
except
result := false;
end;
finally
SetErrorMode(OldMode);
end;
end;
Call to it with
if CanWrite('g') = true then
begin
showmessage('Can Write');
end
else
begin
showmessage('Can not write');
end;
What happens when you put your code inside an try/except?
Also, you can try (something like) this:
function CanWrite: boolean;
begin
result := true;
with TStringList.Create do
try
SaveToFile('file.txt');
except
result := false;
finally
Free;
end;
end;
Sorry, but I don't code in Delphi anymore and I don't have Delphi installed anywhere.
There exist a small freeware "Drive ready?" utility (dready.com) written by Horst Schaeffer that also can check write access. I have not tested it but as far as I can see this could be used as a solution; call it for instance as "DREADY C: /W" and check the return value.
I have Midas project that uses a TDataSetProvider in one of RemoteDataModules in the Server
Currently I am making use of the following events
BeforeApplyUpdates - to create an Object
BeforeUpdateRecord - to use the object
AfterApplyUpdates - to destory the object
Question:
Will ‘ AfterApplyUpdates’ always be called even if the is an update error ?
If you look at the sourcecode:
function TCustomProvider.DoApplyUpdates(const Delta: OleVariant; MaxErrors: Integer;
out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant;
begin
SetActiveUpdateException(nil);
try
try
if Assigned(FOnValidate) then
FOnValidate(Delta);
DoBeforeApplyUpdates(OwnerData);
Self.OwnerData := OwnerData;
try
Result := InternalApplyUpdates(Delta, MaxErrors, ErrorCount);
finally
OwnerData := Self.OwnerData;
Self.OwnerData := unassigned;
end;
except
on E: Exception do
begin
SetActiveUpdateException(E);
raise;
end;
end;
finally
try
DoAfterApplyUpdates(OwnerData);
finally
SetActiveUpdateException(nil);
end;
end;
end;
Yoy see that DoAfterApplyUpdates is called in the finally block. This means it is always called regardles of any exception.