Our programming dept just spent about a non-mythical man-month tracking down what we think is a bug in a 3rd party component, here's their copyrighted source code:
function TGDIPPicture.GetImageSizes: boolean;
var
multi: TGPImage;
pstm: IStream;
hGlobal: THandle;
pcbWrite: Longint;
begin
result := false;
if Empty then
Exit;
if FDataStream.Size = 0 then
Exit;
hGlobal := GlobalAlloc(GMEM_MOVEABLE, FDataStream.Size);
if (hGlobal = 0) then
raise Exception.Create('Could not allocate memory for image');
try
pstm := nil;
// Create IStream* from global memory
CreateStreamOnHGlobal(hGlobal, TRUE, pstm);
pstm.Write(FDataStream.Memory, FDataStream.Size,#pcbWrite);
multi := TGPImage.Create(pstm);
FWidth := multi.GetWidth;
FHeight := multi.GetHeight;
Result := true;
multi.Free;
finally
GlobalFree(hGlobal);
end;
end;
We found the problem was with TMS's AdvOfficeTabSet. If we added tabs, then it crashed, if we didn't add tabs then it didn't crash. (the crash was one of those un-debuggable app hangs that hits you 10 steps after the real problem).
Following Raymond Chen's advice I replaced GMEM_MOVEABLE with GPTR and it appears to have fixed the problem.
I'm wondering if anyone can tell me if the above code had any legitimate reason for using GMEM_MOVEABLE. AFAIK it's only for the clipboard and it should always be used with GlobalAlloc.
while I was typing this another programmer got an error in the GlobalFree function using my code. So, apparently this doesn't work either. Could really use some help here!
*CreateStreamOnHGlobal is a Windows API function. (which apparently prefers GMEM_MOVEABLE)
*TGPImage is part of TMS's implementation of the GDI+ library.
Jonathan has identified the obvious problem, that being the double free of the HGLOBAL. But as you have found, the use is GMEM_MOVEABLE is correct.
Frankly, the code seems needlessly complex. I suggest you use the built in stream adapter and avoid any GlobalAlloc. To get an IStream you just need to do this:
pstm := TStreamAdapter.Create(FDataStream);
That's it.
Related
I have been asked to correct an issue (not related to this question) in a legacy Delphi program. After fixing some issues with missing components, I am now stuck with some GDI Plus functionality, which stops me from compiling the program. One of the functions where this is used is:
function TDownLoadItem.LoadRawBitmapFromStream(var bm: TBitmap): Boolean;
var
image: TGPBitmap;
begin
Result := False;
if Content.Size = 0 then
exit;
// NOTE: Content is a TMemoryStream, declared globally.
image := GDIPlusHelper.LoadBitmapFromStream(Content); // <== This is where the problem is....
try
bm.Width := image.GetWidth;
bm.Height := image.GetHeight;
with TGPGraphics.Create(bm.Canvas.Handle) do
try
DrawImage(image, 0, 0, image.GetWidth, image.GetHeight);
Result := True;
finally
Free;
end;
finally
image.Free;
end;
end;
I think (not sure) the last Delphi version used was 2006, I am on Delphi Rio 10.3.
Online I have managed to find GDI+ 1.2, but this does not solve the problem. The procedure LoadBitmapFromStream does not exit in these libraries. GDIPlusHelper was apparently renamed to GDIPlusHelpers and most code has changed from classes to interfaces. I suspect an older edition of the GDI Plus libraries were used, but I cannot find these.
Reworking the code would be too complex as it would require Content to be an IStream instead of a TMemoryStream. Also, simply using a TBitmap is not feasible either as other code (not shown) uses functionality specific to TGPBitmap (e.g. RotateFlip).
Any suggestions on how to fix/work around this? Thanks in advance!
I'm getting an access violation when I close a form in my application. It seems to happen only after I have access a database a couple of times, but that doesn't seem to make sense.
I have traced through and put outputdebugstring messages in all the related OnDestroy() methods, but the AV appears to be outside of my code.
This is the text of the message:
Access violation at address 00405F7C in module
'MySoopaApplication.exe'. Read of address 00000008.
How do I find where in the application 00405F7C is?
What tools are available in Delphi 10.1 Berlin to help me with this?
Edit: added a bit more info ... when clicking "Break" the IDE always takes me to this piece of code in GETMEM.INC:
#SmallPoolWasFull:
{Insert this as the first partially free pool for the block size}
mov ecx, TSmallBlockType[ebx].NextPartiallyFreePool
Further edit: well, I found the culprit, though I can't honestly say that the debug tools got me there - they just seemed to indicate it wasn't in my code.
I had used code from the net that I used to find the Windows logged in user - this is it:
function GetThisComputerName: string;
var
CompName: PChar;
maxlen: cardinal;
begin
maxlen := MAX_COMPUTERNAME_LENGTH +1;
GetMem(CompName, maxlen);
try
GetComputerName(CompName, maxlen);
Result := CompName;
finally
FreeMem(CompName);
end;
end;
once I had replaced the code with a simple result := '12345' the AVs stopped. I have no changed it to this code:
function GetThisComputerName: string;
var
nSize: DWord;
CompName: PChar;
begin
nSize := 1024;
GetMem(CompName, nSize);
try
GetComputerName(CompName, nSize);
Result := CompName;
finally
FreeMem(CompName);
end;
end;
which seems to work and, as a bonus, doesn't cause AVs.
Thanks for your help, much appreciated.
Under Tools|Options in the IDE go to Embarcadero Debuggers | Language Exceptions and make sure Notify on Language Exceptions is checked. Also under Project Options | Compiling, make sure Debugging | Use debug DCUs is checked.
Allow the exception to happen, then go to View | Debug Windows | Call stack and you should be able to see exactly where it occurred. The fact that it occurs after db access is probably because that causes some object to be created which generates the AV when it is destroyed. Possibly because it is being Free()ed twice.
If that doesn't solve it, you may may need an exception-logging tool like madExcept mentioned by DavidH.
Read of address 00000008.
The fact that this address is a low number is suggestive of it being the address of a member of an object (because they are typically at low offsets from the base address of the object).
How do I find where in the application 00405F7C is?
With your app running, in the IDE go to Search | Go to Address. This should find it if the exception is in your application and not in some related module like a .DLL it is using. The menu item is enabled once the application is running in the IDE and stopped at a breakpoint. Also there is a compiler command line switch to find an error by address.
Others have explained how to diagnose an AV.
Regarding the code itself, there are issues with it:
Most importantly, you are not allocating enough memory for the buffer. GetMem() operates on bytes but GetComputetName() operates on characters, and in this case SizeOf (Char) is 2 bytes. So you are actually allocating half the number of bytes that you are reporting to GetComputerName(), so if it writes more than you allocate then it will corrupt heap memory. The corruption went away when you over-allocated the buffer. So take SizeOf(Char) into account when allocating:
function GetThisComputerName: string;
var
CompName: PChar;
maxlen: cardinal;
begin
maxlen := MAX_COMPUTERNAME_LENGTH +1;
GetMem(CompName, maxlen * SizeOf(Char)); // <-- here
try
GetComputerName(CompName, maxlen);
Result := CompName;
finally
FreeMem(CompName);
end;
end;
In addition to that:
you are ignoring errors from GetComputerName(), so you are not guaranteeing that CompName is even valid to pass to Result in the first place.
You should use SetString(Result, CompName, nSize) instead of Result := CompName, since GetComputerName() outputs the actual CompName length. There is no need to waste processing time having the RTL calculate the length to copy when you already know the length. And since you don't check for errors, you can't rely on CompName being null terminated anyway if GetComputerName() fails.
You should get rid of GetMem() altogether and just use a static array on the stack instead:
function GetThisComputerName: string;
var
CompName: array[0..MAX_COMPUTERNAME_LENGTH] of Char;
nSize: DWORD;
begin
nSize := Length(CompName);
if GetComputerName(CompName, nSize) then
SetString(Result, CompName, nSize)
else
Result := '';
end;
I'm writing an app I'd like to be backwardly compatible to some extent on XP, or at the very least windows vista.
EDIT FOR CLARITY: I need to be able to do what the first code snippet below does, but in XP. "Does anybody know the best approach to take under XP, given the functions aren't available in USER32.DLL.?"
My initial prototype code on windows 7 just called CreateProcess to start up displayswitch.exe, which is deployed with windows 7.
if you are not familiar with it, it's a handy little utility that is what gets invoked when you press the windows key and the letter P. you can read more about it here.
while this was adequate, i subsequently needed to sense the current state (eg internal vs external or extend vs clone), so i have now coded up a winapi solution that works well on windows 7 (and i presume 8). it involves making calls to SetDisplayConfig and QueryDisplayConfig in User32.DLL
The pertinent section of it is here (minus the many, many structures i had to hand craft in pascal code from the original klingon).
function getTopology : DISPLAYCONFIG_TOPOLOGY_ID ;
var NumPathArrayElements,
NumModeInfoArrayElements : UINT32;
var PathArrayElements_Size,
ModeInfoArrayElements_Size : UINT32;
error : Longint;
paths : PDISPLAYCONFIG_PATH_INFO_array;
info : PDISPLAYCONFIG_MODE_INFO_array;
begin
NumModeInfoArrayElements := 0;
Result := DISPLAYCONFIG_TOPOLOGY_EXTERNAL;
inc(result);
error := GetDisplayConfigBufferSizes(QDC_DATABASE_CURRENT,NumPathArrayElements,NumModeInfoArrayElements);
case error of
ERROR_SUCCESS :
begin
PathArrayElements_Size := sizeof(DISPLAYCONFIG_PATH_INFO) * NumPathArrayElements ;
ModeInfoArrayElements_Size := sizeof(DISPLAYCONFIG_MODE_INFO) * NumModeInfoArrayElements;
GetMem(paths,PathArrayElements_Size);
try
GetMem(info,ModeInfoArrayElements_Size );
try
error := QueryDisplayConfig(QDC_DATABASE_CURRENT,NumPathArrayElements, paths,NumModeInfoArrayElements, info,result);
case error of
ERROR_SUCCESS :;
else
Result := DISPLAYCONFIG_TOPOLOGY_EXTERNAL;
inc(result);
end;
finally
FreeMem(info,ModeInfoArrayElements_Size );
end;
finally
FreeMem(paths,PathArrayElements_Size);
end;
end;
end;
end;
function setTopology ( top : DISPLAYCONFIG_TOPOLOGY_ID) : boolean;
var flags : dword;
begin
result := false;
flags := DecodeDISPLAYCONFIG_TOPOLOGY_ID_SDC(top);
if flags <> 0 then
begin
result := SetDisplayConfig(0,nil,0,nil,SDC_APPLY or flags) = ERROR_SUCCESS;
end;
end;
Since these functions don't exist in XP (as far as I know), I am looking for a stable way of achieving a similar thing in XP. whilst i am coding in Delphi, it's not necessary that the solution be presented as such. i am quite happy to just look at how it's done, or read a description of the appropriate steps, and implement it myself.
(removed full listing as it was confusing the issue as it did not appear like a question)
The following code opens the document specified by the 'app' parameter and then waits until the particular document has been closed. This works fine for all document types, except when you have an Excel workbook open and open another Excel workbook. The code thinks the document has closed when it is actually still open. How would I solve this?
procedure RunAppAndWAit( a: TApplication; app, par, verb: string);
var
seinfo: tshellexecuteinfo;
exitcode: dword;
begin
fillchar( seinfo, sizeof( seinfo), 0);
seinfo.cbsize := sizeof( tshellexecuteinfo);
with seinfo do
begin
fmask := see_mask_nocloseprocess;
wnd := a.Handle;
lpfile := pchar( app);
lpDirectory := pchar( ExtractFileDir( app));
lpParameters := pchar( par);
lpVerb := pchar( verb);
nshow := sw_shownormal;
end;
if ShellExecuteEx( #seinfo) then
begin
repeat
a.ProcessMessages;
GetExitCodeProcess( seinfo.hprocess, exitcode);
until ( exitcode <> still_active) or a.terminated;
end
else
sshowmessage( 'Unable to open ' + app);
end;
Your attempt only works for applications that open the document in the same process which launches the document.
A lot of applications don't work this way any more: the process launching the document will pass the document to another process that shows/edits it, and the launching process dies.
You will need to find an API that supports event callbacks (in this case for Excel, most likely the COM API that Excel exposes) that lets you watch more closely what Excel actually does with your document.
Open your document using this API, register an event that gets called when the document is closed, wait for the event, then close.
This isn't pretty and may not be as reliable as you wish, but you could loop (or better, use a timer event?) calling the Windows EnumWindows function looking for title bars that match what you'd expect Excel to show for this file. (Obviously, this is an Excel-specific solution.)
For example, look for a title bar that contains the word "Excel" and your file name, which is what Excel shows in the title bar.
There may be holes in this approach that make it fragile. In fact, I'm a bit hesitant to post this since I don't think the solution is particularly robust. However, if you have no other way to solve your problem, this might work...
Google "EnumWindows Delphi" for sample code.
... on further thought,below is another way. As Jeroen noted, you could use an API to Excel. If you're doing a lot of these calls, then put the CreateOLEObject and unAssigned assignment outside the function might make it less heavy. (And you'll need some try...except blocks in case Excel is no longer running, etc.) This solution, too, is Excel-specific and clumsy, IMO. I don't know if there might be circumstances (like a File, Dialog box open in Excel?) that would cause this to return erroneous result.
So, basically, I'm saying, here are two relatively weak approaches that are specific to Excel and may not always work. (When I say it that way, I'd almost rather just delete this entire post... But, maybe it'll give you some ideas on how you want to proceed.)
This code is not tested, but similar code has worked for me in the past:
uses ComObj;
function FindWorkbook( Workbookname: String):boolean;
var
ExcelOLE: Variant;
WorkbookNumber: Integer;
begin
Result := FALSE;
ExcelOLE := CreateOLEObject('Excel.Application');
try
for WorkbookNumber := 1 to ExcelOLE.Workbooks.Count do
if UpperCase(WorkbookName) = UpperCase(ExcelOLE.Workbooks[WorkbookNumber].Name) then
Result := TRUE;
finally
ExcelOLE := unAssigned;
end;
end;
Using the DelphiTwain files from http://delphitwain.sourceforge.net/ and am getting some weird behavior.
After each scan a little more memory is being held onto.
After an hour or so of repetitive scans, the image scanned is zoomed in approxamately 10 times, and just the upper-left square inch is stored.
Has anyone had similar issues, or have some suggestions?
Code below...
try
try
Twain := TDelphiTwain.Create(self);
Twain.OnTwainAcquire := TwainAcquireHandler; //manually set the event handler
Twain.OnSourceFileTransfer := TwainSourceFileTransfer;
Twain.OnSourceSetupFileXfer := TwainSourceSetupFileXfer;
Twain.LoadLibrary;
Twain.LoadSourceManager;
Twain.Source[0].Loaded := TRUE;
Twain.Source[0].TransferMode := ttmFile;
Twain.Source[0].EnableSource(false, false);
except on e : exception do
showmessage('Error loading Scanner.');
end;
try
while Twain.Source[0].Enabled do
Application.ProcessMessages;
except on e : exception do
showmessage('Error Scanning Packing List.');
end;
finally
Twain.Source[0].Loaded := FALSE;
Twain.UnloadSourceManager(true);
Twain.UnloadLibrary;
Twain.Destroy;
end;
Since the TDelphiTwain appears to be a component you are creating in code, I would recommend passing in nil for the constructor and calling the .Free method or (as suggested by Joseph) FreeAndNil.
Twain := TDelphiTwain.Create(nil);
try
try
Twain.OnTwainAcquire := TwainAcquireHandler; //manually set the event handler
Twain.OnSourceFileTransfer := TwainSourceFileTransfer;
Twain.OnSourceSetupFileXfer := TwainSourceSetupFileXfer;
Twain.LoadLibrary();
Twain.LoadSourceManager();
Twain.Source[0].Loaded := True;
Twain.Source[0].TransferMode := ttmFile;
Twain.Source[0].EnableSource(False, False);
except on e : exception do
showmessage('Error loading Scanner.');
end;
try
while Twain.Source[0].Enabled do
Application.ProcessMessages;
except on e : exception do
showmessage('Error Scanning Packing List.');
end;
Twain.Source[0].Loaded := False;
Twain.UnloadSourceManager(True);
Twain.UnloadLibrary();
finally
FreeAndNil(Twain);
end;
I would also recommend better exception handling, but not related to question you asked. The only thing users will see and report to you (or worse, the quiet guy in the corner responsible for your IT support who loves to get non-descriptive errors from users) is 'Error doing something'
Good luck
Another area to look at is if the scanner supports WIA (Windows Image Acquisition)
var
DevMgr: IDeviceManager;
Scanner: Idevice;
Picture: IItem;
Image: OleVariant;
AImage: IImageFile;
begin
DevMgr := CreateOleObject('WIA.DeviceManager') as IDeviceManager;
// Figure out which device is the scanner
Scanner:= DevMgr.DeviceInfos.Item[1].Connect;
//Command: Figure out which command scans..
Picture := Scanner.ExecuteCommand(Scanner.Commands.Item[1].CommandID);
//Transfer as JPG
Image := Picture.Transfer(Picture.Formats.Item[1]);
//Save the image
AImage := IImageFile(Image);
AImage.SaveFile('c:\wia_viaScanner\image.' + AImage.FileExtension);
end;
More info on the WIA library can be found here..
http://msdn.microsoft.com/en-us/library/ms629859(VS.85).aspx
Examining the code within these calls may be fruitful:
TwainAcquireHandler;
TwainSourceFileTransfer;
TwainSourceSetupFileXfer;
Do any of those create any objects without freeing them?
If you are using Delphi 2006 or higher, then you can add this line to your .DPR file:
ReportMemoryLeaksOnShutdown := True;
Then reproduce the memory leak, close your app... and it will describe the leaks in detail. A little more info about this can be found here.
On another note, I'd suggest replacing
Twain.Destroy;
with
FreeAndNil(Twain);
.Destroy will call the destructor directly, while FreeAndNil is a safer alternative that will also prevent the "Twain" variable from pointing anywhere dangerous. (See the accepted answer to this question).
I can't address the problem you're reporting but you have a busy loop there that will gobble CPU time.
What are you doing when you get the Image, did you keep in memory?
Or the library can have some memory leaks, you can check if it is true with FastMM4.
to KevinRF:
I need to use WIA automation in Delphi 7 project. I registered WIAAut.dll in my system, import this library into Delphi and past your programm code into my project and got some errors:
Scanner:= DevMgr.DeviceInfos.Item[1].Connect;
Types of actual and formal var parameters must be identical
in "Item" must be Item[var Index: OleVariant], but "1" is integer
What's wrong, what i need to made it works?