Delphi Pascal Problem when WMDeviceChange function calls other functions/procedures - delphi

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.

Related

How can I remove a PCB Object in Altium PCB Library using Altium scripting systems?

I am writing a Delphi Altium script to remove all tracks in TopOverLay inside the PCB Library.
When running the script though, nothing happens (the tracks are not removed).
I don't know why. Can you please help me?
Here below is my code :
procedure RemoveTrackObject;
Var
MyComponent : IPCB_LibComponent;
MyTrack : IPCB_Track;
Iterator : IPCB_GroupIterator;
DeleteList : TInterfaceList;
TrackTemp : IPCB_Track;
i : Integer;
begin
MyComponent := PCBServer.GetCurrentPCBLibrary.CurrentComponent;
//////////////////////////////////////////////////////////////////////
Iterator := MyComponent.GroupIterator_Create;
Iterator.AddFilter_ObjectSet(Mkset(eTrackObject));
Iterator.AddFilter_LayerSet(Mkset(eTopOverLay));
DeleteList := TInterfaceList.Create;
try
MyTrack := Iterator.FirstPCBObject;
While MyTrack <> nil do
begin
DeleteList.Add(MyTrack);
MyTrack := Iterator.NextPCBObject;
end;
finally
MyComponent.GroupIterator_Destroy(Iterator);
end;
try
PCBServer.PreProcess;
for i := 0 to DeleteList.Count - 1 do
begin
TrackTemp := DeleteList.Items[i];
MyComponent.RemovePCBObject(TrackTemp);
end;
finally
PCBServer.PostProcess;
DeleteList.Free;
end;
Client.SendMessage('PCB:Zoom', 'Action=Redraw' , 255, Client.CurrentView);
end;
AFAIU In Altium dephiscript API InterfaceList have specific uses: holding non-PCB objects & passing to external dll functions & letting the receiving fn destroy the list.
You don't really need one here.
The PcbLib does have some strange behaviour around deleting from selected/focused footprint etc.
I think the problem is caused by the Pcb Editor not allowing objects to be deleted from the current focused component/footprint.
The history around this issue points to solutions involving moving focus away from the required component..
You can't complete the delete process while the List still contains the object reference.
Use a While loop, after RemovePCBObject(), remove object ref from the List (remove the List Item). Then when the While loop terminates you have zero items in List.
Might help refresh or look & feel to use some of these fn calls:
CurrentLib.Board.GraphicallyInvalidate;
CurrentLib.Navigate_FirstComponent;
CurrentLib.Board.ViewManager_FullUpdate;
CurrentLib.Board.GraphicalView_ZoomRedraw;
CurrentLib.RefreshView;

What is a better method to suspend program execution until a condition is met?

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
...

Determine when an Excel workbook has closed with Delphi

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;

Problem with running WebService in separate thread in Delphi

I have never asked questions in any community as I always solved problems by myself or could find them online. But with this one I came to dead end and need Help!
To make it very clear – I converted a simple app, found elsewhere to make it use a Tthread object.
The idea is simple – the app checks online using webservice, through THTTPRIO component, weather and put the results in Memo1 lines.
Clicking on Button1 we get it done in standard way – using THTTPRIO put on the Form1 (it's called here htt as in original app) and using main and only thread.
procedure TForm1.Button1Click(Sender: TObject);
var
wf:WeatherForecasts;
res:ArrayOfWeatherData;
i:integer;
begin
wf:=(htt as WeatherForecastSoap).GetWeatherByPlaceName(edit1.Text);
if wf.PlaceName<> '' then
res:=wf.Details;
memo1.Lines.Add('The min and max temps in Fahrenheit is:');
memo1.Lines.Add(' ');
for i:= 0 to high(res) do
begin
memo1.Lines.Add(res[i].Day+' - '+ ' Max Temp. Fahr: '+res[i].MaxTemperatureF+' - '+'Min Temp Fahr: '+res[i].MinTemperatureF);
end
end;
Clicking on Button2 – we use class TThread
procedure TForm1.Button2Click(Sender: TObject);
var WFThread:WeatherThread;
begin
WFThread := WeatherThread.Create (True);
WFThread.FreeOnTerminate := True;
WFThread.Place := Edit1.Text;
WFThread.Resume;
end;
In Execute procedure in WeatherThread1 unit I put this code:
procedure WeatherThread.Execute;
begin
{ Place thread code here }
GetForecast;
Synchronize (ShowWeather);
end;
...and the GetForecast code:
procedure WeatherThread.GetForecast;
var
HTTPRIO: THTTPRIO;
wf:WeatherForecasts;
res:ArrayOfWeatherData;
i:integer;
begin
HTTPRIO := THTTPRIO.Create(nil);
HTTPRIO.URL := 'http://www.webservicex.net/WeatherForecast.asmx';
HTTPRIO.WSDLLocation := 'http://www.webservicex.net/WeatherForecast.asmx?WSDL';
HTTPRIO.Service := 'WeatherForecast';
HTTPRIO.Port := 'WeatherForecastSoap';
wf:=(HTTPRIO as WeatherForecastSoap).GetWeatherByPlaceName(Place);
if Lines=nil then Lines:=TStringList.Create;
if wf.PlaceName<> '' then
res:=wf.Details;
Lines.Clear;
for i:= 0 to high(res) do
begin
Lines.Add(res[i].Day+' - '+ ' Max Temp. Fahr: '+res[i].MaxTemperatureF+' - '+'Min Temp Fahr: '+res[i].MinTemperatureF);
end;
end;
Procedure ShowWeather shows results in Form1.Memo1.
And now there is a problem: In main thread, clicking Button1, everything works fine. But of course when HTTPRIO component communicates – it freezes the form.
With Button2 I put the code in separate thread but it does NOT WANT TO WORK! Something strange happens. When I start application – and click Button2, there is an error when using HTTPRIO component. But it works for a while when I click FIRST Button1 and AFTER THAT Button2 (but it works for a while, 5-7 clicks only).
I suppose I do something wrong but cannot figure out where the problem is and how to solve it. It looks like the code in threaded unit is not thread-safe, but it should be. Please help how to make HTTPRIO work in a thread!!!
You can find zipped full code here.
When I run your code in Delphi 2007, madExcept shows an exception CoInitialize has not been called.
After adding the call to CoInitialize in the execute method, the webservice gets called without problems.
Possible fix
procedure TWeatherThread.Execute;
begin
CoInitialize(nil);
try
...
finally
CoUninitialize;
end;
end;
A long shot, but I'm missing calls to Synchronize here:
You should never update your GUI directly from your thread code.
You should embed those calls inside a method, and call that method using the TThread.Synchronize method for this.
Delphi about has a nice demo on this.
Since Delphi 4, it includes a demo called sortthds.pas in the ...\demos\threads subdirectory that shows the same.
--jeroen
You may be clouding the issue by doing the dynamic RIO creation (RIO objects have a strange lifetime) and threading together, and comparing that outcome to the straightforward Button1. I'd make another button that calls GetForecast without threads. See if that works. If it bombs, then your problem isn't threading.

Delphi Twain issue help

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?

Resources