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.
Related
Does anyon know how to create word ole object in DLL.
I have one application that load a DLL which in turn create word ole object.
My application crash every time.
MSWord:= CreateOleObject('Word.Application');
Assuming that Word is installed, then the primary reason why you code might fail is that COM has not been initialized in the calling thread. That is not something that should be attempted from the DLL, because you want the DLL to be able to work with consumers that have already initialized COM.
So, the correct way to tackle this is to state as part of the DLL's interface contract that COM must be initialized by the caller. Typically by calling CoInitialize or CoInitializeEx.
One further comment, is that it if the application crashes, that suggests that you error handling is broken. All the functions in your DLL should take steps to catch any exceptions and convert into error codes to be returned to the caller. I suspect that you have not done this and are throwing a Delphi exception out of the DLL. You must never do that.
Note that I have given a broad and general answer. That matches the broad nature of the question, and the fact that there are few details in the question. If you had provided an MCVE we could have offered a more detailed response.
As DavidH points out, CoInitialize has to be called in the calling thread.
A point to watch out for in connection with the main thread of a VCL application is that whether a VCL application calls CoInitialize automatically depends on whether it uses the ComObj unit: if it does the CoInitialize is called via TApplication.Initialize and the InitComObj routine in ComObj; if it does not, you must call it (or CoInitializeEx) yourself.
The easy way to test this is to call the DLL from a TApplication-less console application - this will avoid being misled by ComObj being used some other than your main unit.
Suppose you have a DLL that contains the following exported procedure:
procedure CreateWordDoc;
var
DocText : String;
MSWord,
Document : OleVariant;
begin
MSWord := CreateOleObject('Word.Application');
MSWord.Visible := True;
Document := MSWord.Documents.Add;
DocText := 'Hello Word!';
MSWord.Selection.TypeText(DocText);
end;
then you could call it like this:
program WordCaller;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows, ActiveX;
type
TWordProc = procedure;
var
LibHandle : THandle;
WordProc : TWordProc;
begin
CoInitialize(Nil);
LibHandle := LoadLibrary('WordDll.Dll');
try
if LibHandle <> 0 then begin
try
WordProc := GetProcAddress(LibHandle, 'CreateWordDoc');
if Assigned(WordProc) then
WordProc;
finally
FreeLibrary(LibHandle);
end;
end;
finally
CoUnInitialize;
Readln;
end;
end.
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'm writing an app I'd like to be backwardly compatible to some extent on XP, or at the very least windows vista.
EDIT FOR CLARITY: I need to be able to do what the first code snippet below does, but in XP. "Does anybody know the best approach to take under XP, given the functions aren't available in USER32.DLL.?"
My initial prototype code on windows 7 just called CreateProcess to start up displayswitch.exe, which is deployed with windows 7.
if you are not familiar with it, it's a handy little utility that is what gets invoked when you press the windows key and the letter P. you can read more about it here.
while this was adequate, i subsequently needed to sense the current state (eg internal vs external or extend vs clone), so i have now coded up a winapi solution that works well on windows 7 (and i presume 8). it involves making calls to SetDisplayConfig and QueryDisplayConfig in User32.DLL
The pertinent section of it is here (minus the many, many structures i had to hand craft in pascal code from the original klingon).
function getTopology : DISPLAYCONFIG_TOPOLOGY_ID ;
var NumPathArrayElements,
NumModeInfoArrayElements : UINT32;
var PathArrayElements_Size,
ModeInfoArrayElements_Size : UINT32;
error : Longint;
paths : PDISPLAYCONFIG_PATH_INFO_array;
info : PDISPLAYCONFIG_MODE_INFO_array;
begin
NumModeInfoArrayElements := 0;
Result := DISPLAYCONFIG_TOPOLOGY_EXTERNAL;
inc(result);
error := GetDisplayConfigBufferSizes(QDC_DATABASE_CURRENT,NumPathArrayElements,NumModeInfoArrayElements);
case error of
ERROR_SUCCESS :
begin
PathArrayElements_Size := sizeof(DISPLAYCONFIG_PATH_INFO) * NumPathArrayElements ;
ModeInfoArrayElements_Size := sizeof(DISPLAYCONFIG_MODE_INFO) * NumModeInfoArrayElements;
GetMem(paths,PathArrayElements_Size);
try
GetMem(info,ModeInfoArrayElements_Size );
try
error := QueryDisplayConfig(QDC_DATABASE_CURRENT,NumPathArrayElements, paths,NumModeInfoArrayElements, info,result);
case error of
ERROR_SUCCESS :;
else
Result := DISPLAYCONFIG_TOPOLOGY_EXTERNAL;
inc(result);
end;
finally
FreeMem(info,ModeInfoArrayElements_Size );
end;
finally
FreeMem(paths,PathArrayElements_Size);
end;
end;
end;
end;
function setTopology ( top : DISPLAYCONFIG_TOPOLOGY_ID) : boolean;
var flags : dword;
begin
result := false;
flags := DecodeDISPLAYCONFIG_TOPOLOGY_ID_SDC(top);
if flags <> 0 then
begin
result := SetDisplayConfig(0,nil,0,nil,SDC_APPLY or flags) = ERROR_SUCCESS;
end;
end;
Since these functions don't exist in XP (as far as I know), I am looking for a stable way of achieving a similar thing in XP. whilst i am coding in Delphi, it's not necessary that the solution be presented as such. i am quite happy to just look at how it's done, or read a description of the appropriate steps, and implement it myself.
(removed full listing as it was confusing the issue as it did not appear like a question)
Been trying to use the following code in order to check if Windows Aero is enabled:
function AeroEnabled: boolean;
var
enabled: bool;
begin
// Function from the JwaDwmapi unit (JEDI Windows Api Library)
DwmIsCompositionEnabled(enabled);
Result := enabled;
end;
...
if (CheckWin32Version(5,4)) and (AeroEnabled) then
CampaignTabs.ColorBackground := clBlack
else begin
GlassFrame.Enabled := False;
CampaignTabs.ColorBackground := clWhite;
end;
However, doing so on a pre-vista machine causes the app to crash because the DWMApi.dll is missing. I've also tried this code however it produces 2 AV's in a row. How can I do this ? I am using Delphi 2010. :)
You've got your versions wrong. Vista/2008 server are version 6.0. Your test should be:
CheckWin32Version(6,0)
I believe that you are using Delphi 2010 or later in which case you should simply call the DwmCompositionEnabled function from the built-in Dwmapi unit. This organises the version check and the delayed binding for you. No need for JEDI.
Edit: Text below was written before the question was edited.
Probably the easiest approach is to check the Windows version. You need Win32MajorVersion>=6 (i.e. Vista or 2008 server) in order to call DwmIsCompositionEnabled.
If you were binding yourself then you would call LoadLibrary with DWMApi.dll and if that succeeded you would then call GetProcAddress to bind. If that succeeded you are good. But, as I said, since you aren't handling the binding yourself then a version check is probably the simplest.
So the function would be:
function AeroEnabled: boolean;
var
enabled: bool;
begin
if Win32MajorVersion>=6 then begin
DwmIsCompositionEnabled(enabled);
Result := enabled;
end else begin
Result := False;
end;
end;
Note, I'm assuming that your library is doing late binding, i.e. explicit linking. If not then you'll need LoadLibrary/GetProcAddress, exactly as is done in #RRUZ's code to which you link.
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.