I'm struggling with application "client side" to communicate with service.
Requirement for that type of communication is to use XML Soap Envelope.
I'm trying to use TFPHTTPClient for that. I prepare Form to see response from serwer but something is missing.
When I send a request I receive error "Stream read error"
On Form I put Button and Memo1 for displaing XML code and Memo2 for answear.
Interesting is when I copy code from memo1 and paste into SoapUI everything is OK
My code is:
procedure TForm1.Button2Click(Sender: TObject);
var
FPHTTPClient: TFPHTTPClient;
SL: TStringList;
Str: String;
begin
FPHTTPClient := TFPHTTPClient.Create(nil);
try
FPHTTPClient.AllowRedirect := True;
FPHTTPClient.KeepConnection:=True;
FPHTTPClient.AddHeader('Content-Type','application/soap+xml;charset=utf-8');
FPHTTPClient.AddHeader('User-Agent','Apache-HttpClient/4.5.5 (Java/16.0.1)');
SL := TStringList.Create;
try
SL.Add('<soap:Envelope xmlns:soap="http://www.w3.org/2003/05/soap-envelope" xmlns:ns="http://CIS/BIR/PUBL/2014/07"> ');
SL.Add('<soap:Header xmlns:wsa="http://www.w3.org/2005/08/addressing">');
SL.Add('<wsa:To>https://wyszukiwarkaregontest.stat.gov.pl/wsBIR/UslugaBIRzewnPubl.svc</wsa:To>');
SL.Add('<wsa:Action>http://CIS/BIR/PUBL/2014/07/IUslugaBIRzewnPubl/Zaloguj</wsa:Action>');
SL.Add('</soap:Header>');
SL.Add('<soap:Body>');
SL.Add('<ns:Zaloguj>');
SL.Add('<ns:pKluczUzytkownika>abcde12345abcde12345</ns:pKluczUzytkownika>');
SL.Add('</ns:Zaloguj>');
SL.Add('</soap:Body>');
SL.Add('</soap:Envelope>');
Memo1.Lines.BeginUpdate;
Memo1.Lines := SL;
Memo1.Lines.EndUpdate;
try
Str:=FPHTTPClient.FormPost('https://wyszukiwarkaregontest.stat.gov.pl/wsBIR/UslugaBIRzewnPubl.svc',SL);
//ShowMessage(Str);
Memo2.text := Str;
except
on E: exception do
ShowMessage(E.Message);
end;
finally
SL.Free;
end;
finally
FPHTTPClient.Free;
end;
end;
Related
A while ago I wrote a method in Delphi 2010 to get the OAuth2 token using the Indy components (TidHttp). See code below.
I am now doing something new in Delphi 10.4 and would like to use the REST components such as RESTClient, RESTRequest, TOAuth2Authenticator, etc.
Our grant type is Client Credentials but in none of the examples on the net could I find on how to use TOAuth2Authenticator with Client Credentials. Is it even possible?
We have a client id, client secret and token URL. We do not have authorization or redirect endpoints. In Insomnia, the setup will look like this:
Does somebody know how to get the token using TOAuth2Authenticator with grant type = client_credentials?
Here is the Delphi 2010 code:
procedure TfrmToken.btnGetTokenClick(Sender: TObject);
var
IdHTTP: TidHttp;
lsHttpError: string;
loRequest: TStringStream;
loRespJson: TMemoryStream;
liSuper: iSuperObject;
ldtExpiry: TDateTime;
begin
IdHTTP := TIdHTTP.Create();
loRespJson := TMemoryStream.Create();
try
IdHTTP.HandleRedirects := False;
loRequest := TStringStream.Create('grant_type=client_credentials&client_id=' +
edtKey.Text + '&client_secret='+edtSecret.Text);
try
IdHttp.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(IdHttp);
IdHttp.Request.ContentType := 'application/x-www-form-urlencoded';
try
IdHTTP.Post(edtURL.Text, loRequest, loRespJson);
except
on E: EIdHTTPProtocolException do
begin
lsHttpError := E.ErrorMessage;
end;
on E: Exception do
begin
lsHttpError := E.Message;
end;
end;
if idHTTP.ResponseCode = 200 then
begin
liSuper := SO(StreamToString(loRespJSon));
edtToken.Text := liSuper.S['access_token'];
ldtExpiry := IncSecond(Now, liSuper.i['expires_in']);
edtExpiry.Text := 'Expires in ' + liSuper.S['expires_in'] +
' seconds. Time: ' +
FormatDateTime('yyyy/dd/mm hh:nn:ss', ldtExpiry);
end
else
begin
liSuper := SO(lsHttpError);
edtToken.Text := IdHTTP.ResponseText;
edtExpiry.Text := '';
end;
finally
FreeAndNil(loRequest);
end;
finally
FreeAndNil(IdHTTP);
FreeAndNil(loRespJson);
end;
end;
All,
I am working on a new datasnap project based on the example project located in C:\Users\Public\Documents\Embarcadero\Studio\18.0\Samples\Object Pascal\DataSnap\FireDAC_DBX.
I am trying to transfer a large stream (1,606,408 bytes) from datasnap server to client. I am running into what appears to be a common issue and that is that the entire stream does not make it to the client.
Here is my server code:
//Returns Customer Info
function TServerMethods.GetBPInfo(CardCode : String): TStringStream;
begin
Result := TStringStream.Create;
try
qBPInfo.Close;
if CardCode.Trim = '' then
qBPInfo.ParamByName('ParmCardCode').AsString := '%%'
else
qBPInfo.ParamByName('ParmCardCode').AsString := '%' + CardCode + '%';
qBPInfo.Open;
FDSchemaAdapterBPInfo.SaveToStream(Result, TFDStorageFormat.sfBinary);
Result.Position := 0;
// Result.SaveToFile('output.adb');
except
raise;
end;
end;
Here is my client code:
procedure TdmDataSnap.GetBPInfo(CardCode : String);
var
LStringStream : TStringStream;
begin
dmDataSnap.FDStoredProcBPInfo.ParamByName('CardCode').AsString := CardCode;
FDStoredProcBPInfo.ExecProc;
LStringStream := TStringStream.Create(FDStoredProcBPInfo.ParamByName('ReturnValue').asBlob);
//LStringStream.Clear;
//LStringStream.LoadFromFile('Output.adb');
try
if LStringStream <> nil then
begin
LStringStream.Position := 0;
try
DataModuleFDClient.FDSchemaAdapterBP.LoadFromStream(LStringStream, TFDStorageFormat.sfBinary);
except
on E : Exception do
showmessage(e.Message);
end;
end;
finally
LStringStream.Free;
end;
end;
You will see the stream save and load code; that is how I determined that the server was getting the entire result set into the stream, and that the client could handle the entire result set and display it properly.
So smaller streams transfer just fine, but this big one, when examined in the ide debugger, does not start with the 65,66,68,83 characters and the load fails with the error, '[FireDAC][Stan]-710. Invalid binary storage format'.
I know from extended Googling that there are work-arounds for this, but I do not understand how to apply the workarounds to my case, with the use of Tfdstoredproc and TfdSchemaAdaptor components. I'm trying to stay with this coding scheme.
How do I adapt this code to correctly receive large streams?
Update 1:
Ok, I tried strings and Base64 encoding. It didn't work.
Client Code:
procedure TdmDataSnap.GetBPInfo(CardCode : String);
var
LStringStream : TStringStream;
TempStream : TStringStream;
begin
dmDataSnap.FDStoredProcBPInfo.ParamByName('CardCode').AsString := CardCode;
FDStoredProcBPInfo.ExecProc;
try
TempStream := TStringStream.Create;
TIdDecoderMIME.DecodeStream(FDStoredProcBPInfo.ParamByName('ReturnValue').asString,TempStream);
if TempStream <> nil then
begin
TempStream.Position := 0;
try
DataModuleFDClient.FDSchemaAdapterBP.LoadFromStream(TempStream, TFDStorageFormat.sfBinary);
except
on E : Exception do
showmessage(e.Message);
end;
end;
finally
TempStream.Free;
end;
end;
Here is my server code:
//Returns Customer Info
function TServerMethods.GetBPInfo(CardCode : String): String;
var
TempStream : TMemoryStream;
OutputStr : String;
begin
Result := '';
TempStream := TMemoryStream.Create;
try
try
qBPInfo.Close;
if CardCode.Trim = '' then
qBPInfo.ParamByName('ParmCardCode').AsString := '%%'
else
qBPInfo.ParamByName('ParmCardCode').AsString := '%' + CardCode + '%';
qBPInfo.Open;
FDSchemaAdapterBPInfo.SaveToStream(TempStream, TFDStorageFormat.sfBinary);
TempStream.Position := 0;
OutputStr := IdEncoderMIMEBPInfo.EncodeStream(TempStream);
Result := OutputStr
except
raise;
end;
finally
TempStream.Free;
end;
end;
The result is the same.
I have just decided to solve the "Connection" problem when a MSSQL Database server is restarted, and the connection is dropped eternally.
The only solution so far has been to restart the program, not always so easy on server far-far away (and the problem must first be detected).
**The code below seems to be working fine, but can a skilled ADO person look deeper into the code and see any errors/problems or improvements needed with this code? **
Type
TComponentHelper = class helper for TComponent
Procedure Reconnect(var AdoConn:TAdoConnection; ConnStr:String);
end;
procedure TComponentHelper.Reconnect(var AdoConn: TAdoConnection; ConnStr: String);
begin
if Assigned(AdoConn) then begin
FreeAndNil(AdoConn);
AdoConn := TAdoConnection.Create(Self);
AdoConn.ConnectionString := ConnStr;
AdoConn.LoginPrompt := false;
SetConnAdoComponent(Self,AdoConn);
AdoConn.Open;
end;
end;
procedure SetConnAdoComponent(aSrc:TComponent; var AdoConn:TAdoConnection);
var
Ctrl : TComponent;
i : Integer;
begin
if (aSrc = Nil) then Exit;
if (aSrc.ComponentCount <= 0) then Exit;
for i:=0 to aSrc.ComponentCount-1 do begin
Ctrl := aSrc.Components[i];
if (Ctrl is TAdoQuery) then TAdoQuery(Ctrl).Connection := AdoConn;
if (Ctrl is TAdoTable) then TAdoTable(Ctrl).Connection := AdoConn;
if (Ctrl is TAdoDataset) then TAdoDataset(Ctrl).Connection := AdoConn;
end;
end
I Call Reconnect() from the Exception part in a TForm or TDataModule, AdoConn is the name of the TAdoConnection component and the ConnStr is the complete connectionstring used.
Except
On E:EOleException do begin
ReConnect(AdoConn,ConnStr);
end;
On E:Exception do begin
ReConnect(AdoConn,ConnStr);
end;
End;
Instead of destroying the TADOConnection your best option is to replace the internal TADOConnection.ConnectionObject with a new one. e.g.
uses ActiveX, ComObj, ADOInt;
function CreateADOConnectionObject: _Connection;
begin
OleCheck(CoCreateInstance(CLASS_Connection, nil, CLSCTX_INPROC_SERVER or
CLSCTX_LOCAL_SERVER, IUnknown, Result));
end;
var
NewConnectionObject: _Connection;
ConnectionString: WideString;
begin
ConnectionString := ADOConnection1.ConnectionString;
NewConnectionObject := CreateADOConnectionObject;
NewConnectionObject.ConnectionString := ConnectionString;
ADOConnection1.Close;
// set the new connection object
ADOConnection1.ConnectionObject := NewConnectionObject;
ADOConnection1.Open;
end;
Setting ADOConnection1.ConnectionObject := NewConnectionObject will destroy the previous internal FConnectionObject and set a new connection object to be used by the TADOConnection object.
Also you need to handle the specific EOleException.ErrorCode (probably E_FAIL) at the time of the exception so that you sure you don't handle other exceptions which has nothing to do with your issue.
I did not try this with your specific scenario (SQL restart). I leave it up to you for testing.
EDIT: Tested with SQL Server 2014 and SQLOLEDB.1. My application connected to the SQL, and after restarting the SQL, I could not reproduce the described behavior "connection is dropped eternally". a Close/Open did the job, and the client re-connected.
I'm using SHFileOperation to delete files to Recycle bin. But sometimes I received a "System call level is not correct" error. It not happens every time or every file. Just some random files at random time. Anyone knows the reason? Thanks.
Update: Here it the code I am using:
function DeleteToRecycleBin(const ADir : WideString) : Integer;
var
op : SHFILEOPSTRUCTW;
begin
ZeroMemory(#op, sizeof(op));
op.pFrom := PWideChar(ADir + #0#0);
op.wFunc := FO_DELETE;
op.fFlags := FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOERRORUI or FOF_ALLOWUNDO;
Result := SHFileOperationW(op);
end;
You are receiving error code 124 (0x7C). Win32 error code 124 is ERROR_INVALID_LEVEL. However, if you read the documentation for SHFileOperation(), some of its error codes pre-date Win32 and thus do not have the same meaning as the same Win32 error codes. Error code 124 is one of those values. In the context of SHFileOperation(), error 124 actually means:
DE_INVALIDFILES 0x7C
The path in the source or destination or both was invalid.
Update: try this:
function DeleteToRecycleBin(const ADir : WideString) : Integer;
var
op : SHFILEOPSTRUCTW;
sFrom: WideString;
begin
// +1 to copy the source string's null terminator.
// the resulting string will have its own null
// terminator, effectively creating a double
// null terminated string...
SetString(sFrom, PWideChar(ADir), Length(ADir)+1);
ZeroMemory(#op, sizeof(op));
op.pFrom := PWideChar(sFrom);
op.wFunc := FO_DELETE;
op.fFlags := FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOERRORUI or FOF_ALLOWUNDO;
Result := SHFileOperationW(op);
end;
I'm making requests to the webaddress to get XML files throught the HTTPS connection. But this connection works like 50%. In most cases it fails. Usual error is "socket error #10060". Or "Error connecting with SSL. EOF was observed that violates the protocol". What I'm doing wrong?
function SendRequest(parameters: string): IXMLDocument;
var
sPostData: TStringList;
sHttpSocket: TIdHTTP;
sshSocketHandler: TIdSSLIOHandlerSocketOpenSSL;
resStream: TStringStream;
xDoc: IXMLDocument;
begin
sPostData := TStringList.Create;
try
sPostData.Add('add some parameter to post' + '&');
sPostData.Add('add some parameter to post' + '&');
sPostData.Add('add some parameter to post' + '&');
sPostData.Add(parameters);
sHttpSocket := TIdHTTP.Create;
sshSocketHandler := TIdSSLIOHandlerSocketOpenSSL.Create;
sHttpSocket.IOHandler := sshSocketHandler;
sHttpSocket.Request.ContentType := 'application/x-www-form-urlencoded';
sHttpSocket.Request.Method := 'POST';
resStream := TStringStream.Create;
sHttpSocket.Post(Self.sUrl, sPostData, resStream);
xDoc := CreateXMLDoc;
xDoc.LoadFromStream(resStream);
Result := xDoc;
resStream.Free;
sHttpSocket.Free;
sshSocketHandler.Free;
sPostData.Free;
except on E: Exception do
begin
TCommon.ErrorLog('errorLog.txt', DateTimeToStr(Now) + ' ' + E.Message);
end
end;
end;
Maybe I can do this in another way, that works like 100%, when internet connection is available?
Regards,
evilone
An "EOF" error suggests you are connnecting to a server that is not actually using SSL to begin with, or the SSL data may be corrupted.
Besides that, why are you including explicit '&' characters between your post data parameters? Don't do that, Indy will just encode them and send its own '&' characters. Also, consider using TMemoryStream instead of TStringStream to ensure IXMLDocumect.LoadFromStream() is loading the server's original raw XML data as-is, and not an altered version that the RTL/VCL produces due to Unicode handling (TStringStream is TEncoding-enabled).
Edit: Given the URL you provided, an example of calling verifyUser() would look like this:
const
ERPLYAccountCode = '...';
function verifyUser(const user, pass: string; const sessionLength: Integer = 3600): IXMLDocument;
var
sPostData: TStringList;
sHttpSocket: TIdHTTP;
sshSocketHandler: TIdSSLIOHandlerSocketOpenSSL;
resStream: TMemoryStream;
xDoc: IXMLDocument;
begin
Result := nil;
try
resStream := TMemoryStream.Create;
try
sPostData := TStringList.Create;
try
sPostData.Add('clientCode=' + ERPLYAccountCode);
sPostData.Add('request=verifyUser');
sPostData.Add('version=1.0');
sPostData.Add('responseType=XML');
sPostData.Add('responseMode=normal');
sPostData.Add('username=' + user);
sPostData.Add('password=' + pass);
sPostData.Add('sessionLength=' + IntToStr(sessionLength));
sHttpSocket := TIdHTTP.Create;
try
sshSocketHandler := TIdSSLIOHandlerSocketOpenSSL.Create(sHttpSocket);
sHttpSocket.IOHandler := sshSocketHandler;
sHttpSocket.Request.ContentType := 'application/x-www-form-urlencoded';
sHttpSocket.Post('https://www.erply.net/api/', sPostData, resStream);
finally
sHttpSocket.Free;
end;
finally
sPostData.Free;
end;
resStream.Position := 0;
xDoc := CreateXMLDoc;
xDoc.LoadFromStream(resStream);
Result := xDoc;
finally
resStream.Free;
end;
except
on E: Exception do
begin
TCommon.ErrorLog('errorLog.txt', DateTimeToStr(Now) + ' ' + E.Message);
end;
end;
end;