I am getting "Catastrophic Failure" error in following scenario.
type
TGetDoubleValue = function (var ID: Integer): Double; safecall;
....
....
var
GetDoubleValue: TGetDoubleValue;
.....
.....
LibHandle := LoadLibrary('GetDoubleValue.dll');
#GetDoubleValue := GetProcAddress(LibHandle, 'getDoubleValue');
if not (#GetDoubleValue = nil) then
begin
myDouble := GetDoubleValue(ID);
end
else
RaiseLastOSError;
I am getting error on the "myDouble := GetDoubleValue(ID);" line while calling this function.
Almost certainly this error is because of a calling convention or parameter list mis-match.
It is highly unlikely that the function you import from the DLL really is safecall. That calling convention is used with COM methods to perform HRESULT parameter list re-writing. Much more plausible is that the calling convention is stdcall, but you must check. You should also double-check that the parameters and return type are an exact match.
If you cannot work it out for yourself, then please just add to the question the function's declaration from the DLL source code (or documentation).
I am also not a fan of using # with function pointers. It tends to lead to errors that could have been found by the compiler. I would write your code like this:
LibHandle := LoadLibrary('GetDoubleValue.dll');
Win32Check(LibHandle<>0);
GetDoubleValue := GetProcAddress(LibHandle, 'getDoubleValue');
Win32Check(Assigned(GetDoubleValue));
myDouble := GetDoubleValue(ID);
FWIW, I'm a huge fan of Win32Check because it removes branching from the high level code which makes it much easier to read.
Related
I am trying to copy directory:
procedure CopyBigDirWithSubdirs;
{$IOCHECKS ON}
begin
try
TDirectory.Copy(SrcPath, DstPath);
except
on E: EInOutError do something
end;
end;
In my case it is crucial to check disk full condition and I hoped that catching EInOutError exception would solve my problem. But as far as I could find out TDirectory methods do not notify of this condition at all. The situation is even worse because TDirectory.copy can write part of subdirs, face disk full condition and terminate, so I have to check the whole directory tree to be sure that my directory is copied properly. Does anybody know better solution?
{$IOCHECKS ON} isn't relevant here. That's for legacy Pascal I/O. And likewise for EInOutError, you aren't ever going to get that from functions in the IOUtils unit.
The real problem here is that TDirectory.Copy is, like so much of IOUtils, broken by design. There appears to be no error checking whatsoever implemented in TDirectory.Copy. For what it is worth, the rule at my place of work is that IOUtils must not be used in our code.
You are going to have to either write your own code which does include some error checking, or find a third party library to do the work.
Certainly on Windows then you should use IFileOperation to do this. As a benefit you'll even be able to show the standard system progress dialog. And because the code is provided by the system rather than by Embarcadero, you can expect it to work.
If you require support for other platforms then you may have to work a little harder to find suitable code.
As using IFileOperation interface looks like most practical solution I've written the function based on it:
function CopyItem(const Src, Dest: string ): HRESULT;
const
FOF_SILENT = $0004;
FOF_NOCONFIRMATION = $0010;
FOF_NOCONFIRMMKDIR = $0200;
FOF_NOERRORUI = $0400;
FOF_NO_UI =(FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOERRORUI or FOF_NOCONFIRMMKDIR); // don't display any UI at all
var
lFileOperation: IFileOperation;
psiFrom: IShellItem;
psiTo: IShellItem;
opAborted : longbool;
begin
//We probably don't need to call CoInitializeEx/CoUninitialize pair as it could have been called by Delphi library
CoInitializeEx(nil, COINIT_APARTMENTTHREADED or COINIT_DISABLE_OLE1DDE);
// check arguments and create the IFileOperation interface,
if (Src='') or (Dest='') then Result := E_INVALIDARG
else Result := CoCreateInstance(CLSID_FileOperation, nil, CLSCTX_ALL, IFileOperation, lFileOperation);
// Set the operation flags. Turn off all UI from being shown to the user
if Succeeded(Result) then Result := lFileOperation.SetOperationFlags(FOF_NO_UI);
// Create IShellItem-s from the supplied source and dest paths.
if Succeeded(Result) then Result := SHCreateItemFromParsingName(PWideChar(wideString(Src)),
nil, IShellItem, psiFrom);
if Succeeded(Result) then Result := SHCreateItemFromParsingName(PWideChar(wideString(Dest)),
nil, IShellItem, psiTo);
// This method does not copy the item, it merely declares the item to be copied
if Succeeded(Result) then Result := lFileOperation.CopyItem(psiFrom, psiTo, nil, nil);
// This method is called last to execute those actions that have been specified earlier
if Succeeded(Result) then Result := lFileOperation.PerformOperations;
// Check now if the operation was aborted by the system
if Succeeded(Result) then
begin
lFileOperation.GetAnyOperationsAborted(opAborted);
if opAborted then Result := ERROR_WRITE_FAULT;
end;
CoUninitialize;
end;
As you can see from the code the solution is not complete because in case of disc full error (my reason for all this fiddling with lFileOperation) PerformOperations returns S_OK (!!!) and I can find the error only by calling GetAnyOperationsAborted which does not specify the error condition exactly but merely sets opAborted flag. Then I have to guess the real case of abortion.
I have a little problem with compilation under Delphi:
function T_QS2ProcessMailbox.PutRec<T>(const aID: T_Barcode; var aRec: T;const aTxt: String): Boolean;
var
FA: T_FahrauftragRec absolute aRec;
LP: T_LagerpackungRec absolute aRec;
begin
init_Rec;
Rec.ID := aID;
Rec.EventTime := Now;
Rec.Text := aTxt;
if TypeInfo(T_LagerpackungRec) = TypeInfo(T) then
begin
Rec.RecType := C_QS_TYPE_TLAGERPACKUNGREC;
Rec.FA := FA;
end
else
if Typeinfo(T) = Typeinfo(T_LagerpackungRec) then
begin
Rec.RecType := C_QS_TYPE_TFAHRAUFTRAGREC;
Rec.LP := LP;
end
else
Rec.RecType := C_QS_TYPE_TEXT;
Send_TraceMsg(ClassName + '.PutRec Type=' + IntToStr(Rec.RecType));
Result := PutRec(Rec);
end;
It compiles fine without errors, messages, or hints. But it is compiled without if statements. You can look at it in the picture - this code without compilations marker
I do not understand why.
Can somebody explain to me what I am doing incorrectly?
Those if statements can be resolved at compile time, so only ever 1 of them will be actually compiled for any given value of T. (In other word, the compiled code will never execute any if for this function).
I can imagine 2 reasons for seeing only 1 compilation marker. Either your application will only ever use 1 of the if statements, or the IDE will map the compilation marker of all the if statements to the same line (I find this last one unlikely, but I've seen stranger things in the IDE).
Another possibility is that your 2nd if should read
if Typeinfo(T) = Typeinfo(T_FahrauftragRec) then
instead of
if Typeinfo(T) = Typeinfo(T_LagerpackungRec) then
Typeinfo() is a compiler intrinsic function in XE7 and later, and thus is available for the compiler to evaluate at compile-time 1. And since the type of T is a Generic that is also known to the compiler, the compiler can directly evaluate your ifs and any blocks that evaluate to False and would never be executed at runtime are simply omitted from the final executable altogether. That is why you don't see any debugger points on them.
1: but only in the specific case where TypeInfo(T) is used in an if TypeInfo(T) = TypeInfo(X) statement inside a Generic method. Other uses of TypeInfo() are not similarly inlined at compile-time.
This is normal behavior, and is what you WANT to have happened, as it produces slimmer and more efficient runtime code.
When your other code calls PutRec<T_FahrauftragRec>(...) then T will be T_FahrauftragRec and thus TypeInfo(T_LagerpackungRec) = TypeInfo(T_FahrauftragRec) will evaluate as False.
Likewise, when calling PutRec<T_LagerpackungRec>(...) then T will be T_LagerpackungRec and thus TypeInfo(T_FahrauftragRec) = TypeInfo(T_LagerpackungRec) will evaluate as False.
And so on for any other type you pass to T.
Also, you have a bug in your code. Your second if statement:
if Typeinfo(T) = Typeinfo(T_LagerpackungRec) then
Should be this instead:
if Typeinfo(T) = Typeinfo(T_FahrauftragRec) then
I assume that it is possible to get the complete path of the unit (not just the name) at runtime, since when I generate an error, Delphi already has this stored information:
try
Assert (False, '#');
except
on E: EAssertionFailed from
begin
ShowMessage (E.Message); // this show me the path
end;
end;
Would anyone know if there is any function that returns me the path of a specific unit, or something similar?
The complete path of the unit as it was on the machine that compiled the project is only possible using Assert. However personally I don't find that information incredibly useful unless you have many units with the same name in different folders or lost control over your source repository and and library paths in effect when compiling.
To get the unit name you can turn on map file or debug information (aka TD32) and do the following:
Use the FileByLevel function from JclDebug - in your case with the default value (0).
The level parameter tells the function how many calls it look up the callstack. If you put that method into a FormCreate of a VCL form for example and pass 1 it will give you Vcl.Forms.pas as the event handler was called from there.
I hesitate to write this answer as it shows a really dirty hack to get the unit name making use of the Assert compiler magic shown above.
Use the following unit:
unit UnitNameHack;
interface
const
cUnitNameSentinel = '$$$sentinel$$$';
var
HackUnitname: string = '';
implementation
var
OrgAssertErrorProc: TAssertErrorProc = nil;
procedure MyAssertErrorProc(const Message, Filename: string; LineNumber: Integer; ErrorAddr: Pointer);
begin
if Message = cUnitNameSentinel then begin
HackUnitname:= Filename;
end
else begin
OrgAssertErrorProc(Message, Filename, LineNumber, ErrorAddr);
end;
end;
initialization
OrgAssertErrorProc := AssertErrorProc;
AssertErrorProc := MyAssertErrorProc;
finalization
AssertErrorProc := OrgAssertErrorProc;
end.
Now whenever you need the unit name call
Assert(False, cUnitNameSentinel);
and retrieve the unit name from HackUnitname.
Note that you cannot wrap the Assert call and reading HackUnitName into a function, not even if inlined.
You've said, something similar. I see that it might have been in a different context, but anyway, for objects you can inspect UnitName or UnitScope to get the name of the module where the object instance was declared, without the module path (which is not valuable information anyway).
Based on Uwe Raabe's answer:
// directly after the implementation uses:
var
ThisUnit: string = '<unknown>';
procedure MyAssertErrorProc(const Message, Filename: string; LineNumber: Integer; ErrorAddr: Pointer);
begin
ThisUnit := Filename;
end;
procedure InitThisUnit;
var
OrgAssertErrorProc: TAssertErrorProc;
begin
OrgAssertErrorProc := AssertErrorProc;
try
AssertErrorProc := MyAssertErrorProc;
Assert(False);
finally
AssertErrorProc := OrgAssertErrorProc;
end;
end;
// [...]
// call InitThisUnit in the initialization section
initialization
InitThisUnit;
end.
It's still a hack, but a bit more elegant. ;-)
This is probably similar / continuation on the previous question below:
Why Delphi XE3 gives "E2382 Cannot call constructors using instance variables"?
Now I'm trying Delphi XE4 with the same code (with 'constructor' changed to 'procedure' as per the solution of the above question).
Now I have also these things in a generics list, i.e. I have
TCoordRect = object
public
function Something: Boolean;
end;
and then a list of these in a function parameter, which I loop through and try to access the items directly:
function DoSomething(AList: TList<TCoordRect>): Boolean;
var
i: Integer;
begin
Result := False;
for i := 0 to AList.Count - 1 do
begin
Result := Result or AList[i].Something; // <-- Here comes the compiler error!
end;
end;
This gives the compiler error "E2036 Variable required". However, if I don't access it directly, i.e put instead a local variable and use that first, then it works:
function DoSomething(AList: TList<TCoordRect>): Boolean;
var
i: Integer;
ListItem: TCoordRect;
begin
Result := False;
for i := 0 to AList.Count - 1 do
begin
ListItem := AList[i];
Result := Result or ListItem.Something; // <-- Now this compiles!
end;
end;
And another "workaround" is to remove all these 'object' types and change them to 'class', but I'm curious as to why this does not work like it used to? Is it again just something with "the compiler moving towards mobile development" or is there some more specific reason, or is this even a bug? BTW I also reported this as a QC issue, so will see if something comes from there.
It's a compiler bug, and it's present in all earlier versions of the compiler. The fault is not limited to XE4. Submitting a QC report is the correct response.
I would not be surprised if Embarcadero never attempt to fix it. That's because you are using deprecated object. Switch to using record and the code compiles.
The issue you have uncovered in this question is unrelated to the SO question you refer to at the top of your question.
Incidentally, this really is a case of old meets new. Legacy Turbo Pascal objects, and modern day generic containers. You are mixing oil and water!
I've declared the following function:
function next(current, next: string): Integer;
begin
form1.Label1.Caption := next;
form1.Label2.Caption := current;
form1.label3.Caption := clipboard.AsText+inttostr(c);
Result:=1;
end;
I try to execute it with this code:
if label1.Caption = '' then res := next('current', 'next');
I am getting the following error:
[Error] Unit1.pas(47): E2034 Too many
actual parameters
I think all parameters are good, so why am I getting that error?
I just tried your code on both Delphi 7 and Delphi 2010. If it works on those two, it should also work on Delphi 2005.
Conclusion: Delphi wants to use a different version of the "next" routine, because of code scope/visibility. Try ctrl+click-ing on "next" in "res := next();" and see where Delphi takes you. Alternatively post more code so we can tell you why Delphi is not choosing your version of the "next" routine. Ideally you should post a whole unit, starting from "unit name" to the final "end."
As specified by Cosmin Prund, the problem is because of the visibility.
TForm has a procedure with name Next which wont accept any parameters.
Your function uses the same name and as you are calling the function in TForm1 class implementation, compiler is treating the call as TForm1.Next and hence it was giving error.
To solve the problem, precede the unit name before the function name i.e., Unit1.Next().
So this should be your code
if label1.Caption = '' then res := Unit1.next('current', 'next');