Delphi XE8 Printe VCL and DocumentProperties strange issue - windows

I'm using the vcl.printers unit (delphi XE8) and I'm facing an error when "talking" to a printer.
I traced into the vcl.printers and found this code (written by EMB people):
if OpenPrinter(ADevice, FPrinterHandle, nil) then
begin
if DeviceMode = 0 then // alloc new device mode block if one was not passed in
begin
DeviceMode := GlobalAlloc(GHND,
DocumentProperties(0, FPrinterHandle, ADevice, nil, nil, 0));
if DeviceMode <> 0 then
begin
DevMode := GlobalLock(DeviceMode);
if DocumentProperties(0, FPrinterHandle, ADevice, DevMode^,
DevMode^, DM_OUT_BUFFER) < 0 then
begin
GlobalUnlock(DeviceMode);
GlobalFree(DeviceMode);
DeviceMode := 0;
DevMode := nil;
end
end;
end;
if DeviceMode <> 0 then
SetPrinterCapabilities(DevMode^.dmFields);
end;
The
DocumentProperties(0, FPrinterHandle, ADevice, nil, nil, 0)
return the correct buffer size the first time (I haven't written it somewhere), then going thru the second execution time it returns 4294967295 bytes, indeed a -1 because declaration is wrong, but meanning an error.
As you can see the VCL code handle the errors very poorly since there is no error check !
But what error I have here and why ?
DocumentProperties lies in winspool.dll
To recover from it, I need to reboot the PC, but I cannot use this more than one time pass that is vey annoying for debug.
The printer is simply the "PDFcreator"
I tried with other PC and seems OK even if I run it many times.
I have also two laser network printers.
Thanks

In the past I did have the same problem with two customers. I did track it down to printers unit (printers.pas) Kind of hard to track it down without debugger on a distant computer in other part of my country.
Ok.. but I did track it all the way down to this line:
DeviceMode := GlobalAlloc(GHND, DocumentProperties (0, FPrinterHandle, ADevice, StubDevMode, StubDevMode, 0)); in the function SetPrinter in the unit PRINTERS.PAS
When I did broke it up into two lines, i.e. call to DocumentProperties first and store the value in integer variable and then check the value and only then call Globalalloc if the value is greater than 0 and kind of debugged it with stored values in debug file the error was truly in the DocumentProperties function from SPOOL.DLL if I remember correctly. This function returned -1 as size for the device, but only with this customer on one computer (he is using 4 or 5 with my program)
Of all my customers (close to 200 clients) I have had this issue on two computers. The other one fixed it kind of itself.. I didn't know how it did get fixed. The later one I was trying to fix just a couple of minutes ago. In the end I found a solution. I did fix this customer with simple change of shortcut. I began to use the automatic fix for compatibility in Windows 10 and then ran the button "test program" and it worked.. No error choosing printers or using it's propertis. Ok.. Then I tried again with the shortcut alone.. aarrgg.. error returned.. but then, aha.. I thought to myself "this has to connects to how Windows is running this program" and changed how Windows 10 ran the program as check "run as administrator" to uncheck.
And no problem.
On almost every compture with Windows 10 I do check "Run as Administrator" with no problems. I think there was a update or some issues with spool.dll that connects these dots.
ps. If you google this behavior with Delphi DocumentProperties problems, then you will find out this is known problem.. some say connected to x86 and x64 mode, but I found this out.

Related

Virtual Pascal RunTime Error (or no output) if including Printer unit?

I'm using Virtual Pascal on Windows and have a weird problem whereby if an attempt to Reset() any file that doesn't exist causes the WriteLn() to CRT fail. Example:
{$I+}
program TestIt;
uses Printer; { attempts to open LPT1 as Lst but LPT1 doesn't exist on system }
begin
{ Generates a RunTime Error with $I+ and no output with $I- }
writeln('Test It');
end.
This also fails:
program TestIt;
var
SomeFile : text;
begin
{$I-}
Assign(SomeFile, 'a:\filepath_not_exist');
{ Without $I- the Reset generates a RunTime Error as expected }
Reset(SomeFile);
{$I+}
{ Generates a RunTime Error with $I+ and no output with $I- }
writeln('Test It');
end.
This works as expected:
{$I+}
program TestIt;
begin
writeln('Test It');
end.
Any ideas why this may be happening and how to fix it? Is the source available for WriteLn() or Assign() ? I'm able to change the Printer unit to not Reset() to work around it until needing to get printing working but I don't think failure to open a file should cause the screen output to stop working.
Probably the error state is kept in some variable (which is queried by ioresult) and might cause an error to be raised in the next I/O function. If you don't do automatic error checking ($I+) you must call ioresult after every operation.
Such implementation is not ideal (if errors from the opening using "somefile" spill into a writeln to a second(output) file as happens in the second example), but it happens, specially in older compilers, and specially on targets that are less dos-like.
Also, not existing drive errors are much harder to cache than non existing files. Keep those cases fundamentally apart.
You can test this theory by trying to reset state by querying ioresult just before the action in the hope it resets the state.
Afaik VP is dead for almost a decade now. What you see (read: download) is what you get.

Readkey in Pascal (Unknown Identifier)

I am learning how to use the graphic mode from Pascal (Using Turbo Pascal 5.5). This is a simple code, which shows me the graphic mode with some messages:
program GraficoPri
uses Graph;
var Driver, Modo : Integer;
begin
Driver := VGA;
Modo := VGAHi;
InitGraph(Driver,Modo,'P:BGI');
{Using DOSBox, P: is a mounted drive I created where all TP files are stored}
SetTextStyle(SansSerifFont,0,2);
SetColor(Red);
OutTextXY(120,60,'Welcome to graphic mode');
Writeln('Push any button to continue'};
Readkey;
CloseGraph;
End.
Well, the problem I'm having is that "Readkey;" is giving me a 'Unknown Identifier' error. I tried changing the line with "Readln;" and it worked fine. What is the problem here?
Thank you!
Readkey is from the crt library, so you need to change
uses graph
to
uses wincrt, graph
Also, readkey is always used as a variable declaration. For example,
ch := readkey;
If you just want to push a button to continue, you should use a repeat-until keypressed loop.
repeat
until keypressed;
This will wait and do nothing until the user presses a key.

Access violations on string operations in Delphi

I have a Delphi application that reads data form a file and stores it in an array. Each row in a file contains an address, lineTypeIndicator and data. This is the algorithm (contains code that I believe is critical):
AssignFile(inputFile, inFileName);
Reset(inputFile);
while not EOF(inputFile) do
begin
Readln(inputFile,fileLineBuffer);
if Copy(fileLineBuffer, 8, 2) = '01' then //Never managed to catch the error here
begin
break;
end;
//extract the address from the line and use it to determine max and min address.
end;
//Now that you have min and max address, use it to set the length of an char array
SetLength(memoryArray,(lastAddress - firstAddress) * 2);
Reset(inputFile);
while not EOF(inputFile) do
begin
Readln(inputFile,fileLineBuffer);
if Copy(fileLineBuffer, 8, 2) = '01' then //I caught all the errors here
begin
break;
end;
//extract the address and data from the fileLineBuffer and place it in the corresponding place in an array
end;
This code is executed every time the user clicks the corresponding button on a form. It runs the first few times it is executed, but then after a few runs i get this:
MyProgram.exe faulted with message: 'access violation at 0x00406111:
write of address 0x00090d1c (this varies). Proceess stopped. Use step
or run to continue.
To me, this smells like some kind of heap overflow. I have tried replacing
if Copy(fileLineBuffer, 8, 2) = '01' then
with
lineTypeBuffer := Copy(fileLineBuffer, 8, 2);
if lineTypeBuffer = '01' then
or
if (fileLineBuffer[8] = '0') and (fileLineBuffer[9] = '1') then
but it did not help.
Any suggestions on how I should approach this problem?
P.S. Tried running it on Win7 32 bit and Win7 64 bit - no difference
P.P.S. sorry for the long question.
The only explanation for
Copy(fileLineBuffer, 8, 2) = '01'
resulting in an access violation is that you have corrupted the heap.
Something else in your program is writing out of bounds and corrupting the heap. Such problems can be tricky to diagnose because the fault is typically in one part of the code, but the error occurs elsewhere. Some code corrupts the heap, and then a subsequent heap operation fails because of the earlier heap corruption.
I am confident in my diagnosis because Delphi string variables are known to work, Copy is known to work, and string equality testing is known to work. In other words there is no fault in the line of code at which the error occurs. Ergo the error is elsewhere.
Some debugging tools that might help:
FastMM in full debug mode.
Range checking (enabled from the project's compiler options).

How to determine programmatically the Windows' Performance settings with Delphi 2010

The following code is to fade my application on close.
procedure TfrmMain.btnClose1Click(Sender: TObject);
var
i : Integer;
begin
for i := 255 downto 0 do begin
frmMain.AlphaBlendValue := i;
application.ProcessMessages;
end;
Close;
end;
With Windows performance set to “Let Windows choose…”
When closing my Delphi app with the above code the fade is almost
instantaneous (maybe ¼ second at the most, if I blink I miss the
transition).
If I set the performance Option to ‘Adjust for best performance”
When exiting the same app the fade takes over 12 seconds.
Using the same code but commenting out the AlphaBlendValue change removes the delay.
I tested this out on both Delphi 2010 and DelphiXE2 and the results are the same.
This was tested on Windows 7 Ultimate 64bit if that makes any difference.
To say the least this behavior puzzles me.
I thought that the forms Alpha property was handled by the GPU and would therefore not be affected by Windows performance settings that should would be targeted at maximizing CPU performance.
So as far as this is concerned I'm not sure if this is a Windows 7 bug, a Delphi bug or just my lack of knowledge.
As far as a fix...
Is there a way to tell if Windows is running in crap graphics/max performance mode so that I can disable Alpha fade effects in my apps?
Edit for clarity:
While I would like to fix the fade what I am really looking for is a way to determine what the Windows performance setting is.
I am looking for how to determine a specific Windows setting - when you go into Windows Performance Options there are 3 tabs. On the first tab "Visual Effects" there are 3 canned options and a 4th option for 'Custom'. Minimally I am trying to determine if the option chosen is 'Adjust for best performance', if I could determine what the settings are on this tab even better.
Appreciate any help.
The fundamental problem with your code is that you are forcing 256 distinct updates irrespective of the performance characteristics of the machine. You don't have to use every single alpha blend value between 255 and 0. You can skip some values and still have a smooth fade.
You need to account for the actual graphics performance of the machine. Since you cannot predict that, you should account for real time in your fade code. Doing so will give you a consistent rate of fade irrespective of the performance characteristics of your machine.
So, here's a simple example to demonstrate tying the fade rate to real time:
procedure TfrmMain.btnClose1Click(Sender: TObject);
var
Stopwatch: TStopwatch;
NewAlphaBlendValue: Integer;
begin
Stopwatch := TStopwatch.StartNew;
while True do
begin
NewAlphaBlendValue := 255-(Stopwatch.ElapsedMilliseconds div 4);
if NewAlphaBlendValue>0 then
AlphaBlendValue := NewAlphaBlendValue
else
break;
end;
Close;
end;
The fade has a 1 second duration. You can readily adjust the mathematics to modify the duration to your requirements. This code will produce a smooth fade even on your low performing machine.
I would also comment that you should not use the global variable drmMain in a TfrmMain method. The TfrmMain method already has access to the instance. It is Self. And of course you can omit the Self. What's more the call to ProcessMessages is bad. That allows re-entrant handling of queued input messages. You don't want that to happen. So remove the call to ProcessMessages.
You actually ask about detecting the Adjust for best performance setting. But I think that's the wrong question. For a start you should fix your fade code so that the fade duration is independent of graphics performance.
Having done that you may still wish to disable the fade if the user has asked for lower quality appearance settings. I don't think you should look for one of the 3 canned options that you mention. They are quite possibly Windows version specific. Personally I would base the behaviour on the Animate windows when minimizing and maximizing setting. My rationale is that if the user does not want minimize and maximize to be animated, then presumably they don't want window close to be faded.
Here's how to read that setting:
function GetWindowAnimation: Boolean;
var
AnimationInfo: TAnimationInfo;
begin
AnimationInfo.cbSize := SizeOf(AnimationInfo);
if not SystemParametersInfo(SPI_GETANIMATION, AnimationInfo.cbSize,
#AnimationInfo, 0) then
RaiseLastOSError;
Result := AnimationInfo.iMinAnimate<>0;
end;
I think that most of the other settings that you may be concerned with can also be read using SystemParametersInfo. You should be able to work out how to do so by following the documentation.
Sorry for the tardy followup but it took me a while to figure out a working answer to my question and some of the issues behind it.
First, a thank you to David Heffernan for insight on a better way to handle the fade loop and information on the TStopWatch function from the Delphi's Diagnostics unit, much appreciated.
In regards to being able to determine the Windows' Performance settings...
When using the following un-optimized fade loop
procedure TfrmMain.btnFadeNCloseClick(Sender: TObject);
var
i : Integer;
begin
for i := 255 downto 0 do
frmMain.AlphaBlendValue := i;
Close;
end;
the actual Windows Performance Option settings causing the performance issue are "Enable desktop composition" and "Use visual styles on Windows and buttons". If both options are enabled there is no issue, if either setting is not enabled the loop crawls** (about 12 seconds on my system if the form is maximized).
Turns out that turning Aero Glass on or off affects these same 2 settings. So being able to detect if Aero Glass is on or not enables me to determine whether to not to enable the form effects, such as transition fades and other eye candy, in my apps. Plus now I can also capture that information in my bug reports.
**Note this appears to be an NVidia issue/bug, or at least an issue that is much more severe on systems with NVidia graphics cards. On 2
different NVidia systems (with recent, if not latest drivers) I
got similar results for a miximized form fade - less than
.001 seconds if Aero Glass is on, around 12 seconds if Aero Glass is
off. On a system with an Intel graphics card - less than .001 seconds
if Aero Glass is on, about 3.7 seconds if Aero Glass is off. Now
granted my test sampling is small, 3 NVidia systems (counting my
customer who initially reported the issue) and one non-NVidia system
but if I was using a decent NVidia graphic card I would not bother
turning Aero Glass off.
Below is the working code to detect if Aero Glass is enabled via Delphi:
This function has been tested on a Windows7 64 bit system and works with Delphi 2007, 2010 and Xe2 (32 & 64bit).
All of the various versions of the Delphi function below that I found on the net were broken - along with comments of people complaining about getting Access Violation errors.
What finally shed the light on fixing the bad code was Gerry Coll's response to: AccessViolationException in Delphi - impossible (check it, unbelievable...) which was about trying to fix AV errors in a function of the same type.
function ISAeroEnabled: Boolean;
type
_DwmIsCompositionEnabledFunc = function(var IsEnabled: Bool): HRESULT; stdcall;
var
Flag : BOOL;
DllHandle : THandle;
OsVersion : TOSVersionInfo;
DwmIsCompositionEnabledFunc: _DwmIsCompositionEnabledFunc;
begin
Result:=False;
ZeroMemory(#OsVersion, SizeOf(OsVersion));
OsVersion.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);
if ((GetVersionEx(OsVersion)) and (OsVersion.dwPlatformId = VER_PLATFORM_WIN32_NT) and
(OsVersion.dwMajorVersion = 6) and (OsVersion.dwMinorVersion < 2)) then //Vista&Win7 only (no Win8)
begin
DllHandle := LoadLibrary('dwmapi.dll');
try
if DllHandle <> 0 then
begin
#DwmIsCompositionEnabledFunc := GetProcAddress(DllHandle, 'DwmIsCompositionEnabled');
if (#DwmIsCompositionEnabledFunc <> nil) then
begin
if DwmIsCompositionEnabledFunc(Flag)= S_OK then
Result:= Flag;
end;
end;
finally
FreeLibrary(DllHandle);
end;
end;
end;

SCardEstablishContext hangs as a service

Why might SCardEstablishContext hang, never to return, when called from a service?
I have code that works fine on lots of Windows installations. It accesses a Cherry keyboard's Smart Card reader (6x44) to read data on a smart card. It works fine on most PCs it has been tried on. However, on some PCs, running in Spain with Spanish Windows, the SCardEstablishContext function never returns. I cannot work out why this might be. I have logging either side of it, but the log entry after it does not appear. I cannot then shut it down (the worker thread is getting stuck), and have to kill it.
Exactly the same thread code works fine if run from an application, and not a service. Giving the service login settings of a user instead of system makes no difference.
I've installed Spanish XP on a machine here, but it works just fine. The far end has the same Winscard.dll version as I have here (both at XP SP3 status). No errors are shown in the event log.
How might I work out what is going wrong, and what might be fixing it? (Delphi code below)
// based on code by Norbert Huettisch
function TPCSCConnector.Init: boolean;
var
RetVar: LongInt;
ReaderList: string;
ReaderListSize: integer;
v: array[0..MAXIMUM_SMARTCARD_READERS] of string;
i: integer;
begin
Result := false;
FNumReaders := 0;
{$IFDEF MJ_ONLY}
LogReport(leInformation, 'About to call SCardEstablishContext');
{$ENDIF}
RetVar := SCardEstablishContext(SCARD_SCOPE_USER, nil, nil, #FContext);
{$IFDEF MJ_ONLY}
// never gets to report this (and logging known good etc)
LogReport(leInformation, 'SCardEstablishContext result = ' + IntToStr(RetVar));
{$ENDIF}
if RetVar = SCARD_S_SUCCESS then
begin
There may be different reasons why the API function appears to hang, like a deadlock, or an invisible message box or dialog waiting for user input. You should try to get a stacktrace using WinDbg.
You should also make sure that you are trying to reproduce the bug in the same environment. Important points might be whether Fast User Switching is active and whether other users are logged on, also that there are the same device drivers and services running.

Resources