DELPHI: "Invalid property element: System" - delphi

I am consuming a WSDL and when I try to execute one of the methods i am getting the error
.. raised exception class EPropertyConvertError with message 'Invalid
property element: System'
Any ideas what causes this?
Here is the code I am running (cEPS_* are constants defined earlier in the code):
procedure TForm1.Button1Click(Sender: TObject);
var
Headers : ISOAPHeaders;
aResult: c_ExpressPSAPI.Response;
begin
try
FEPS_SoapService := c_ExpressPSAPI.GetExpressSoap();
FEPS_Headers := (FEPS_SoapService as ISOAPHeaders);
FEPS_Application := c_ExpressPSAPI.Application.Create();
FEPS_Application.ApplicationID := cEPS_ApplicationID;
FEPS_Application.ApplicationName := cEPS_ApplicationName;
FEPS_Credentials := c_ExpressPSAPI.Credentials.Create();
FEPS_Credentials.AccountID := cEPS_AccountID;
FEPS_Credentials.AccountToken := cEPS_AccountToken;
FEPS_Credentials.AcceptorID := cEPS_AcceptorID;
FEPS_Credentials.NewAccountToken := '';
aResult := c_ExpressPSAPI.Response.Create;
aResult := FEPS_SoapService.HealthCheck(FEPS_Credentials, FEPS_Application);
except
on E : ERemotableException do
ShowMessage(E.ClassName + ' error raised, with message : ' + E.FaultDetail + ' :: '
+ E.Message);
end;
end;
And here is the WSDL code:
ExpressSoap = interface(IInvokable)
['{83D77575-DBDE-3A05-D048-60B2F6BCDFE6}']
function HealthCheck(const credentials: Credentials; const application: Application): Response; stdcall;

Related

Delphi: How to catch TStreamWriter Disk full error?

I wonder, why this code does not catch a 'Disk Full' error like it should?
This is important because the user may lose their data if they do not notice that the saving failed.
I don't get this...
procedure TForm2.Button1Click(Sender: TObject);
var
Writer: TStreamWriter;
n : integer;
begin
Writer := TStreamWriter.Create('MyUTF8Text.txt', false, TEncoding.UTF8);
Try //Finally
Try //Except
for n := 1 to 1000 do
begin
Writer.WriteLine('Testing text writing to the UTF-8 file.');
end;
Except
on E: Exception do
begin
ShowMessage('Exception Class name: ' + E.ClassName);
ShowMessage('Exception Message: ' + E.Message);
end;
end; // except
Finally
Writer.Free();
End; //finally
end;
"BTW. 'Writer might not be initialized' warning, is it serious really?"
Edit: There was this warning because TStreamWriter.Create was after TRY.
Thanks for your advice I corrected that line of code to the correct location before(!) the TRY.
Try This:
procedure WriteStream;
var
Writer: TStreamWriter;
fs: TFileStream;
s: String;
n, bytesWritten : integer;
begin
bytesWritten := 0;
fs := TFileStream.Create('MyUTF8Text.txt', fmCreate);
try
//avoid warning by initiaizing before try
Writer := TStreamWriter.Create(fs);
try //Finally
try //Except
for n := 1 to 10 do
begin
s := 'Testing text writing to the UTF-8 file.' + '#13#10';
//keep count of bytes written
bytesWritten := bytesWritten + TEncoding.UTF8.GetByteCount(s);
Writer.Write(s);
end;
Writer.Flush;
Writer.Close;
//Check stream size to make sure all bytes written
if bytesWritten <> Writer.BaseStream.Size then
raise Exception.Create(String.Format('Expected %d bytes, wrote %d', [Writer.BaseStream.Size, bytesWritten]));
except
on E: Exception do
begin
Showmessage('Exception Class name: ' + E.ClassName);
Showmessage('Exception Message: ' + E.Message);
end;
end; // except
finally
Writer.Free; // Will only free if it has been constructed
end; //finally
finally
fs.Free;
end;
end;

Is there a way I can send a TFileStream with a httprequest.post method and extract it somehow in my webbroker?

I am trying to allow clients to upload pdf/xls and jpg files to my webbroker server I have running. I think I am sending the correct content but I have no clue on how to extract the received data. I can't find an appropiate method to allow me to do this. I am using the provied Delphi httprequest.post method to connect to the server's back-end.
Below a code snippet:
Client
try
NetHTTPClient.ContentType := 'application/pdf';
//NetHTTPRequest.ResponseTimeout := 600000;
tmpPDFFile := TFileStream.Create(pFilename, fmOpenRead);
//tmpPDFFile.Position:=0;
GetDossierIDAndDagboek;
tmpURL := MyURL + 'uploadAnyFile' + '?key=' + MyAPIKey + '&CLID=' + MyCLID + '&DOSID=' + tmpDOSID + '&JOURNAL=' + tmpDagboek + '&FILETYPE=' + pFileExstension;
NetHTTPRequest.ContentStream := tmpPDFFile;
NetHTTPRequest.Post(tmpURL,tmpPDFFile);
if HTTPLastStatusCode = 500 then begin
WriteToLog('Er ging iets mis bij het verwerken van document ' + pFilename);
end;
if HTTPLastStatusCode = 200 then begin
DeleteFile(pFilename);
end;
except
on e : exception do begin
WriteToLog(e.Message);
end;
end;
Server
procedure TWebModule1.WebModule1UploadAnyFileAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
tmpJournal, tmpFileType : string;
tmpCLID, tmpDOSID : integer;
tmpStream : TFileStream;
tmpStr:string;
tmpX:integer;
begin
try
Handled := true;
Response.StatusCode := 200;
tmpCLID := StrToInt(Request.QueryFields.Values['CLID']);
tmpDOSID := StrToInt(Request.QueryFields.Values['DOSID']);
tmpJournal := Request.QueryFields.Values['JOURNAL'];
tmpFileType := Request.QueryFields.Values['FILETYPE'];
CodeSite.Send('bestand opgeslagen');
request.Files.Count;
tmpStream := Response.ContentStream;
// TmpStream := request.ReadString;
if tmpFileType = 'pdf' then begin
//tmpStr.SaveToFile('c:\temp\test.pdf');
end;
if (tmpFileType = 'jpeg') OR (tmpFileType = 'jpg') then begin
end;
if (tmpFileType = 'xlsx') OR (tmpFileType = 'xls') then begin
end;
except
on e : exception do begin
end;
end;
end;

How to log in DUnitX?

Using Rad Studio 10 Seattle, DUnitX and TestInsight, I would need to show some texts in the console or any log screen. How can it be done? I have not been able to find it in the web.
procedure CreateRunner;
var fn : TFileName;
begin
runner := TDUnitX.CreateRunner;
runner.UseRTTI := True;
fn := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'dUnitX.Log';
ConsoleLogger := TDUnitXConsoleLogger.Create(false);
TextFileLogger:= TDUnitXTextFileLogger.Create(fn);
nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile);
runner.AddLogger(ConsoleLogger );
runner.AddLogger(TextFileLogger);
runner.AddLogger(nunitLogger);
end;
Here's how to add log messages, fragments copied from https://github.com/VSoftTechnologies/DUnitX/blob/d5861ce0de6a9fbfdc8c158b0b1c8614082c188d/Examples/DUnitX.Examples.General.pas
[TestFixture('ExampleFixture1','General Example Tests')]
TMyExampleTests = class
public
[Test]
procedure LogMessageTypes;
end;
procedure TMyExampleTests.LogMessageTypes;
begin
TDUnitX.CurrentRunner.Log(TLogLevel.Information, 'Information');
TDUnitX.CurrentRunner.Log(TLogLevel.Warning, 'Warning');
TDUnitX.CurrentRunner.Log(TLogLevel.Error, 'Error');
end;
If you want to have a less convoluted syntax, you can always add an interposer for the Assert class like so
Assert = class(DUnitX.Assert.Assert) //Or (DunitX.Assert.Ex.Assert)
public
class procedure Log(const message: string);
end;
class procedure Assert.Log(const message: string);
begin
TDUnitX.CurrentRunner.Log(TLogLevel.Information, message);
end;
https://github.com/jsf3rd/DUnitX.git/trunk/Examples
var
runner : ITestRunner;
logger : ITestLogger;
begin
try
//Create the runner
runner := TDUnitX.CreateRunner;
runner.UseRTTI := True;
//tell the runner how we will log things
if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then
begin
logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet);
runner.AddLogger(logger);
end;
//Run tests
results := runner.Execute;
System.Write('Done.. press <Enter> key to quit.');
System.Readln;
except
on E: Exception do
System.Writeln(E.ClassName, ': ', E.Message);
end;

Free Mailitem in Delphi

I have a Mailitem and make a reply for that.
Now I register an OnSend EventHandler and display the Item with modal FALSE.
Everything works as desired.
My Problem is that I don't know how to free the MailItem.
If I display the Item modal I can free it in the finally block at the end of the function,
but if I display the Item non-modal, my eventhanlder (AOnSend) clearly will never be called, cause the mailitem with the registered handler is thrown away.
But to simply not call MailItem.Free will produce a Mem-Leak, so my Question: How to correctly free this MailItem?
function InternalReply(AFolder, AMailID, ASender, ACC: String; AWithoutTo: TList<String>; AModal: Boolean; AOnSend: TMailItemSend; var AErrorText: String; AReplyAll: Boolean = FALSE): Boolean; overload;
var AOutlookApplication: TOutlookApplication;
ANewInstance: Boolean;
AMAPIFolder: MAPIFolder;
AMailItem: MailItem;
AMail: TMailItem;
begin
AErrorText := '';
AOutlookApplication := Nil;
AMailItem := Nil;
AMail := TMailItem.Create(Nil);
try
try
Result := OpenOutlookInstance(AOutlookApplication, ANewInstance, AErrorText);
if Result then begin
AMAPIFolder := IntGetFolderByName(AOutlookApplication, UpperCase(AFolder), AErrorText);
if Assigned(AMAPIFolder) then begin
Result := IntGetMailFromMAPIFolderByID(AOutlookApplication, AMAPIFolder, AMailID, AMailItem, AErrorText);
if Result and Assigned(AMailItem) then begin
AMailItem := AMailItem.ReplyAll;
if Assigned(AOnSend) then begin
AMail.ConnectTo(AMailItem);
AMail.OnSend := AOnSend;
end;
if Assigned(AMailItem) then begin
...
AMailItem.Display(AModal);
end
else begin
Result := TRUE;
end;
end
else begin
Result := FALSE;
AErrorText := AErrorText + ' Mail not found! MailID: ' + AMailID;
end;
end
else begin
Result := FALSE;
AErrorText := AErrorText + ' Folder not found! Name: ' + AFolder;
end;
CloseOutlookInstance(AOutlookApplication, ANewInstance, AErrorText);
end;
except
on E: Exception do begin
Result := FALSE;
AErrorText := AErrorText + ' ' + 'Reply: Internal Error! Message: ' + E.Message;
end;
end;
finally
AMail.Free // IF I DO THIS THEN I LOSE MY HANDLER
end;
end;
You can use a global object container for this purpose: TObjectList.
When you create a new mail, add it to the container.
In the OnSend eventhandler, you can remove the mail from the container.
If you work like this, you can have multiple mails open at the same time:
uses
Contnrs,
...
var
Mails : TObjectList;
...
// create the container at application startup
// do not forget to free the container at application termination
Mails := TObjectList.Create;
...
// create mail
function InternalReply()
...
if Assigned(AOnSend) then begin
AMail.ConnectTo(AMailItem);
AMail.OnSend := AOnSend;
// add it to the container
Mails.Add(AMail);
end;
...
end;
// in your OnSend handler, remove mail from the list
// this will automatically free the mail
procedure AOnSend(Sender: TObject; var Cancel: WordBool);
begin
...
Mails.Remove(Sender); // sender is our Mail object
end;

Coinitialize has not been called error message

I am in the process of coding a console application that will create a firewall exception for my main app called Client.exe which uploads a few documents to our servers via FTP. I borrowed RRUZ code from Delphi 7 Windows Vista/7 Firewall Exception Network Locations my code looks like this:
program ChangeFW;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
ComObj;
var
ExecName: string;
procedure AddExceptionToFirewall(Const Caption, Executable: String);
const
NET_FW_PROFILE2_DOMAIN = 1;
NET_FW_PROFILE2_PRIVATE = 2;
NET_FW_PROFILE2_PUBLIC = 4;
NET_FW_IP_PROTOCOL_TCP = 6;
NET_FW_ACTION_ALLOW = 1;
var
fwPolicy2 : OleVariant;
RulesObject : OleVariant;
Profile : Integer;
NewRule : OleVariant;
begin
Profile := NET_FW_PROFILE2_PRIVATE OR NET_FW_PROFILE2_PUBLIC;
fwPolicy2 := CreateOleObject('HNetCfg.FwPolicy2');
RulesObject := fwPolicy2.Rules;
NewRule := CreateOleObject('HNetCfg.FWRule');
NewRule.Name := Caption;
NewRule.Description := Caption;
NewRule.Applicationname := Executable;
NewRule.Protocol := NET_FW_IP_PROTOCOL_TCP;
NewRule.Enabled := TRUE;
NewRule.Profiles := Profile;
NewRule.Action := NET_FW_ACTION_ALLOW;
RulesObject.Add(NewRule);
end;
begin
try
{ TODO -oUser -cConsole Main : Insert code here }
ExecName := GetCurrentDir + '\' + 'Client.exe';
AddExceptionToFirewall('SIP Inventory',ExecName);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
When I execute the application I get the following error message:
EOIeSysError: Coinitialize has not been called, ProgID: “HNetCfg.FwPolicy2”
Any idea what I am doing wrong? Could you please point me in the right direction? Thank you so very much.
If you want to use COM - objects you will have to call CoInitialize with corresponding CoUninitialize.
In a usual application this will be already done.
As far as your program is a console program you will have to call it on your own.
.....
CoInitialize(nil);
try
try
{ TODO -oUser -cConsole Main : Insert code here }
ExecName := GetCurrentDir + '\' + 'Client.exe';
AddExceptionToFirewall('SIP Inventory',ExecName);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
finally
CoUninitialize;
end;
.....

Resources