I am attempting to create a simple debug visualiser for TDatasets (well, I'm having to make it a TADODataset for now, so I can use the .SaveToFile method).
I've pretty much copied the TStrings visualiser example suplied by EMBT, but am running into problems when the form is being shown, as it gives me an AV without showing any data.
The top part of the callstack in the AV looks like this:
[5003C49E]{rtl150.bpl } System.#UStrAsg (Line 17745, "System.pas" + 30) + $0
[149038D1]{DatasetVisualiserProject.bpl} Datasetvisualiserframe.TDatasetVisualiserFrame.ThreadNotify + $151
[20A2CA9A]{coreide150.bpl} DebuggerMgr.TDebuggerMgr.OnShowVisualizer (Line 1112, "DebuggerMgr.pas" + 4) + $3B
So it's a problem with string assignments, likely unallocated memory? Like the TStrings implementation my ThreadNotify procedure has no code in it.
My 'work' routine replaces the TStrings implementation's AddStringListItems call, and looks like this:
procedure TDatasetVisualiserFrame.SetDataset(const Expression, TypeName, EvalResult: string);
var
TempFilename: string;
begin
FAvailableState := asAvailable;
FExpression := Expression;
IntDataset.Close;
TempFileName := GetTempFile('DSDebug');
try
if FTypeName = TADODataset.Classname then
begin
Evaluate(Format('%s.SaveToFile(%s)', [FExpression, TempFileName]));
IntDataset_ADO.LoadFromFile(TempFileName);
srcIntDataset.DataSet := IntDataset_ADO;
end
else if FTypeName = TKBMMemTable.Classname then
begin
Evaluate(Format('%s.SaveToFile(%s)', [FExpression, TempFileName]));
IntDataset.LoadFromFile(TempFileName);
srcIntDataset.DataSet := IntDataset;
end
else raise Exception.Create('Unhandled class type ' + TypeName);
finally
if fileexists(TempFileName) then
begin
DeleteFile(TempFileName);
end;
end;
DebugDatasetView.beginupdate;
try
DebugDatasetView.ClearItems;
DebugDatasetView.DataController.CreateAllItems(false);
finally
DebugDatasetView.endupdate;
end;
end;
The frame itself has a TADODataset, Datasource and a QuantumGrid component for display (though a DBGrid should work)
Do I need to do something with thread handling because I'm dealing with Datasets or is it something more fundamental?
As a bonus question: My original plan was to take a TDataset and use KBMMemTable's LoadFromDataset routine passing in the original dataset, but soon after starting I discovered I was limited to getting strings back from the debugger so this wasn't possible. Am I mistaken, or is there a tricksy way around it?
After being given the means of how to debug the IDE (thanks #David M) I noticed that I hadn't implemented FrameCreated properly.
Other than that, SaveToFile also needed the filename with QuotedStr, otherwise the file would be created empty and LoadFromFile would fail due to an empty stream.
Now it works perfectly :-)
Related
In addition to this question I have made some tests and researches on the docwiki. My conclusion is that this kind of code should work without memory leaks:
function testResultObject: TClassA;
begin
Result := TClassA.Create;
Result.DoSomething;
end;
And then somewhere I can call the above code in this manner:
var k: TClassA;
begin
k := testResultObject;
try
//code code code
finally
k.Free;
end;
end;
As Remy suggested in the answer it's better to avoid this way of doing things and instead use something like testResultObject(x: TClassA): boolean. In this case the return true/false can tell me if everything went fine and I am passing an object already created.
Look at this code:
function testResultObject: TClassA;
begin
Result := TClassA.Create;
try
Result.DoSomething;
except
Result.Free;
end;
end;
The problem with the first version above of the function is that DoSomething could raise an exception and if so I'll leak memory. Can the second implementation with try-except be a solution? For sure later I'll have to check if the result is assigned or nil.
I agree that (as already said above) the testResultObject(x: TClassA): boolean would be better. I was just wondering if the return-a-class function way could be fixed as I've written.
Your code has serious problems. In case of an error, it swallows the exception, and returns an invalid object reference.
This is easy to fix. The canonical way is as follows:
function testResultObject: TClassA;
begin
Result := TClassA.Create;
try
Result.DoSomething;
except
Result.Free;
raise;
end;
end;
Either the function succeeds and returns a new object. Or it fails, cleans up after itself, and raises an exception.
In other words, this function looks and behaves just like a constructor. You consume it in the same way:
obj := testResultObject;
try
// do things with obj
finally
obj.Free;
end;
Your second approach works, but has 2 serious problems.
By swallowing all exceptions, (as J pointed out) you'll hide the fact that something went wrong.
There's no indication to the caller that you've created an object that the caller is responsible for destroying. This makes using the function more error prone; and easier to cause memory leaks.
I would recommend the following improvement on your second approach:
{Name has a clue that caller should take ownership of a new object returned}
function CreateObjectA: TClassA;
begin
{Once object is successfully created, internal resource protection is required:
- if no error, it is callers responsibility to destroy the returned object
- if error, caller must assume creation *failed* so must destroy object here
Also, by assigning Result of successful Create before *try*:
The object (reference) is returned
**if-and-only-if**
This function returns 'normally' (i.e. no exception state)}
Result := TClassA.Create;
try
Result.DoSomething; {that could fail}
except
{Cleanup only if something goes wrong:
caller should not be responsible for errors *within* this method}
Result.Free;
{Re-raise the exception to notify caller:
exception state means caller does not "receive" Result...
code jumps to next finally or except block}
raise;
end;
end;
The most important benefit of the above create function is that: as far as any caller/client code is concerned, it behaves exactly like a normal TObject.Create.
And so the correct usage pattern is exactly the same.
Note that I'm not keen on J's FreeAndNil suggestion because if calling code doesn't check if the result was assigned: it is likely to AV. And code that does check the result correctly will be a little messy:
var k: TClassA;
begin
k := testResultObject; {assuming nil result on failed create, next/similar is *required*}
if Assigned(k) then {Note how this differs from normal try finally pattern}
try
//code using k
finally
k.Free;
end;
end;
NB: It's important to note that you cannot ever have your caller simply ignore memory management; which brings me to the next section.
All the above aside, there is much less chance of making careless mistakes if your testResultObject takes an input object that you require the caller to create and manage its lifetime as needed. I'm not sure why you're resisting that approach so much? You cannot get simpler than the following without resorting to a different memory model.
var k: TClassA;
begin
k := TClassA.Create;
try
testResultObject(k); {Where this is simply implemented as k.DoSomething;}
//more code using k
finally
k.Free;
end;
end;
The only problem with this :
function testResultObject: TClassA;
begin
Result := TClassA.Create;
try
Result.DoSomething;
except
Result.Free;
end;
end;
Is that you have no way of knowing whether the function was successful. Freeing an object does not alter the reference; the variable will still point to the (now) invalid memory location where the object used to exist. You must explicitly set the reference to nil if you want the consumer to be able to test if the reference is valid. If you want to use this pattern (having the consumer test for nil) then you would need to do :
try
Result.DoSomething;
except
FreeAndNil(Result);
end;
This way the caller can test the result for nil (using Assigned or otherwise) as you intended. This still isn't a very clean approach, however, since you're still swallowing exceptions. Another solution might be to simply introduce a new constructor or alter the existing one. For example
TFoo = class
public
constructor Create(ADoSomething : boolean = false);
procedure DoSomething;
end;
constructor TClassA.Create(ADoSomething: Boolean = False);
begin
inherited Create;
if ADoSomething then DoSomething;
end;
procedure TClassA.DoSomething;
begin
//
end;
This way you can get rid of all of the exception handling and just call this as :
function testResultObject: TClassA;
begin
Result := TClassA.Create(true);
end;
Since you've now pushed the DoSomething execution into the constructor any exceptions will naturally automatically call the destructor and your memory management problems go away. The other answers also have good solutions.
I found the following code snippet here:
with TClipper.Create do
try
AddPolygon(subject, ptSubject);
AddPolygon(clip, ptClip);
Execute(ctIntersection, solution);
finally
free;
end
Just curious, what does the free statement/function (between finally and end) do here? Google did not help.
The code
with TClipper.Create do
try
AddPolygon(subject, ptSubject);
AddPolygon(clip, ptClip);
Execute(ctIntersection, solution);
finally
free;
end
is shorthand for
with TClipper.Create do
begin
try
AddPolygon(subject, ptSubject);
AddPolygon(clip, ptClip);
Execute(ctIntersection, solution);
finally
free;
end;
end;
TClipper.Create creates an object of type TClipper, and returns this, and the with statement, which works as in most languages, lets you access the methods and properties of this TClipper object without using the NameOfObject.MethodOrProperty syntax.
(A simpler example:
MyPoint.X := 0;
MyPoint.Y := 0;
MyPoint.Z := 0;
MyPoint.IsSet := true;
can be simplified to
with MyPoint do
begin
X := 0;
Y := 0;
Z := 0;
IsSet := true;
end;
)
But in your case, you never need to declare a TClipper object as a variable, because you create it and can access its methods and properties by means of the with construct.
So your code is almost equivelant to
var
Clipper: TClipper;
Clipper := TClipper.Create;
Clipper.AddPolygon(subject, ptSubject);
Clipper.AddPolygon(clip, ptClip);
Clipper.Execute(ctIntersection, solution);
Clipper.Free;
The first line, Clipper := TClipper.Create, creates a TClipper object. The following three lines work with this object, and then Clipper.Free destroys the object, freeing RAM and possibly also CPU time and OS resources, used by the TClipper object.
But the above code is not good, because if an error occurrs (an exception is created) within AddPolygon or Execute, then the Clipper.Free will never be called, and so you have a memory leak. To prevent this, Delphi uses the try...finally...end construct:
Clipper := TClipper.Create;
try
Clipper.AddPolygon(subject, ptSubject);
Clipper.AddPolygon(clip, ptClip);
Clipper.Execute(ctIntersection, solution);
finally
Clipper.Free;
end;
The code between finally and end is guaranteed to run, even if an exception is created, and even if you call Exit, between try and finally.
What Mason means is that sometimes the with construct can be a paint in the ... brain, because of identifier conflicts. For instance, consider
MyObject.Caption := 'My test';
If you write this inside a with construct, i.e. if you write
with MyObect do
begin
// A lot of code
Caption := 'My test';
// A lot of code
end;
then you might get confused. Indeed, most often Caption := changes the caption of the current form, but now, due to the with statement, it will change the caption of MyObject instead.
Even worse, if
MyObject.Title := 'My test';
and MyObject has no Caption property, and you forget this (and think that the property is called Caption), then
MyObject.Caption := 'My test';
will not even compile, whereas
with MyObect do
begin
// A lot of code
Caption := 'My test';
// A lot of code
end;
will compile just fine, but it won't do what you expect.
In addition, constructs like
with MyObj1, MyObj2, ..., MyObjN do
or nested with statements as in
with MyConverter do
with MyOptionsDialog do
with MyConverterExtension do
..
can produce a lot of conflicts.
In Defence of The With Statement
I notice that there almost is a consensus (at least in this thread) that the with statement is more evil than good. Although I am aware of the potential confusion, and have fallen for it a couple of times, I cannot agree. Careful use of the with statement can make the code look much prettier. And this lessens the risk of confusion due to "barfcode".
For example:
Compare
var
verdata: TVerInfo;
verdata := GetFileVerNumbers(FileName);
result := IntToStr(verdata.vMajor) + '.' + IntToStr(verdata.vMinor) + '.' + IntToStr(verdata.vRelease) + '.' + IntToStr(verdata.vBuild);
with
with GetFileVerNumbers(FileName) do
result := IntToStr(vMajor) + '.' + IntToStr(vMinor) + '.' + IntToStr(vRelease) + '.' + IntToStr(vBuild);
There is absolutely no risk of confusion, and not only do we save a temporaray variable in the last case - it also is far more readable.
Or what about this very, very, standard code:
with TAboutDlg.Create(self) do
try
ShowModal;
finally
Free;
end;
Exactly where is the risk of confusion? From my own code I could give hundreds of more examples of with statements, all simplifying code.
Furthermore, as have been stated above, there is no risk of using with at all, as long as you know what you are doing. But what if you want to use a with statement together with the MyObject in the example above: then, inside the with statement, Caption is equal to MyObject.Caption. How do you change the caption of the form, then? Simple!
with MyObject do
begin
Caption := 'This is the caption of MyObject.';
Self.Caption := 'This is the caption of Form1 (say).';
end;
Another place where with can be useful is when working with a property or function result that takes a non-trivial amount of time to execute.
To work with the TClipper example above, suppose that you have a list of TClipper objects with a slow method that returns the clipper for a particular TabSheet.
Ideally you should only call this getter once, so you can either use an explicit local variable, or an implicit one using with.
var
Clipper : TClipper;
begin
Clipper := ClipList.GetClipperForTab(TabSheet);
Clipper.AddPolygon(subject, ptSubject);
Clipper.AddPolygon(clip, ptClip);
Clipper.Execute(ctIntersection, solution);
end;
OR
begin
with ClipList.GetClipperForTab(TabSheet)do
begin
AddPolygon(subject, ptSubject);
AddPolygon(clip, ptClip);
Execute(ctIntersection, solution);
end;
end;
In a case like this, either method would do, but in some circumstances, typically in complex conditionals a with can be clearer.
var
Clipper : TClipper;
begin
Clipper := ClipList.GetClipperForTab(TabSheet);
if (Clipper.X = 0) and (Clipper.Height = 0) and .... then
Clipper.AddPolygon(subject, ptSubject);
end;
OR
begin
with ClipList.GetClipperForTab(TabSheet) do
if (X = 0) and (Height = 0) and .... then
AddPolygon(subject, ptSubject);
end;
In the end is is matter of personal taste. I generally will only use a with with a very tight scope, and never nest them. Used this way they are a useful tool to reduce barfcode.
It's a call to TObject.Free, which is basically defined as:
if self <> nil then
self.Destroy;
It's being executed on the unnamed TClipper object created in the with statement.
This is a very good example of why you shouldn't use with. It tends to make the code harder to read.
Free calls the destructor of the object, and releases the memory occupied by the instance of the object.
I don't know anything about Delphi but I would assume that it is releasing the resources used by TClipper much like a using statement in C#. That is just a guess....
Any dinamicly created object must call free to free at object creation alocated memory after use. TClipper object is a desktop content creation, capture and management tool. So it is some kind of Delphi connection object with Clipper. The create (object creation) is handled in try finaly end; statment what mean, if connection with Clipper isn't successful the object TClipper will not be created and can not be freed after after of try finaly end; statement.
If "with" is as evil as some posters are suggesting, could they please explain
1. why Borland created this language construct, and
2. why they (Borland/Embarcadero/CodeGear) use it extensively in their own code?
While I certainly understand that some Delphi programmers don't like "with", and while acknowledging that some users abuse it, I think it's silly to say "you shouldn't use it".
angusj - author of the offending code :)
I wrote Delphi debug visualizer for TDataSet to display values of current row, source + screenshot: http://delphi.netcode.cz/text/tdataset-debug-visualizer.aspx . Working good, but very slow. I did some optimalization (how to get fieldnames) but still for only 20 fields takes 10 seconds to show - very bad.
Main problem seems to be slow IOTAThread90.Evaluate used by main code shown below, this procedure cost most of time, line with ** about 80% time. FExpression is name of TDataset in code.
procedure TDataSetViewerFrame.mFillData;
var
iCount: Integer;
I: Integer;
// sw: TStopwatch;
s: string;
begin
// sw := TStopwatch.StartNew;
iCount := StrToIntDef(Evaluate(FExpression+'.Fields.Count'), 0);
for I := 0 to iCount - 1 do
begin
s:= s + Format('%s.Fields[%d].FieldName+'',''+', [FExpression, I]);
// FFields.Add(Evaluate(Format('%s.Fields[%d].FieldName', [FExpression, I])));
FValues.Add(Evaluate(Format('%s.Fields[%d].Value', [FExpression, I]))); //**
end;
if s<> '' then
Delete(s, length(s)-4, 5);
s := Evaluate(s);
s:= Copy(s, 2, Length(s) -2);
FFields.CommaText := s;
{ sw.Stop;
s := sw.Elapsed;
Application.MessageBox(Pchar(s), '');}
end;
Now I have no idea how to improve performance.
That Evaluate needs to do a surprising amount of work. The compiler needs to compile it, resolving symbols to memory addresses, while evaluating properties may cause functions to be called, which needs the debugger to copy the arguments across into the debugee, set up a stack frame, invoke the function to be called, collect the results - and this involves pausing and resuming the debugee.
I can only suggest trying to pack more work into the Evaluate call. I'm not 100% sure how the interaction between the debugger and the evaluator (which is part of the compiler) works for these visualizers, but batching up as much work as possible may help. Try building up a more complicated expression before calling Evaluate after the loop. You may need to use some escaping or delimiting convention to unpack the results. For example, imagine what an expression that built the list of field values and returned them as a comma separated string would look like - but you would need to escape commas in the values themselves.
Because Delphi is a different process than your debugged exe, you cannot direct use the memory pointers of your exe, so you need to use ".Evaluate" for everything.
You can use 2 different approaches:
Add special debug dump function into executable, which does all value retrieving in one call
Inject special dll into exe with does the same as 1 (more hacking etc)
I got option 1 working, 2 should also be possible but a little bit more complicated and "ugly" because of hacking tactics...
With code below (just add to dpr) you can use:
Result := 'Dump=' + Evaluate('TObjectDumper.SpecialDump(' + FExpression + ')');
Demo code of option 1, change it for your TDataset (maybe make CSV string of all values?):
unit Unit1;
interface
type
TObjectDumper = class
public
class function SpecialDump(aObj: TObject): string;
end;
implementation
class function TObjectDumper.SpecialDump(aObj: TObject): string;
begin
Result := '';
if aObj <> nil then
Result := 'Special dump: ' + aObj.Classname;
end;
initialization
//dummy call, just to ensure it is linked c.q. used by compiler
TObjectDumper.SpecialDump(nil);
end.
Edit: in case someone is interested: I got option 2 working too (bpl injection)
I have not had a chance to play with the debug visualizers yet, so I do not know if this work, but have you tried using Evaluate() to convert FExpression into its actual memory address? If you can do that, then type-cast that memory address to a TDataSet pointer and use its properties normally without going through additional Evaluate() calls. For example:
procedure TDataSetViewerFrame.mFillData;
var
DS: TDataSet;
I: Integer;
// sw: TStopwatch;
begin
// sw := TStopwatch.StartNew;
DS := TDataSet(StrToInt(Evaluate(FExpression)); // this line may need tweaking
for I := 0 to DS.Fields.Count - 1 do
begin
with DS.Fields[I] do begin
FFields.Add(FieldName);
FValues.Add(VarToStr(Value));
end;
end;
{
sw.Stop;
s := sw.Elapsed;
Application.MessageBox(Pchar(s), '');
}
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?
SOLVED
I am using delphi 2009. My program listens for usb drives being connected and remove. Ive used a very similar code in 10 apps over the past year. It has always worked perfectly. When i migrated i had to give up using thddinfo to get the drive model. This has been replaced by using WMI. The WMI query requires the physical disk number and i happen to already have a function in the app for doing just that.
As i test I put this in a button and ran it and it successfully determines the psp is physical drive 4 and returns the model (all checked in the debugger and in another example using show message):
function IsPSP(Drive: String):Boolean;
var
Model: String;
DriveNum: Byte;
begin
Result := False;
Delete(Drive, 2, MaxInt);
DriveNum := GetPhysicalDiskNumber(Drive[1]);
Model := (MagWmiGetDiskModel(DriveNum));
if Pos('PSP',Model) > 0 then Result := True;
end;
procedure TfrmMain.Button1Click(Sender: TObject);
var DriveNum: Byte;
begin
IsPSP('I');
end;
It works perfectly that is until i allow the WMDeviceChange that ive been using for a year to call up the getphysicaldisknumber and the wmi query statement. Ive tried them by themselves theyre both a problem. GetPhysicalDiskNumber freezes real bad when its doing a CloseHandle on the logical disk but does return the number eventually. The WMI query fails with no error just returns '' debugger points into the wbemscripting_tlb where the connection just never happened. Keep in mind the only thing thats changed in a year is what im calling to get the model i was using an api call and now im using something else.
Below is the rest of the code involved at this time sans the ispsp that is displayed above:
procedure TfrmMain.WMDeviceChange(var Msg: TMessage);
var Drive: String;
begin
case Msg.wParam of
DBT_DeviceArrival: if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
begin
Drive := GetDrive(PDevBroadcastVolume(Msg.lParam)) + '\';
OnDeviceInsert(Drive);
end;
DBT_DeviceRemoveComplete: if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
begin
Drive := GetDrive(PDevBroadcastVolume(Msg.lParam)) + '\';
OnDeviceRemove(Drive);
end;
end;
end;
Procedure TfrmMain.OnDeviceInsert(Drive: String);
var PreviousIndex: Integer;
begin
if (getdrivetype(Pchar(Drive))=DRIVE_REMOVABLE) then
begin
PreviousIndex := cbxDriveList.Items.IndexOf(cbxDriveList.Text);
cbxDriveList.Items.Append(Drive);
if PreviousIndex = -1 then //If there was no drive to begin with then set index to 0
begin
PreviousIndex := 0;
cbxDriveList.ItemIndex := 0;
end;
if isPSP(Drive) then
begin
if MessageDlg('A PSP was detect # ' + Drive + #10#13 + 'Would you like to select this drive?',mtWarning,[mbYes,mbNo], 0) = mrYes then
cbxDriveList.ItemIndex := cbxDriveList.Items.IndexOf(Drive)
else cbxDriveList.ItemIndex := PreviousIndex;
end
else if MessageDlg('USB Drive ' + Drive + ' Detected' + #10#13 + 'Is this your target drive?',mtWarning,[mbYes,mbNo], 0) = mrYes then
cbxDriveList.ItemIndex := cbxDriveList.Items.IndexOf(Drive)
else cbxDriveList.ItemIndex := PreviousIndex;
end;
end;
Procedure TfrmMain.OnDeviceRemove(Drive: String);
begin
if not (getdrivetype(Pchar(Drive)) = DRIVE_CDROM) then
begin
if cbxDriveList.Text = (Drive) then ShowMessage('The selected drive (' + Drive + ') has been removed');
cbxDriveList.Items.Delete(cbxDriveList.Items.IndexOf(Drive));
if cbxDriveList.Text = '' then cbxDriveList.ItemIndex := 0;
if Drive = PSPDrive then //Check Detect PSP and remove reference if its been removed
begin
PSPDrive := '';
end;
end;
end;
Rob has said something below about im not calling the inherited message handler, ive read the document i see a couple of things i can return... but im not really sure i understand but i will look into it. Im not a very good pascal programmer but ive been learning alot. The transition to 2009 has had some rough patches as well.
The USB drive detection and all that works perfectly. If i remove the two things from is psp the user is greeted right away with wis this your whatever and adds I:\ to the list. Its just the two new things that have changed in the app that fail when called by wmdevicechange and as said before they work on their own.
EDIT - SOLVED
Alright well im using a timer as suggested and the problem seems to be solved. One note is that when called by the timer very shortly after the wmdevicechange getting the physical disk number still seems to be slow. I attribute this to the device still being attached to the system.
On that note im using a P2 450 on the regular. I hooked the PSP and app to a 1.8Ghz Dual Core Laptop and the program detected the psp and notified the user very fast. So the app wont freeze unless there on a very very slow computer and on this slow onw its only for a matter of seconds and doesnt affect the operation of the program though isnt very cool. But i feel that all modern computers will run the detection fast especially because they can attach the device alot faster.
It's possible that the information you're querying becomes available only after the WMDeviceChange message handler runs. If the very same code works when called from a button, try this:
Refactor your WMDeviceChange handler code into one or more separate methods.
In the WMDeviceChange handler, activate a precreated timer and have it fire one second later, or something like that.
Call the former WMDeviceChange handler code from the timer handler code.
You haven't indicated what "statement 1" is in your code.
I have a few comments about parts of the code, which may or may not be related to the problem you're having.
First, you assign a value to DriveNum in IsPSP, but you don't use it. The compiler should have issued a hint about that; don't ignore hints and warnings. You also pass the magic number 4 into MagWmiGetDiskModel; was that supposed to be DriveNum instead?
You aren't calling the inherited message handler, and you aren't returning a result in your message handler. The documentation tells what values you're supposed to return. To return a value from a Delphi message handler, assign a value to the Msg.Result field. For the cases that your message handler doesn't handle, make sure you call inherited so that the next handler up the chain can take care of them. If there is no next handler, then Delphi will call DefWindowProc to get the operating system's default behavior.
The change you've illustrated is called refactoring, and it will do nothing to affect how your code runs. It makes the code easier to read, though, so please keep the second version. As for finding the problem, my best advice is to use the debugger to step through the code to identify the point where things stat to go wrong and the parts that run slower than you'd like. You can also try removing portions of the code to confirm that the other parts work correctly in isolation.