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.
Related
I have created a new component from (TShape ), and I make a Timer property as the next ::
property Timer:TTimer read FDeviceTimer write SetDeviceTimer ;
The purpose from this timer is that I want it to change the component height in the design time by using the next procedure :
procedure TFireDeviceWTimer.OnTimerRepaint(Sender: TObject);
begin
//==================
if ChangDim then begin
Height:=Height+10;
//Repaint;
Sleep(FDeviceTimer.Interval);
ChangDim:=False;
end
else begin
Height:=Height-10;
//Repaint;
Sleep(FDeviceTimer.Interval);
ChangDim:=true;
end;
end;
and it works good , but the issue that I have noted after using it in the run time , that it makes the application too slow ...
can anybody explain the reason & the solution for such issue ..
Thank u.
Reason: The TTimer works in the same Thread of the main application.
Solution: Instead of a Timer, create a Thread that loops until the main component has been destroyed.
To do this, you could put in the constructor of the component something like this
FPaintThread := CreateAnonymouseThread(procedure
begin
while assigned(Self) and (not Application.Terminated) do
begin
RepainInstruction;
Sleep(100);
end;
end);
FPaintThread.Start;
But remember to use TThread.Synchronize to interact with the main Thread objects to prevent bugs.
In my application I want to copy all the text from a website into a string variable. Because of some issues with Indy, I want to use the webbrowser component.
The following code works perfectly for me:
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate('www.tribalwars.nl');
while WebBrowser1.Busy do
Application.ProcessMessages;
Memo1.Lines.Add((WebBrowser1.Document as IHTMLDocument2).body.innerText);
end;
However, in the example above I use a WebBrowser that has been manually created on my Form1.
Now I want to create it during runtime. I tried the following code:
procedure TForm1.Button2Click(Sender: TObject);
var Web: TWebBrowser;
begin
Web := TWebBrowser.Create(nil);
Web.Navigate('www.tribalwars.nl');
while Web.Busy do
Application.ProcessMessages;
Memo1.Lines.Add((Web.Document as IHTMLDocument2).body.innerText); //This line raises the error mentioned below
Web.Free;
end;
Unfortunately it keeps raising the following error:
Project Project1.exe raised exception class $C0000005 with message 'access violation at 0x005d9b4f: read of address 0x00000000'.
I guess I'm trying to use something that hasn't been created yet, or somewhere in that direction.
I hope someone can help me get this to work!
EDIT: whosrdaddy mentioned that I should make this component visible. How can I do that? I tried this, but it doesn't work:
procedure TForm1.Button2Click(Sender: TObject);
var Web: TWebBrowser;
begin
Web := TWebBrowser.Create(nil);
Web.Left := 50;
Web.Top := 50;
Web.Width := 50;
Web.Height := 50;
Web.Visible := True;
Application.ProcessMessages;
Web.Navigate('www.tribalwars.nl');
while Web.Busy do
Application.ProcessMessages;
Memo1.Lines.Add((Web.Document as IHTMLDocument2).body.innerText);
Web.Free;
end;
The problem is that when you create TWebBrowser dynamically and pass NIL as the owner, unfortunately the parent is also NIL. a non -NIL parent is needed to display anything.
Normally you would do this:
var
pnlBrowser : TPanel;
Web : TWebBrowser;
Web := TWebBrowser.Create(nil);
Web.Parent := pnlBrowser;
BUT, unfortunately, you cannot (directly) do this either (you get an error message "read-only property" if you try).
But luckily, there IS a way to circumvent the problem:
TWinControl(Web).Parent := pnlBrowser; // this works OK!
I have no idea WHY the parent property of the TWebBrowser class is read-only.
Reading the Delphi documentation, also
TControl(Web).Parent := pnlBrowser; // this should also work
as a side note:
If you have TmsMediaPlayer component (the ActiveX version of Microsoft Windows Media Player), setting parent using the Delphi's Parent property will stop any video playing, but setting it directly through a windows API call does not.
IF you want to use your TWebBrowser to play videos, changing the Parent property on the fly may also stop any video playing. If so it is worth trying to change the parent using windows API call directly instead to avoid stopping a video playing in the web browser.
1) try to change Your TWebBrowser component to TEmbeddedWB
- the parameters/events are the same + lots of extras You can use...
2) I think the problem is with the readystate of your created browser after navigation - its not loaded completely (+maybe it has not assigned parent)
try use the following code (replace Your TWebBrowser component name):
Web.Navigate('www.tribalwars.nl')
repeat application.processmessages; until web.readystate=4;
Memo1.Lines.Add((Web.Document as IHTMLDocument2).body.innerText);
I'm currently developing some simple auto-updater app. The most important feature is the possibility of self updating. That's why I plan to put most logic in external DLL. After my DLL grown a little I started to get problems with FreeLibrary call in main app. During dll debugging I've found function responsible for that bug:
function TpmDSServerUpdateDownloader.DownloadUpdates: Boolean;
var
LSQLConnection: TSQLConnection;
LSQLServerMethod: TSqlServerMethod;
LUpdatePackageLink: string;
begin
try
{$IFDEF DEBUG}
Sleep(10000);
{$ENDIF}
// Getting update package link
FUpdateServerIP := '127.0.0.1';
FUpdateServerPort := 8080;
LSQLConnection := TSQLConnection.Create(nil);
LSQLServerMethod:= TSQLServerMethod.Create(nil);
LSQLConnection.DriverName :='DataSnap';
LSQLConnection.LoginPrompt := False;
LSQLConnection.Params.Add('CommunicationProtocol=HTTP');
LSQLConnection.Params.Add('Hostname=' + FUpdateServerIP);
LSQLConnection.Params.Add('Port=' + IntToStr(FUpdateServerPort));
LSQLConnection.Params.Add('ConnectTimeout=' + IntToStr(10000));
LSQLConnection.Connected := True;
LSQLServerMethod.SQLConnection:= LSQLConnection;
LSQLServerMethod.ServerMethodName:= 'TServerMethods1.GetUpdatePackageLink';
LSQLServerMethod.Params[0].AsInteger := 1;
LSQLServerMethod.ExecuteMethod;
LUpdatePackageLink := LSQLServerMethod.Params[1].AsString;
// Downloading update package with LUpdatePackage link
finally
LSQLConnection.Connected := False;
LSQLServerMethod.Free;
FreeAndNil(LSQLConnection);
end;
end;
The problem appears when I'm using dbExpress components from that function. I'm wondering if freeing the TSQLConnection/TSQLServerMethod leaves some working dbExpress threads/objects like it was with SQLMonitor in IBObjects. Maybe you have some ideas how to solve that? I would be very grateful for help.
Greetings
Michal
This is a Delphi BUG.
However there is a solution:
following Microsoft closing thread cannot be called from DLL unload, so FreeLibrary freez on WaitForMultipleObject inifinite loop in the TThread.WaitFor proc of the TDBXScheduler which is created in the initialization section of the Data.DBXCommon and going to be auto close in the finialization section of that unit. This makes the error. So we must close that thread earlier.
The solution is you need to export new procedure and call it before FreeLibrary:
uses
Data.DBXCommon
.....
procedure FinishDLLWork; stdcall; export;
begin
TDBXScheduler.Instance.Free;
end;
and call it just before FreeLibrary;
TDBXScheduler on freeining TDBXScheduler.Instance will auto set it to Nil so this call is fine(check TDBXScheduler.Destroy;)
Unfortunately it cannot be called in the DLL_THREAD_DETACH or DLL_PROCESS_DETACH - it is too late.
I am working on the application which has two listboxes.I load the two listboxes with values and when i keep on clicking the items from the list box i get the following error while debugging.
Running the exe causes the application to close.Sometimes i get the "Access Violation" message.
so what should I do to get rid of this error from my aaplication?
EDIT
..
The main form has timer that refresh all the controls
timer_RefreshCOntrol (intervali 1).
whenver the editBox_one is modified(value)
this function is called
Procedure TStringSetting.SetValue (const AValue : String);
Begin
...
If FValueControl <> Nil then
Begin
FValueControl.OnChange := VoidNotifyEvent;
FValueControl.Text := NewValue;
FValueControl.OnChange := EditChange; //<--here the stackoverflow error comes....
end;
end;
Procedure EditChange (Sender: TObject);
Begin
Value := FValueControl.Text;
If Not EditIsValid then FValueControl.Font.Color := clRed
else If Dirty then FValueControl.Font.Color := clBlue
else FValueControl.Font.Color := clWindowText;
If #OldCustomEditChange <> Nil then OldCustomEditChange(Sender);
end;`
the EditChange (Sender: TObject); <--keeps geting called and the stackoverflow error comes
EditChange is assigned to the editbox on FormCreate
EDIT2
I am not the original developer.I just handled code sometimes back, major refactoring is not possible.
edit 3
The call stack value but what is the "???"
EDIT 4
after going through #Cosmin Prund and #david
i got the place where the infinity call start
Procedure TFloatSetting.EditChange (Sender: TObject);
Begin
SkipNextOnChange := True;
Inherited EditChange(Sender);
IfValidThenStore(FValueControl.Text);
Inherited EditChange(Sender); {<-------This is where it start}
end;
Procedure TStringSetting.EditChange (Sender: TObject);
Begin
Value := FValueControl.Text;
If Not EditIsValid then FValueControl.Font.Color := clRed
else If Dirty then FValueControl.Font.Color := clBlue
else FValueControl.Font.Color := clWindowText;
If #OldCustomEditChange <> Nil then OldCustomEditChange(Sender); {<---this keeps calling Procedure TFloatSetting.EditChange (Sender: TObject);}
end;
Based in the posted call stack it's obvious why the error is happening: TStringSetting.EditChange triggers TFloatSetting.EditChange and that in turn triggers TStringSetting.EditChange. The loop goes on like this until all stack space is exhausted.
Here are some tips on why that might happen, and tips on how to debug and fix it:
Maybe the controls involved trigger the OnChange event handler when the Value is changed progrmatically. If the two editors are supposed to display the same data in two formats and you're using the respective OnChange event handlers to keep them in sync, this might be the cause.
Maybe you're directly calling one event handler from the other.
Ways to debug this:
You should first try the breakpoint solution, as suggested by paulsm4. If the stack overflow happens every time one of the OnChange handlers is called, this solution would easily work.
Comment-out the code for one of the event handlers. Run the program, the error should no longer appear. Un-comment the code in tiny (but logical) amounts, test and repeat. When the error shows up again, you know you fund the line that's causing the error. If you can't figure it out yourself, edit the question, add the code and mark the line that you just found out it's giving you trouble.
If the controls you're using are triggering the OnChange event handler when there value is changed programatically, you should make your event handlers non-reentrant: that would stop the infinite recursive loop for sure. I almost always assume controls trigger OnChange or equivalent events when properties are changed from code and always protect myself from re-entry using something like this:
// Somewhere in the private section of your form's class:
FProcessingEventHandler: Boolean;
// This goes in your event handler
procedure TYourForm.EventHandler(Sender:TObject);
begin
if FProcessingEventHandler then Exit; // makes code non-reentrant
FProcessingEventHandler := True;
try
// old code goes here ...
finally FProcessingEventHandler := False;
end;
end;
Suggestions:
Set a breakpoint in EditChange and OldCustomEditChange to see who's calling them. Each invocation. Clearly, only EditChange should ever call OldCustomEditChange.
Look in your .dfm to make sure EditChange is only assigned to one event (not multiple events) and OldCustomEditChange isn't assigned at all.
You report a non-terminating recursive call sequence to EditChange. Looking at the code of EditChange there are two candidates for a recursive call:
OldCustomEditChange being equal to EditChange, or calling a function that in turn calls EditChange.
An event handler that responds to changes to FValueControl.Font by calling EditChange.
These are the only opportunities for the code in EditChange to call itself.
It is easy to see how both of these possibilities leads to the non-terminating recursive function call and eventually the stack overflow. Of the two candidates my bet is number 1. I would study carefully what happens when OldCustomEditChange is called.
To debug a stack overflow of this nature simply open the call stack window and look at the long sequence of calls. You will typically see a pattern with one function calling itself, possibly via one or more intermediate functions.
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.