Delphi Callback Server using HTTP Protocol Always timeout after a few minutes - apache

I have problem with setting Callback Server in Delphi Tokyo. I've setup a Datasnap WebBroker Server, then i use
FDSCallBackClientManager.RegisterCallback(sCallbackID,FDSCallBack);
on my client to connect callback server, it can connect and i can send a broadcast message to other client, but after a few minutes since connected, it will disconnected, when i try to broadcast message it will raise an exception telling that the communication is timeout.
I'm using HTTP protocol for the connection, this is not happening when using TCP/IP protocol. The code is just the wizard to create webbroker application targeting Apache. Here the code for the SQLConnection :
FConnection.Params.Values['CommunicationIPVersion'] := 'IP_IPv4';
FConnection.Params.Values['Hostname'] :=
TCSClass_Configuration.ReadConfig(
ClientVariables.Config.FileName,
AProfile,
'Hostname',
'localhost'
);
FConnection.Params.Values['Port'] :=
TCSClass_Configuration.ReadConfig(
ClientVariables.Config.FileName,
AProfile,
'WebPort',
'80'
);
FConnection.Params.Values['DatasnapContext'] :=
TCSClass_Configuration.ReadConfig(
ClientVariables.Config.FileName,
AProfile,
'DatasnapContext',
'datasnap'
);
FConnection.Params.Values['URLPath'] :=
TCSClass_Configuration.ReadConfig(
ClientVariables.Config.FileName,
AProfile,
'URLPath',
'rest'
);
FConnection.Params.Values['ConnectTimeout'] :=
TCSClass_Configuration.ReadConfig(
ClientVariables.Config.FileName,
AProfile,
'ConnectTimeOut',
'1000'
);
FConnection.Params.Values['CommunicationTimeout'] :=
TCSClass_Configuration.ReadConfig(
ClientVariables.Config.FileName,
AProfile,
'CommunicationTimeOut',
'1000'
);
And here the code to connect to callback server:
FDSCallBackClientManager.ChannelName := FCallbackChannelName;
FDSCallBackClientManager.DSHostname :=
FConnection.Params.Values['Hostname'];
FDSCallBackClientManager.DSPort :=
FConnection.Params.Values['Port'];
FDSCallBackClientManager.DSPath :=
FConnection.Params.Values['URLPath'];
FDSCallBackClientManager.CommunicationProtocol :=
FConnection.Params.Values['CommunicationProtocol'];
FDSCallBackClientManager.ConnectionTimeout :=
FConnection.Params.Values['ConnectTimeout'];
FDSCallBackClientManager.CommunicationTimeout :=
FConnection.Params.Values['CommunicationTimeout'];
sManagerID := TDSTunnelSession.GenerateSessionId;
sCallbackID := TDSTunnelSession.GenerateSessionId;
FDSCallBackClientManager.ManagerId := sManagerID;
if FDSCallBack = nil then
begin
FDSCallBack := TCSClass_Callback.Create(
Self,
sManagerID,
sCallbackID
);
end;
FDSCallBackClientManager.RegisterCallback(sCallbackID,FDSCallBack);
So can anyone give me some advice what am i missing?

Related

Custom connection to Xero using Oracle PL/SQL

I am having a problem with Xero API when the API establishes the connection, in the first attempt to establish the connection, it returns an error of Unexpected character "<" while in the very 2nd attempt to establish a connection gets successful.
The Code I am using is in the form of a Function as below:
function base64encode(t in varchar2) return varchar2
is
begin
return translate(utl_raw.cast_to_varchar2(utl_encode.base64_encode(utl_raw.cast_to_raw(t))), 'd'||CHR(10)||CHR(13), 'd');
end base64encode;
function get_access_token return varchar2
is
g_client varchar2(200);
v_secret varchar2(200);
l_result clob;
token_not_found exception;
l_token clob;
begin
g_client := mis_system_parameters.get_string_value('XERC');
v_secret := mis_system_parameters.get_string_value('XERS');
g_xero_revenue_account_code := mis_system_parameters.get_string_value('XENC');
while l_result is null or l_result like '%<%' loop
apex_web_service.g_request_headers.delete();
apex_web_service.g_request_headers(1).name := 'authorization';
apex_web_service.g_request_headers(1).value := 'Basic '|| base64encode(g_client||':'||v_secret);
apex_web_service.g_request_headers(2).name := 'Content-Type';
apex_web_service.g_request_headers(2).value := 'application/x-www-form-urlencoded';
l_result := apex_web_service.make_rest_request(
p_url => 'http://localhost/identity-xero-api-proxy/connect/token'
,p_http_method => 'POST'
,p_body => 'grant_type=client_credentials&scope=accounting.transactions accounting.contacts assets files accounting.settings'
);
end loop;
apex_json.parse(l_result);
l_token := apex_json.get_varchar2('access_token');
if apex_json.get_varchar2('access_token') is null then
raise token_not_found;
end if;
return l_token;
exception
when token_not_found then
mis_errors.ins_err
('mis_xero_customer_api.get_access_token','Token Not Found');
when others then
mis_errors.ins_err
('mis_xero_customer_api.get_access_token',l_result||' - '||SQLERRM);
raise;
end get_access_token;
Any kind of advise and help will be highly appreciated.
Thanks

TADOConnection with SQL Server Thread with Delphi

I am working on a project and I need to think about emergency situations.
The main issue is, how to check if the database is connected (circle object = red or green)?
BeforeConnect, AfterDisconnect, they have no good answer.
Inside type:
Create Connection:
procedure TForm1.Button1Click(Sender: TObject);
var
s : String;
begin
ADOConnectionSQL := TADOConnection.Create(nil);
ADOConnectionSQL.LoginPrompt := false;
with ADOSQL do
begin
s := 'Provider=SQLNCLI11.1;'+
'Persist Security Info=False;'+
'User ID='+Edit1.Text+';'+
'Initial Catalog='+Edit2.Text+';'+
'Data Source='+Edit3.Text+';'+
'Initial File Name="";'+
'Server SPN="";'+
'password="'+Edit4.Text+'"';
ADOConnectionSQL.ConnectionString := s;
end;
ADOConnectionSQL.BeforeConnect := SQLConnected;
ADOConnectionSQL.AfterDisconnect := SQLDisconnected;
end;
Try to connect:
procedure TForm1.Button2Click(Sender: TObject);
var
Thread : TThread;
begin
Thread := TThread.CreateAnonymousThread(
procedure
begin
TThread.Synchronize(TThread.CurrentThread,
procedure
begin
try
ADOConnectionSQL.Connected := True;
ADOConnectionSQL.Open;
except
on E: Exception do
begin
ShowMessage('Exception message = '+E.Message);
end;
end;
ADOQuerySQL := TADOQuery.Create(nil);
end);
end);
Thread.OnTerminate := FinishConnected;
Thread.Start;
end;
Green or Red:
procedure TForm1.SQLConnected(Sender: TObject);
begin
Circle1.Fill.Color := $FF00FF00;
end;
procedure TForm1.SQLDisconnected(Sender: TObject);
begin
Circle1.Fill.Color := $FFFF0000;
end;
FinishConnected:
procedure TForm1.FinishConnected(Sender: TObject);
begin
if TThread(Sender).FatalException <> nil then
begin
// something went wrong
ShowMessage ('Failure to connection');
//Exit;
end;
end;
When the SQL Server is online, I would like to see a green circle. When the connection with server goes downs, the circle should be red.
You are creating and opening the ADO connection in the context of the main UI thread, not in the context of the worker thread. So your worker thread is basically useless. You could have just used TThread.ForceQueue() instead to get the same effect.
ADO uses COM technology internally, so you can't really use it across thread boundaries anyway. If you want to use ADO in a thread, give the thread its own ADO Connection and Query objects. Do all your SQL work in the context of the thread, and synchronize status updates with the main UI thread as needed.
Also, you need to initialize the COM library in the worker thread before it can work with ADO.
Try something more like this instead:
procedure TForm1.Button1Click(Sender: TObject);
var
Thread : TThread;
ConnStr: string;
begin
ConnStr := 'Provider=SQLNCLI11.1;'+
'Persist Security Info=False;'+
'User ID='+Edit1.Text+';'+
'Initial Catalog='+Edit2.Text+';'+
'Data Source='+Edit3.Text+';'+
'Initial File Name="";'+
'Server SPN="";'+
'password="'+Edit4.Text+'"';
Thread := TThread.CreateAnonymousThread(
procedure
var
ADOConnectionSQL: TADOConnection;
ADOQuerySQL: TADOQuery;
begin
CoInitialize(nil);
try
ADOConnectionSQL := TADOConnection.Create(nil);
try
ADOConnectionSQL.LoginPrompt := False;
ADOConnectionSQL.ConnectionString := ConnStr;
ADOConnectionSQL.Open;
TThread.Queue(nil,
procedure
begin
Circle1.Fill.Color := TAlphaColorRec.Green;
end
);
ADOQuerySQL := TADOQuery.Create(nil);
try
ADOQuerySQL.Connection := ADOConnectionSQL;
// use ADOQuerySQL as needed...
finally
ADOQuerySQL.Free;
end;
finally
ADOConnectionSQL.Free;
end;
finally
CoUninitialize;
end;
end);
Thread.OnTerminate := SQLFinished;
Thread.Start;
end;
procedure TForm1.SQLFinished(Sender: TObject);
begin
Circle1.Fill.Color := TAlphaColorRec.Red;
if TThread(Sender).FatalException <> nil then
begin
// something went wrong
ShowMessage('Failure! ' + Exception(TThread(Sender).FatalException).Message);
end;
end;

Receiving 400 Bad request when making S3 GET request

I am trying to make an AWS version 4 authorization signed GET request to S3, and receive a bad request error 400 Code:InvalidRequest Message:Missing required header for this request: x-amz-content-sha256
If I prefix the header with "Authorization: ", I get error Code:InvalidArgument Message:Unsupported Authorization Type <ArgumentName>Authorization</ArgumentName> <ArgumentValue>Authorization: AWS4-HMAC-SHA256 Credential=XXXXXXXXXXXXXXXXXXX/20200408/eu-west-3/s3/aws4_request, SignedHeaders=host;x-amz-content-sha256;x-amz-date, Signature=vdchzint97uwyt3g%2fjehszrc8zpkbjsx4tfqacsqfow%3d</ArgumentValue>
I'm using Delphi XE5 with Indy's TIdHTTP component. Can anyone tell me what I am doing wrong? I have included my code below.
begin
bucket := 'mybucket.ata-test';
obj := 'test.xml';
region := 'eu-west-3';
service := 's3';
aws := 'amazonaws.com';
YYYYMMDD := FormatDateTime('yyyymmdd', now);
amzDate := FormatDateTime('yyyymmdd"T"hhnnss"Z"', TTimeZone.Local.ToUniversalTime(Now), TFormatSettings.Create('en-US'));
emptyHash := lowercase(SHA256HashAsHex(''));
host := Format('%s.%s.%s.%s', [bucket, service, region, aws]);
url := Format('%s://%s.%s.%s.%s/%s', ['https', bucket, service, region, aws, obj]);
// *** 1. Build the Canonical Request for Signature Version 4 ***
// HTTPRequestMethod
CanonicalRequest := URLEncodeValue('GET') +#10;
// CanonicalURI
CanonicalRequest := CanonicalRequest + '/' + URLEncodeValue(obj) +#10;
// CanonicalQueryString (empty just a newline)
CanonicalRequest := CanonicalRequest +#10;
// CanonicalHeaders
CanonicalRequest := CanonicalRequest + 'host:' + Trim(host) +#10
+ 'x-amz-content-sha256:' + emptyHash +#10
+ 'x-amz-date:' + Trim(amzDate) +#10;
// SignedHeaders
CanonicalRequest := CanonicalRequest + 'host;x-amz-content-sha256;x-amz-date' +#10;
// HexEncode(Hash(RequestPayload)) - (hash of an empty string)
CanonicalRequest := CanonicalRequest + emptyHash;
// *** 2. Create a String to Sign for Signature Version 4 ***
StringToSign := 'AWS4-HMAC-SHA256' +#10
+ amzDate +#10
+ UTF8String(YYYYMMDD) +'/'+ UTF8String(region) +'/'+ UTF8String(service) +UTF8String('/aws4_request') +#10
+ lowercase(SHA256HashAsHex(CanonicalRequest));
// *** 3. Calculate the Signature for AWS Signature Version 4 ***
DateKey := CalculateHMACSHA256(YYYYMMDD, 'AWS4' + SecretAccessKey);
DateRegionKey := CalculateHMACSHA256(region, DateKey);
DateRegionServiceKey := CalculateHMACSHA256(service, DateRegionKey);
SigningKey := CalculateHMACSHA256('aws4_request', DateRegionServiceKey);
Signature := lowercase(UrlEncodeValue(CalculateHMACSHA256(StringToSign, SigningKey)));
// *** 4. Create Authorisation Header and Add the Signature to the HTTP Request ***
AuthorisationHeader := 'AWS4-HMAC-SHA256 Credential='+AccessIdKey+'/'+YYYYMMDD+'/'+region+'/'+service+'/aws4_request, SignedHeaders=host;x-amz-content-sha256;x-amz-date, Signature='+signature;
// (Gives <Code>InvalidRequest</Code> <Message>Missing required header for this request: x-amz-content-sha256</Message>)
// Have also tried
// AuthorisationHeader := 'Authorization: AWS4-HMAC-SHA256 Credential='+AccessIdKey+'/'+YYYYMMDD+'/'+region+'/'+service+'/aws4_request, SignedHeaders=host;x-amz-content-sha256;x-amz-date, Signature='+signature;
// (Gives <Code>InvalidArgument</Code> <Message>Unsupported Authorization Type</Message>)
// *** 5. Add Header and Make Request ***
stm := TMemoryStream.Create;
try
try
Idhttp.Request.CustomHeaders.FoldLines := False;
Idhttp.Request.CustomHeaders.AddValue('Authorization', AuthorisationHeader);
Idhttp.Get(URL, stm);
except
on PE: EIdHTTPProtocolException do begin
s := PE.ErrorMessage;
Raise;
end;
on E: Exception do begin
s := E.Message;
Raise;
end;
end;
stm.Position := 0;
Memo1.Lines.LoadFromStream(stm);
finally
FreeAndNil(stm);
end;
end;
function SHA256HashAsHex(const value: string): String;
/// used for stringtosign
var
sha: TIdHashSHA256;
begin
LoadOpenSSLLibrary;
if not TIdHashSHA256.IsAvailable then
raise Exception.Create('SHA256 hashing is not available!');
sha := TIdHashSHA256.Create;
try
result := sha.HashStringAsHex(value, nil);
finally
sha.Free;
end;
end;
function CalculateHMACSHA256(const value, salt: String): String;
/// used for signingkey
var
hmac: TIdHMACSHA256;
hash: TIdBytes;
begin
LoadOpenSSLLibrary;
if not TIdHashSHA256.IsAvailable then
raise Exception.Create('SHA256 hashing is not available!');
hmac := TIdHMACSHA256.Create;
try
hmac.Key := IndyTextEncoding_UTF8.GetBytes(salt);
hash := hmac.HashValue(IndyTextEncoding_UTF8.GetBytes(value));
Result := EncodeBytes64(TArray<Byte>(hash));
finally
hmac.Free;
end;
end;
A few things I notice in your code:
when creating the YYYYMMDD and amzDate values, you are calling Now() twice, which creates a race condition that has the potential of causing those variables to represent different dates. Unlikely, but possible. To avoid that, you should call Now() only 1 time and save the result to a local TDateTime variable, and then use that variable in all of your FormatDateTime() calls.
dtNow := Now();
YYYYMMDD := FormatDateTime('yyyymmdd', dtNow);
amzDate := FormatDateTime('yyyymmdd"T"hhnnss"Z"', TTimeZone.Local.ToUniversalTime(dtNow), TFormatSettings.Create('en-US'));
When using TIdHTTP's Request.CustomHeaders property to set a custom Authorization header, make sure that you also set the Request.BasicAuthentication property to False as well, otherwise TIdHTTP may create its own Authorization: Basic ... header using its Request.Username and Request.Password properties. You don't want two Authorization headers in your GET request.
Idhttp.Request.BasicAuthentication := False;
You are using x-amz-content-sha256 and x-amz-date headers in your authorization calculations, but you are not adding those headers to the actual HTTP request. TIdHTTP will add the Host header for you, but you need to add the other headers yourself.
Idhttp.Request.CustomHeaders.AddValue('x-amz-content-sha256', emptyHash);
Idhttp.Request.CustomHeaders.AddValue('x-amz-date', amzDate);
Your SHA256HashAsHex() function is not specifying a byte encoding when calling Indy's TIdHashSHA256.HashStringAsHex() method (in fact, it is going out of its way to explicitly set the encoding to nil). As such, Indy's default byte encoding will be used, which is US-ASCII (unless you set Indy's GIdDefaultTextEncoding variable in the IdGlobal unit to something else). However, your CalculateHMACSHA256() function is explicitly using UTF-8 instead. Your SHA256HashAsHex() function should use IndyTextEncoding_UTF8 to match:
result := sha.HashStringAsHex(value, IndyTextEncoding_UTF8);
the input salt and output value for CalculateHMACSHA256() needs to be binary bytes, not strings, and certainly not base64-encoded or hex-encoded strings. Nothing in the Calculate the Signature for AWS Signature Version 4 documentation mentions the use of base64 at all.
var
DateKey, RegionKey, ServiceKey, SigningKey: TArray<Byte>;
...
// *** 3. Calculate the Signature for AWS Signature Version 4 ***
DateKey := CalculateHMACSHA256(YYYYMMDD, TEncoding.UTF8.GetBytes('AWS4' + SecretAccessKey));
RegionKey := CalculateHMACSHA256(region, DateKey);
ServiceKey := CalculateHMACSHA256(service, RegionKey);
SigningKey := CalculateHMACSHA256('aws4_request', ServiceKey);
Signature := CalculateHMACSHA256Hex(StringToSign, SigningKey);
...
function CalculateHMACSHA256(const value: string; const salt: TArray<Byte>): TArray<Byte>;
/// used for signingkey
var
hmac: TIdHMACSHA256;
hash: TIdBytes;
begin
LoadOpenSSLLibrary;
if not TIdHashSHA256.IsAvailable then
raise Exception.Create('SHA256 hashing is not available!');
hmac := TIdHMACSHA256.Create;
try
hmac.Key := TIdBytes(salt);
hash := hmac.HashValue(IndyTextEncoding_UTF8.GetBytes(value));
Result := TArray<Byte>(hash);
finally
hmac.Free;
end;
end;
function CalculateHMACSHA256Hex(const value: string; const salt: TArray<Byte>): string;
var
hash: TArray<Byte>;
begin
hash := CalculateHMACSHA256(value, salt)
Result := lowercase(ToHex(TIdBytes(hash)));
end;
I just went through a similar problem, I will leave my contribution here, because this post helped me to arrive at the solution.
In my case I needed to generate a signed url with a certain expiration time.
unit Data.Cloud.AmazonAPI.Utils;
interface
//See https://docs.aws.amazon.com/pt_br/AmazonS3/latest/API/sigv4-query-string-auth.html#query-string-auth-v4-signing-example
//Use example:
// MyUlrSigned := GetUrlPreSigned('mybucketname','/MyFolder/MyFile.zip','sa-east-1',3600);
function GetUrlPreSigned(ABucket:string;AObjectName:string;ARegion:string;AExpiresIn:Int64=3600):string;
implementation
uses
System.Classes, System.SysUtils, System.Hash, System.DateUtils;
const
AWS_ACCOUNTNAME = '<AWSAccessKeyId>';
AWS_ACCOUNTKEY = '<AWSSecretAccessKey>';
function SignString(const Signkey: TBytes; const StringToSign: string): TBytes;
begin
Result := THashSHA2.GetHMACAsBytes(StringToSign, Signkey);
end;
function BuildSignature(const StringToSign, DateISO, Region:string; AService: string; LSecretAccessKey:string): string;
function GetSignatureKey(const datestamp, region, serviceName: string): TBytes;
begin
Result := SignString(TEncoding.Default.GetBytes('AWS4'+LSecretAccessKey) ,datestamp);
Result := SignString(Result, region);
Result := SignString(Result, serviceName);
Result := SignString(Result, 'aws4_request');
end;
var
Signature:string;
SigningKey : TBytes;
begin
SigningKey := GetSignatureKey(DateISO, Region, AService);
Result := THash.DigestAsString(SignString(SigningKey, StringToSign));
end;
function GetHashSHA256Hex( HashString: string): string;
var
LBytes: TArray<Byte>;
begin
LBytes := THashSHA2.GetHashBytes(HashString);
Result := THash.DigestAsString(LBytes);
end;
function GetUrlPreSigned(ABucket:string;AObjectName:string;ARegion:string;AExpiresIn:Int64=3600):string;
var
LNow : TDateTime;
LData : string;
LTimeStamp : string;
LAccessKey : string;
LSecretAccessKey : string;
LService : string;
LAws : string;
LHost : string;
LUrl : string;
LQueryParams : string;
LCanonicalRequest : string;
LStringToSign : string;
LSignature : string;
begin
LNow := Now();
LData := FormatDateTime('yyyymmdd', LNow);
LTimeStamp := FormatDateTime('yyyymmdd"T"hhnnss"Z"', TTimeZone.Local.ToUniversalTime(LNow), TFormatSettings.Create('en-US'));
LAccessKey := AWS_ACCOUNTNAME;
LSecretAccessKey := AWS_ACCOUNTKEY;
if AObjectName.StartsWith('/') then
Delete(AObjectName,1,1);
LService := 's3';
LAws := 'amazonaws.com';
LHost := Format('%s-%s.%s', [LService, ARegion, LAws]);
LUrl := Format('%s://%s-%s.%s/%s/%s', ['https', LService, ARegion, LAws, ABucket, AObjectName]);
LQueryParams := 'X-Amz-Algorithm=AWS4-HMAC-SHA256&X-Amz-Credential='+LAccessKey
+'%2F'+LData
+'%2F'+ARegion
+'%2F'+LService+'%2F'
+'aws4_request'
+'&X-Amz-Date='+LTimeStamp
+'&X-Amz-Expires='+AExpiresIn.ToString
+'&X-Amz-SignedHeaders=host';
//1 - CanonicalRequest
LCanonicalRequest := 'GET' +#10+
'/'+ABucket+'/'+AObjectName +#10
+LQueryParams +#10
+'host:'+LHost+#10
+#10
+'host'+#10
+'UNSIGNED-PAYLOAD';
//2 - StringToSign
LStringToSign := 'AWS4-HMAC-SHA256' +#10
+ LTimeStamp +#10
+ UTF8String(LData)+'/'+ UTF8String(ARegion) +'/'+ UTF8String(LService)+UTF8String('/aws4_request') +#10
+ lowercase(GetHashSHA256Hex(LCanonicalRequest));
//3 - Signature
LSignature := BuildSignature(LStringToSign,LData,ARegion,LService,LSecretAccessKey);
//4 - Signed URL
Result := LUrl+'?'+LQueryParams+'&X-Amz-Signature='+LSignature;
end;
end.

Delphi XE2 Indy10 udp client-server interchange using SendBuffer-ReceiveBuffer

I use Delphi XE2 and Indy10 UDP protocol.
I can't receive server echo on client side if I use ReceiveBuffer method.
I got "Socket Error # 10040" although I send back very small echo
message from server to client.
Console application to illustrate my problem is below.
Thanks in advance.
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, IdGlobal, IdBaseComponent, IdComponent, IdSocketHandle,
IdUDPClient, IdUDPServer, IdUDPBase, IdStack;
type
TUDP_Serv = class(TIdUDPServer)
procedure udpSvUDPRead(AThread: TIdUDPListenerThread;
AData: TIdBytes; ABinding: TIdSocketHandle);
end;
var
udpServer: TUDP_Serv;
udpCl: TIdUDPClient;
bSnd, bRcv: TBytes;
s: string;
k: integer;
//==============================================================================
procedure TUDP_Serv.udpSvUDPRead(AThread: TIdUDPListenerThread; AData: TIdBytes;
ABinding: TIdSocketHandle);
begin
writeln(' Server read: ' + ToHex(AData, length(AData)));
with ABinding do SendTo(PeerIP, PeerPort, AData);
end;
//==============================================================================
begin
try
udpServer := TUDP_Serv.Create;
with udpServer do begin
OnUDPRead := udpSvUDPRead; DefaultPort := 20001; BufferSize := 2048;
ThreadedEvent := true; Active := True;
if Active then writeln('Server started on port: ' + IntToStr(DefaultPort));
end;
udpCl := TIdUDPClient.Create;
with udpCl do begin
BufferSize := 2048; Host := '127.0.0.1'; Port := 20001;
end;
SetLength(bSnd, 5); bSnd[0] := $31; bSnd[1] := $0;
bSnd[2] := $33; bSnd[3] := $0; bSnd[4] := $0;
repeat
writeln(' Client send: ' + ToHex(bSnd, length(bSnd)));
with udpCl do SendBuffer(Host, Port, bSnd); sleep(100);
try
k := udpCl.ReceiveBuffer(bRcv, 10);
if k > 0 then writeln(' Client read: ' + ToHex(bRcv, length(bRcv)));
except
on E: exception do begin
writeln(Format(' Client read err: %s',[E.Message]));
end;
end;
readln(s);
until s <> '';
except
on E: Exception do begin
Writeln(E.ClassName, ': ', E.Message); readln(s);
end;
end;
end.
Screen output:
Server started on prot: 20001
Client send: 3100330000
Server read: 3100330000
Client read err: Socket Error # 10040
Message too long.
10040 is WSAEMSGSIZE, which means the buffer you tried to receive into was smaller than the actual size of the message that was received.
You are not allocating any memory for bRcv before calling ReceiveBuffer(), so you are trying to receive into a 0-byte buffer, hense the error. You need to pre-allocate bRcv to at least the same size as your messages, if not larger.
ReceiveBuffer() does not allocate a new TBytes for each received message. You have to allocate the buffer yourself beforehand and then ReceiveBuffer() will merely fill it in, returning how many bytes were actually received into it.

How do set the timeout on a wcf service caller in Delphi?

I have a straightforward call to a wcf service hosted by iis I'm Delphi 2010
The operation being called on the service could take several minutes
What is the best way of avoiding a timeout error in Delphi?
I deliberately put a Thread.Sleep inside my WCF Service force it to wait for 31 seconds
After 30 seconds I got the error
Project raised exception class ESOAPHTTPException with message 'The handle is in the wrong state for the requested operation - URL:http://10.1.1.4/STC.WcfServices.Host/FlexProcurementService.svc - SOAPAction:http://navsl.stcenergy.com/FlexProcurement/FlexProcurementService/GetPassthroughSummaryGridReportData'.
This turned out to be a bug in Delphi 2010 which I have applied the patch for, so now I get the error operation timed out
function GetFlexProcurementService(const objServiceInfo: TWCFService; UseWSDL: Boolean; Addr: string; HTTPRIO: THTTPRIO): FlexProcurementService;
var
RIO: THTTPRIO;
begin
Result := nil;
if (Addr = '') then
begin
if UseWSDL then
Addr := objServiceInfo.WSDL
else
Addr := objServiceInfo.URL;
end;
if HTTPRIO = nil then
RIO := THTTPRIO.Create(nil)
else
RIO := HTTPRIO;
try
Result := (RIO as FlexProcurementService);
if UseWSDL then
begin
RIO.WSDLLocation := Addr;
RIO.Service := objServiceInfo.Svc;
RIO.Port := objServiceInfo.Prt;
end else
RIO.URL := Addr;
finally
if (Result = nil) and (HTTPRIO = nil) then
RIO.Free;
end;
end;
Paul
uses wininet;
...
function SetTimeout(const HTTPReqResp: THTTPReqResp; Data: Pointer; NumSecs : integer) : boolean;
var
TimeOut: Integer;
begin
// Sets the receive timeout. i.e. how long to wait to 'receive' the response
TimeOut := (NumSecs * 1000);
try
InternetSetOption(Data, INTERNET_OPTION_RECEIVE_TIMEOUT, Pointer(#TimeOut), SizeOf(TimeOut));
InternetSetOption(Data, INTERNET_OPTION_SEND_TIMEOUT, Pointer(#TimeOut), SizeOf(TimeOut));
except on E:Exception do
raise Exception.Create(Format('Unhandled Exception:[%s] while setting timeout to [%d] - ',[E.ClassName, TimeOut, e.Message]));
end;
end;
In the RIO OnBeforePost:
procedure TEETOUpsertWrapper.OnBeforePost(const HTTPReqResp: THTTPReqResp; Data: Pointer); begin
SetTimeout(HTTPReqResp, Data, 5 * 60);
end;