OpenOffice Desktop Instance can not be created (com object) - delphi

I have some problems to create an instance of the StarOffice Desktop object.
I used the standard construct below but whenever it comes to the line: StarDesktop := StarOffice.CreateInstance('com.sun.star.frame.Desktop');
My StarDesktop Variant stays unassigned. I am pretty sure that the code is ok until there but perhaps something with the OpenOffice installation is messed up.
Is there a way to check the com objects or did somebody had the same problem and could solve it...
uses
ComObj;
procedure OpenOfficeDocument;
var
StarOffice: Variant;
StarDesktop: Variant;
begin
StarOffice := CreateOleObject('com.sun.star.ServiceManager');
StarDesktop := StarOffice.CreateInstance('com.sun.star.frame.Desktop');
// StarDesktop is always "unassigned"
....
Yes, I know. I should have stated more clearly that I am too 100% sure that it would work normally in a correct environment.
But my question is what could be the cause why it doesn't work. Why the 'com.sun.star.frame.Desktop' instance is unassigned. I have no option/way to debug it...
And it is a bit unfair to vote me down, I researched for one hour without finding something to explain why it could not work.
Or how and where to check if something is wrong with the Office installation (I uninstalled and reinstalled it twice already"
Again, I know this will work for others and normally would work for me, but something is wrong at my system and I would like to know some help to point me in the direction what could be wrong in the system (and not in the code example...)

is OpenOffice installed on client?
doesn't throw any exception?
I'm using Bernard Marcelly's Delphi 7 OOo tool and as can you see his code like that;
var
OpenOffice, StarDesktop: Variant;
...
OpenOffice:= CreateOleObject('com.sun.star.ServiceManager');
if isNullEmpty(OpenOffice) then Raise Exception.Create('OpenOffice connection is impossible');
StarDesktop:= OpenOffice.createInstance('com.sun.star.frame.Desktop');
if isNullEmpty(Result) then Raise Exception.Create(Format('Impossible to create service : %s', ['com.sun.star.frame.Desktop']));
...
'some constants converted to string'
So, if StarDesktop is null, possible can not access Oo Desktop service. If OpenOffice installed properly some features may be missing, options have to set.

This works for me (in my application):
class procedure TOpenOffice.Connect;
begin
if IsConnected then
Exit;
try
FServiceManager := CreateOleObject('com.sun.star.ServiceManager');
except
FServiceManager := Null;
end;
if VarIsNull(FServiceManager) then
raise EOpenOfficeException.Create(StrConnectionFailed);
FDesktop := CreateService('com.sun.star.frame.Desktop');
FDispatchHelper := CreateService('com.sun.star.frame.DispatchHelper');
FIntrospection := CreateService('com.sun.star.beans.Introspection');
FReflection := CreateService('com.sun.star.reflection.CoreReflection');
end;
and:
class function TOpenOffice.CreateService(const ServiceName: string): Variant;
begin
Result := FServiceManager.createInstance(ServiceName);
if VarIsNull(Result) then
raise EOpenOfficeException.CreateFmt(StrCouldNotCreateService,
[ServiceName]);
end;

Related

Delphi - mORMot Can not access data through client using full memory model and TSQLRestClientURI

I've been trying to start a new project using mORMOt the DDD-way and have created a few classes and begun to test one of them in an easy/simple way.
I used the regression test code from your DDD-sample about TUser and modified it to suit my class .
I have tried to minimize the code and hopefully, it could contain some clues for you to help me understand what's wrong here.
I found that when only using the server, everything works ok but when using client the ORMselection won't find the data.
I stripped down the code as much as possible and marked with some comments where it works and where it not works.
class procedure TInfraRepoPackageFactory.RegressionTestsPackage(test: TSynTestCase);
procedure TestOne(Rest: TSQLRest);
var cmd: IDomPackageCommand;
qry: IDomPackageQuery;
package: TPackage;
begin
test.Check(Rest.Services.Resolve(IDomPackageCommand,cmd));
package := TPackage.Create;
try
package.articleNo := 10000;
test.check(cmd.Add(package)=cqrsSuccess);
end;
test.check(cmd.Commit=cqrsSuccess);
finally
package.Free;
end;
package := TPackage.Create;
try
test.Check(Rest.Services.Resolve(IDompackageQuery,qry));
test.Check(qry.SelectByArticleNo(10000,false)=cqrsSuccess); // <<-- Debugging shows that it will not find anything when using client.
test.Check(qry.GetCount=1); // <<-- getCount returns zero when using client.
end;
finally
package.Free;
end;
end;
var RestServer: TSQLRestServerFullMemory;
RestClient: TSQLRestClientURI;
begin
RestServer := TSQLRestServerFullMemory.CreateWithOwnModel([TSQLRecordPackage]);
try // first try directly on server side
RestServer.ServiceContainer.InjectResolver([TInfraRepoPackageFactory.Create(RestServer)],true);
TestOne(RestServer); // sub function will ensure that all I*Command are released // <<=== Works
finally
RestServer.Free;
end;
RestServer := TSQLRestServerFullMemory.CreateWithOwnModel([TSQLRecordPackage]);
try // then try from a client-server process
RestServer.ServiceContainer.InjectResolver([TInfraRepoPackageFactory.Create(RestServer)],true);
RestServer.ServiceDefine(TInfraRepoPackage,[IDomPackageCommand,IDomPackageQuery],sicClientDriven);
test.Check(RestServer.ExportServer);
RestClient := TSQLRestClientURIDll.Create(TSQLModel.Create([TSQLRecordPackage]),#URIRequest);
try
RestClient.Model.Owner := RestClient;
RestClient.ServiceDefine([IDomPackageCommand],sicClientDriven);
TestOne(RestServer); // <<=== Works
RestServer.DropDatabase;
USEFASTMM4ALLOC := true; // for slightly faster process
TestOne(RestClient); // <<=== DO NOT Work !!!!
finally
RestClient.Free;
end;
finally
RestServer.Free;
end;
end;
I also tried to put this question on the mORMot forum but the mailer can not reach the site.
Got this message :
An error was encountered
Error: Unable to send email. Please contact the forum administrator with the following error message reported by the SMTP server: "450 4.1.2: Recipient address rejected: Domain not found ".
I finally found what's wrong.
In the agregate, class TPackage, I had set the property of packageNo to "stored AS_UNIQUE" - that resulted in that the commit just stored zero in that field and then the SELECT('packageNo=?,[10001]) couldn't find anything.
I didn't realize that because the package object contained just 10001 and could never think of the possibility that the commit should store a 0.
But when I tested with TSQLHttpServer and TSQLHttpClient and a real database I could see all records containing zeroes in the packageNo field.
Then I understood that it must be something with this field that's wrong. When I looked up TPackage I found my mistake.
I should have set the "STORED AS_UNIQUE" in the TSQLRecordPackage class instead, the one that's used by ORM.
The moral of the story... "OPEN YOUR EYES.. and you will see" ;-)

How to get errors of the file using OTA?

I'd like to access the errors on the active file (.pas).
Now a days I can find it on the left side of the IDE, as you can see on image.
I found on OTA the interface IOTAModuleErrors, that seems to be what I want. But I didn't found it on BorlandIDEServices.QueryInterface or BorlandIDEServices.GetService. Someone knows how to access it ?
I found it!
It was much simpler than I thought, it's just a matter of casting the IOTAModule on the module to IOTAModuleErrors.
If you want a practical example you can check this project
I use on the unit Source/FindUnit.OTAUtils.pas, on function GetErrorListFromActiveModule.
Sample:
function GetErrorsListFromActiveModule: TOTAErrors;
var
ModuleServices: IOTAModuleServices;
ModuleErrors: IOTAModuleErrors;
begin
ModuleServices := BorlandIDEServices as IOTAModuleServices;
Assert(Assigned(ModuleServices));
ModuleErrors := ModuleServices.CurrentModule as IOTAModuleErrors;
Result := ModuleErrors.GetErrors(ModuleServices.CurrentModule.FileName);
end;
Thank you

Delphi: SetFileDate creates wrong LastWriteTime (Summer/Wintertime)

i am downloading a file from my server (i only get the bytes and a DateTime for the lastwritetime attribute) and after downloading the data i create a new file on my local machine and want to set the lastwritetime attribute.
For this i am using the following method:
procedure SetFileDate(const FileName: string; NewDate: TDateTime);
var
FileDate, FileHandle: Integer;
begin
try
FileDate := DateTimeToFileDate(NewDate);
FileHandle := FileOpen(FileName, fmOpenReadWrite or fmShareDenyWrite);
if FileHandle > 0 then
begin
FileSetDate(FileHandle, FileDate);
FileClose(FileHandle);
end;
except
begin
// ERROR Log
err.Msg('FileReqThrd.SetFileDate');
end;
end;
end;
For the 'NewDate' parameter i use the DateTime which i get from my server.
I tried to convert the DateTime from the server like this to get the valid lastwritetime (i am requesting the data from a WCF this is why i am converting it to UTCDateTime, the untouched data from the WCF service is TXSDateTime):
TDateTime cloudFileDateTime := StrToDateTime(DateTimeToStr(cloudDownloadResult.FileCloudData.Lastwritetime.AsUTCDateTime));
But in the end my lastwritetime attribute from files which have a lastwritetime in the wintertime period are wrong with -1h.
I hope you understand my problem and can give me an idea how to solve it.
Best regards
The easiest way to do this is to call TFile.SetLastWriteTimeUtc from the System.IOUtils unit.
TFile.SetLastWriteTimeUtc(FileName,
DateTimeUtc);
If this function is not available use the Win32 API function SetFileTime.
You'll also need DateTimeToSystemTime and then SystemTimeToFileTime in that scenario.
The answer provided by David (to use TFile.SetLastWriteTimeUtc) is correct. However, there was some discussion in the comments about bugs. As I am unable to comment (due to lack of rep), I'll add this here for anyone who comes across this problem in future.
While TFile.SetLastWriteTimeUtc works correctly, TFile.GetLastWriteTimeUtc does indeed have a bug relating to daylight saving time. There is a bug report filed with Embarcadero, and it looks like they've now fixed it in Delphi 10.3 Rio (though I haven't tried it yet).
If you are working with an older version of Delphi, you will have to work around the problem via use of the Windows API. e.g. GetFileAttributesEx:
function GetFileModTimeUtc(filePath: string): TDateTime;
var data: TWin32FindData;
var sysTime: TSystemTime;
begin
if GetFileAttributesEx(PChar(filePath), GetFileExInfoStandard, #data) and
FileTimeToSystemTime(data.ftLastWriteTime, sysTime) then begin
Result := SystemTimeToDateTime(sysTime);
end else begin
raise Exception.Create('Unable to get last file write time for ' + filePath);
end;
end;

Is globalalloc with GMEM_MOVEABLE dangerous for local variables in Delphi?

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.

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