I'm with a problem here while using the Delphi Regex records. This is my problem code:
function CrawlThread.CrawlLinks: bool;
var
Matches: TMatchCollection;
Match: TMatch;
i: integer;
begin
Matches:= TRegex.Matches(code, frmCrawler.Edit2.Text);
if Matches.Count > 0 then
begin
i:= 0;
for Match in Matches do
begin
SetLength(CrawledLinks, i + 1);
if (POS('https://', Match.Value) = 0) then
CrawledLinks[i]:= 'http://' + Match.Value
else
CrawledLinks[i]:= Match.Value;
inc(i);
end;
Result:= true;
end;
Matches:= TRegex.Matches(code, frmCrawler.Edit3.Text);
if Matches.Count > 0 then
begin
i:= 0;
for Match in Matches do
begin
SetLength(FollowLinks, i + 1);
if (POS('https://', Match.Value) = 0) then
FollowLinks[i]:= 'http://' + Match.Value
else
FollowLinks[i]:= Match.Value;
inc(i);
end;
Result:= true;
end;
This code gets called multiple times inside threads, if I comment it, I get like 26MB on memory usage, and not growing up... When I use it, I start around 50MB (what is not a problem), but it keeps growing up like 1MB per minute (in 1 min this code gets called hundreds of times).
Using the ReportMemoryLeaksOnShutdown:= true; I get this output:
It's almost the same when commented or using the code, so I don't believe it explain the 1MB per minute when using the code. Of course the UnicodeString leaks bother me, but as I get them even when not using the code, I don't think they are the problem.
Is there any idea on why that code is consuming so much memory?
I dont think any of the shown code is leaking, since TMatchCollection and TMatch are pure records.
I have seen similar build-up of memory due to allocation of strings. But it must stabilize after a while, unless they are f.ex added to a TStringList without ever cleaning it.
That leads me to the next: The message box speaks about 2 x TStringList that are never freed. Have you tried so search your project for all TStringList.Create and made sure there are matching TStringList.Free?
Likewise for TCriticalSection and TIdHashMessageDigest5?
Just to be sure: in the above code it seems its a method inside a Thread class? If so, it will lead to errors referring to the components frmCrawler.Edit2.Text and frmCrawler.Edit3.Text in the VCL thread.
Related
I need to wait until a mapped network folder (\HostName\NetworkPath) become empty. What I mean is that program flow cannot continue until that network folder is empty.
So far I have the following logic in place but I noticed that it takes time before FindFirst notices that the network folder become empty.
If I keep observing an opened explorer windows, pointing to that network folder, I notice that it become empty far before FindFirst notices it.
I used Sleep(5000) to introduce some delay in calling again CheckNetworkFolderIsEmpty in my while loop, otherwise it is being called too often. But maybe that folder will become empty far before 5 seconds, so 5 seconds is an arbitrary time delay that may results in an unnecessary dealy in program execution, in the event that the folder become empty before.
What can be the culprit, what can be a better alternative?
Also I do not know what else to use instead of a simple Sleep.
while not CheckRawFolderIsEmpty do begin
Sleep(5000);
end;
function TForm1.CheckNetworkFolderIsEmpty: Boolean;
begin
Result := (CountFilesInFolder('\\HostName\NetworkPath', '*.txt') = 0);
end;
function CountFilesInFolder(const aPath, aFileMask: string): Integer;
var
Path: string;
SearchRec: TSearchRec;
begin
Path := IncludeTrailingPathDelimiter(aPath);
Result := 0;
if FindFirst(Path + aFileMask, faAnyFile and not faDirectory, SearchRec) = 0 then begin
repeat
Inc(Result);
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;
Observing file system changes like you do is inefficient (FindFirst, FindNext) and inacurate as you've learned. Windows provides API FindFirstChangeNotification for that purpose as J... has pointed out in the comment under your question.
Good news is that you don't need to start studying the API from scratch, because some other people did the hard work for you. Check out some freeware wrappers for Delphi around the API:
https://torry.net/pages.php?id=252
http://www.angusj.com/delphi/dirwatch.html
...
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.
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 had a topic 1-2 weeks ago about a "The block header has been corrupted" and "Block has been modified after being freed" error.
Somebody gave me a good tip (thanks Alexander) about setting FullDebugModeScanMemoryPoolBeforeEveryOperation to true and finally I have some indications about where is the TRUE location of the error.
The error log points to TScObj object. I have a second object very similar to this one and when I use it the error does not appear. So, this somehow confirms that the error is in this specific object (TScObj).
The log is like this:
FastMM has detected an error during a free block scan operation.
FastMM detected that a block has been modified after being freed.
Modified byte offsets (and lengths): 15656(1)
The previous block size was: 15672
This block was previously allocated by thread 0xC88, and the stack trace (return addresses) at the time was:
402EC9 [System][#ReallocMem]
40666C [System][DynArraySetLength]
40A17D [FastMM4][UpdateHeaderAndFooterCheckSums]
40674E [System][#DynArraySetLength]
4CE329 [ReadSC.pas][ReadSC][TScObj.ReadData][239]
4CDD0C [ReadSC.pas][ReadSC][TScObj.LoadFromFile][168]
4D013E [SmplCubImport.pas][SmplCubImport][TCubImport.ImportSample][164]
40461A [System][#AfterConstruction]
4DC151 [UnitAsmJob.pas][UnitAsmJob][TAsmJob.LoadSample][960]
The allocation number was: 78709
The block was previously freed by thread 0xC88, and the stack trace (return addresses) at the time was:
402E6F [System][#FreeMem]
4068A8 [System][#DynArrayClear]
405DF9 [System][#FinalizeArray]
4CE9F9 [ReadSC.pas][ReadSC][TScObj.ReadData][298]
4CDD0C [ReadSC.pas][ReadSC][TScObj.LoadFromFile][168]
4D013E [SmplCubImport.pas][SmplCubImport][TCubImport.ImportSample][164]
40461A [System][#AfterConstruction]
4DC151 [UnitAsmJob.pas][UnitAsmJob][TAsmJob.LoadSample][960]
The thing is that I don't see any place in my code where I could wrongfully allocate memory.
type
TWordTrace = array of Word;
TDiskTrc = array of Smallint;
var Tracea,Tracec: TWordTrace;
procedure TScObj.ReadData;
Var i: Integer;
DiskTrc1: TDiskTrc;
DiskTrc2: TDiskTrc;
DiskTrc3: TDiskTrc;
DiskTrc4: TDiskTrc;
begin
SetLength(DiskTrc1, H.NrOfSamples+1);
SetLength(DiskTrc2, H.NrOfSamples+1);
SetLength(DiskTrc3, H.NrOfSamples+1);
SetLength(DiskTrc4, H.NrOfSamples+1); <------ log shows error here. <- on DynArraySetLength
FStream.Seek( H.SOffset, soFromBeginning);
if H.SampleSize = 1 then
begin
for i:= 1 TO H.NrOfSamples DO
FStream.Read( DiskTrc1[i], 1);
Unpack(DiskTrc1);
for i:= 1 TO H.NrOfSamples DO
FStream.Read( DiskTrc2[i], 1);
Unpack(DiskTrc2);
etc...
end
else
begin
for i:= 1 TO H.NrOfSamples DO
begin
FStream.Read( DiskTrc1[i], 2);
DiskTrc1[i]:= Swap(DiskTrc1[i]);
end;
Unpack(DiskTrc1);
for i:= 1 TO H.NrOfSamples DO
begin
FStream.Read( DiskTrc2[i], 2);
DiskTrc2[i]:= Swap(DiskTrc2[i]);
end;
Unpack(DiskTrc2);
etc...
end;
SetLength(Tracea, H.NrOfSamples+1);
SetLength(Tracec, H.NrOfSamples+1);
SetLength(Traceg, H.NrOfSamples+1);
SetLength(Tracet, H.NrOfSamples+1); <------ log shows error here. <- on FinalizeArray
for i:=1 to H.NrOfSamples DO
begin
if DiskTrc1[i]< 0
then Tracea[i]:= 0
else Tracea[i]:= DiskTrc1[i];
if DiskTrc2[i]< 0
then Tracec[i]:= 0
else Tracec[i]:= DiskTrc2[i];
etc...
end;
end;
procedure TScObj.Unpack(VAR DiskTrc: TDiskTrc);
var i: integer;
Prev: Integer;
Recover: Integer;
begin
Prev:= 0;
for i:= 1 to H.NrOfSamples do
begin
Recover := DiskTrc[i] + Prev;
if (Recover> 32767) OR (Recover< -32768)
then Recover:= 0;
DiskTrc[i]:= Recover;
Prev:= DiskTrc[i];
end;
Prev:= 0;
for i:= 1 to H.NrOfSamples do
begin
Recover := DiskTrc[i] + Prev;
if (Recover> 32767) OR (Recover< -32768)
then Recover:= 0;
DiskTrc[i]:= Recover;
Prev:= DiskTrc[i];
end;
end;
Later during the "load from disk" procedure, the information from the temporary loader object (SC) is transfered into a more "definitive" object, like this:
TSam = class
etc...
for i:= 1 to NrOfSamples DO
begin
CMX[i].Tracea:= SC.Tracea[i];
CMX[i].Tracec:= SC.Tracec[i];
etc...
end;
Edit 2:
The bug appears only when I try to open/load a very specific set of (two) files. For all other files the bug doesn't show.
Did you try to run this code with FullDebugModeScanMemoryPoolBeforeEveryOperation enabled? Did you try to call ScanMemoryPoolForCorruptions at TScObj.ReadData's start?
If that doesn't help - try to step into that problem call (GetMem?) and follow FastMM's code to see the address of that corrupted header. Just write it down on the paper and restart the program. There are very high chances that the address of this block will be the same.
Set a breakpoint at safe location - i.e. right before "bad things" happens. Once stopped on it - then set a new breakpoint on memory's location - right at this header, which will become corrupted later (be sure not to set it too early).
Then just run your program - the debugger will stop right at this bad code, which tries to modify header.
I think you've got corruption happening elsewhere, and what looks like a routine call is just unmasking the problem. The locations you're pointing to don't seem likely to currupt memory. Without looking at the code in detail, isolating procedures and testing them carefully, it's awfully hard to guess where the problem lies. Do you get any warnings when you compile?
I'm thinking the error is not ion the code shown, but there is something you should really check:
SetLength(DiskTrc1, H.NrOfSamples+1);
for i:= 1 TO H.NrOfSamples DO
FStream.Read( DiskTrc1[i], 1);
This works thanks to the +1 in Setlength, but are you aware that you are allocating 1 extra item at DiskTrc1[0] that is never used?
I suspect that you mix this with a Setlength(xx, N) somewhere (how is CMX created/dimensioned?).
Note that the normal pattern is
SetLength(DiskTrc1, H.NrOfSamples);
for i:= 0 TO H.NrOfSamples-1 DO
FStream.Read( DiskTrc1[i], 1);
You need to show more code (like, how is TDiskTrc defined?)
A few points:
Remember that Dynamic arrays are reference-counted, have you tried running with and without Optimizations?
Before using any of these items you may want to assert:
assert(CMX <> nil);
assert(Length(CMX) = NrOfSamples+1);
Is there any code (Swap, Unpack, ...) that stores a reference to an Array?
Are you re-using thos SC objects? (Hint: don't)
Are you clearing any arrays (like DiskTrc1 := nil or SetLength(DiskTrc1, 0) ?
Everyone seems to be skipping the important error at the start:
FastMM has detected an error during a free block scan operation. FastMM detected that a block has been modified after being freed.
An old pointer is being used somewhere.
Since you have no clue on the pointer error you are looking for I would forget it for now and go look for the other one--they might turn out to be related.
Solved.
Today I spent the day manually inspecting each line of code. I made quite few changes and finally the problem went away. I haven't tried to see which specific line generated the problem.
Thanks a lot to every body for help !!!
Are your arrays 0-based or 1-based?
Multiple times you run loops like this:
if H.SampleSize = 1 then
begin
for i:= 1 TO H.NrOfSamples DO
FStream.Read( DiskTrc1[i], 1);
Unpack(DiskTrc1);
...
Are you sure this is not reading past the end of DiskTrc1?
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.