I have a Timer and want send a message to each client of ListView to determine a ping time for example. Then i have this following code:
procedure TMainForm.Timer1Timer(Sender: TObject);
var
i: Integer;
begin
try
for i := 0 to ListView1.Items.count - 1 do
begin
ListView1.Items.Item[i].SubItems.Objects[2] := TObject(GetTickCount);
ServerSocket1.Socket.Connections[i].SendText('ping' + #13#10);
end;
except
exit;
end;
end;
Before send, could be more appropriate check if the client is really connected or some like this. How make this? Thank's in advance.
There is no need to check for a connection. If the client were actually disconnected, it would not be in the server's Connections[] list anymore when your OnTimer handler is triggered. You should have an OnClientDisconnect handler assigned to the TServerSocket to remove the client from the TListView.
If, for some reason, the client were still in the Connections[] list (ie, because the underlying connection has been lost but TServerSocket hasn't detected it yet), then the socket would simply cache all outgoing data until its outbound buffer fills up, then it would start returning WSAWOULDBLOCK errors for each send. Eventually, the OS will timeout the dead connection and TServerSocket will remove it from the Connections[] list, triggering the OnClientDisconnect event.
At the very least, in the code you have shown, you should update your send loop to Close() any socket that actually fails to send, thus triggering the OnClientDisconnect event to remove that client from the TListView, eg:
procedure TMainForm.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
var
Item: TListItem;
begin
Item := ListView1.Items.Add;
Item.Data := Socket;
...
end;
procedure TMainForm.ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
var
Item: TListItem;
begin
Item := ListView1.FindData(0, Socket, True, False);
if Item <> nil then
Item.Delete;
end;
procedure TMainForm.Timer1Timer(Sender: TObject);
const
s: AnsiString = 'ping' + #13#10;
var
Item: TListItem;
Socket: TCustomWinSocket;
p: PAnsiChar;
i, len, sent: Integer;
begin
for i := 0 to ListView1.Items.Count - 1 do
begin
Item := ListView1.Items[i];
Item.SubItems.Objects[2] := TObject(GetTickCount);
Socket := TCustomWinSocket(Item.Data);
try
// SendText() does not handle partial sends, or Unicode strings...
//Socket.SendText('ping' + #13#10);
p := PAnsiChar(s);
len := Length(s);
repeat
sent := Socket.SendBuf(p^, len);
if sent = -1 then
being
if WSAGetLastError() <> WSAEWOULDBLOCK then
Break;
// TODO: stop trying after several attempts fail...
Continue;
end;
Inc(p, sent);
Dec(len, sent);
until len = 0;
if len = 0 then
Continue;
except
end;
Socket.Close;
end;
end;
I'm trying to use Delphi 10.2 TREST components with AWS. I have a CURL command that works:
curl -X POST --data #GetIDData.json -H "X-Amz-Target: AWSCognitoIdentityService.GetId" -H "Content-Type: application/x-amz-json-1.1" https://cognito-identity.us-east-1.amazonaws.com/
GetIDData.json contains this:
{"IdentityPoolId":"us-east-1:XXXXXXXXXXXXXXXXXXXXX"}
Successful result is this:
{"IdentityId":"us-east-1:XXXXXXXXXXXXXXXXXXXXX"}
I'd like to duplicate that result using Delphi TREST components:
...
fClient := TRESTClient.Create('https://cognito-identity.us-east-1.amazonaws.com/');
fClient.SetHTTPHeader('Content-Type', 'application/x-amz-json-1.1');
fClient.SetHTTPHeader('X-Amz-Target', 'AWSCognitoIdentityService.GetId');
fRequest := TRESTRequest.Create(nil);
fRequest.Client := fClient;
fRequest.Method := TRESTRequestMethod.rmPOST;
// fRequest.AddBody('{"IdentityPoolId":"us-east-1:XXXXXXXXXXXXXXXXXXXXX"}', ctAPPLICATION_JSON);
lJObj := TJSONObject.Create;
lJObj.AddPair('IdentityPoolId', 'us-east-1:XXXXXXXXXXXXXXXXXXXXX');
fRequest.AddBody(lJObj);
fRequest.Execute;
str := fRequest.Response.Content;
...
But the result is an error:
{"Output":"__type":"com.amazon.coral.service#UnknownOperationException","message":null},"Version":"1.0"}
Downloading OpenSSL and putting the dlls into System32 did not help.
Can anyone tell me what I'm doing wrong?
This works:
...
lClient := TRESTClient.Create('https://cognito-identity.us-east-1.amazonaws.com/');
lRequest := TRESTRequest.Create(nil);
lRequest.Client := lClient;
lRequest.Method := TRESTRequestMethod.rmPOST;
lParam := lRequest.Params.AddItem;
lParam.name := 'X-Amz-Target';
lParam.Value := 'AWSCognitoIdentityService.GetId';
lParam.ContentType := ctNone;
lParam.Kind := pkHTTPHEADER;
lParam := lRequest.Params.AddItem;
lParam.name := 'Content-Type';
lParam.Value := 'application/x-amz-json-1.1';
lParam.ContentType := ctNone;
lParam.Kind := pkHTTPHEADER;
lParam.Options := [poDoNotEncode];
lRequest.AddBody('{"IdentityPoolId":"us-east-1:XXXXXXXXXXXXXXXXXXXXX"}', ctAPPLICATION_JSON);
lRequest.Execute;
...
WireShark was not as helpful as I wanted because its doc is out of date and I'm using encryption. But the website mentioned by #Christophe Morio in this post made finding a solution a piece of cake.
I'm working with the TSslHttpCli component of ICS OverByte, at times I get the error 500 "Internal Server Error" I get the error code in the "OnRequestDone" event as shown below:
procedure TFFormCot.SslHttpCotRequestDone(Sender: TObject;
RqType: THttpRequest; ErrCode: Word);
var
SslHttpCli : TSslHttpCli;
begin
try
SslHttpCli := Sender as TSslHttpCli;
if ErrCode <> 0 then
begin
Memo1.lines.add('ICS:Erro:CT-01: Falha na solicitação ao servidor - ErrCode:[' + IntToStr(ErrCode) + '][' + SslHttpCli.ReasonPhrase + ']');
end;
if SslHttpCli.StatusCode <> 200 then
begin
Memo1.lines.add('ICS:Erro:CT-01.A: ' + IntToStr(SslHttpCli.StatusCode) + ' ' + SslHttpCli.ReasonPhrase);
end;
end;
But I can not get the details of error 500.
the html is not available, you may have some message stating the reason for the error, such as a wrong sent parameter. How do I get the html in this case, or the header received?
Sorry if this question has been asked in the past, but i'm confused!
I have an app and a DLL, both in Delphi. The Dll has a form that i want to show(no modal) inside a Groupbox.
In the main app i have enabled runtime packages.
In the DLL if i disable them, then works ok with the code bellow.
in DLL :
procedure showInfo(app : Thandle; GB : TGroupBox); stdcall;
begin
// application.Handle := app; // are the same
FormSysInfo := TFormSysInfo.CreateParented(GB.handle);
FormSysInfo.show;
end;
procedure destroyInfo; stdcall;
begin
FormSysInfo.destroy;
end;
exports showInfo index 1,
destroyInfo index 2;
in main app :
procedure loadSysInfo;
var showInfo : procedure(app : Thandle; GB : TGroupBox); stdcall;
begin
sysInfo := LoadLibrary('SysInfo.dll');
if sysInfo <> 0 then begin
#showInfo := GetProcAddress(sysInfo, 'showInfo');
#destroyInfo := GetProcAddress(sysInfo, 'destroyInfo');
if #showInfo <> NIL then showInfo(application.handle,mainForm.GroupBox8);
end;
end;
but didn't show if i enable runtime packages for the DLL (I want to reduce the size).
How can i manage this, please ?
thanks in advance
Client:
//is called when the client tries to log in
procedure TLogin_Form.btnLoginClick(Sender: TObject);
var LoginQuery: TQuery;
begin
//If socket not open, open it
if not LoginSocket.Active then
begin
LoginSocket.Open;
end;
//create package
LoginQuery.Login := ledtName.Text;
LoginQuery.Passwort := ledtPasswort.Text;
LoginQuery.IP := LoginSocket.Socket.LocalAddress;
//send package
LoginSocket.Socket.SendBuf(LoginQuery, SizeOf(LoginQuery));
end;
Server:
//This procedure is executed when I click on start server button
procedure TServer_Form.btnStartStopClick(Sender: TObject);
begin
//If not open, open it
if not ServerSocket.Active then
begin
btnStartStop.Caption := 'stop server';
//Open ServerSocket
ServerSocket.Open;
end
else
begin
//If Socket open, close it, but watch for active connctions.
if ServerSocket.Socket.ActiveConnections > 0 then
begin
ShowMessage('Clients still logged in');
end
else
begin
//If no clients connected, close socket
ServerSocket.Close;
end;
end;
end;
//This procedure is called to verify weather the user is logged in and to send the verification back
procedure UserCheckExist(Login, Passwort: string);
var LoginReply: TReply;
begin
begin
//Connect to DB
DBConnect(true);
DM.AQ_LOGIN.Close;
DM.AQ_LOGIN.SQL.Clear;
//Count of BLOGINs
DM.AQ_LOGIN.SQL.Add('select count(BLOGIN) from BENU where BLOGIN = ''' + Login + ''' AND BPW = ''' + Passwort + '''');
DM.AQ_LOGIN.Open;
//LoginReply.Action tells the client then what to do with the LoginReply.Value
LoginReply.Action := 0;
//if user unique
if DM.AQ_LOGIN.Fields[0].AsInteger = 1 then
begin
//LoginReply.Value = 1 means the client is allowed to log in
LoginReply.Value := 1;
//THIS RETURNS THE WSA 10057 EXCEPTION of user is unique
Server_Form.ServerSocket.Socket.SendBuf(LoginReply, SizeOf(LoginReply));
end
else
begin
//LoginReply.Value = 0 means the client is NOT allowed to log in
LoginReply.Value := 0;
//THIS RETURNS THE WSA 10057 EXCEPTION if user is NOT unique
Server_Form.ServerSocket.Socket.SendBuf(LoginReply, SizeOf(LoginReply));
end;
//Close ADOQuery
DM.AQ_LOGIN.Close;
//Close DB Connection
DBConnect(false);
end;
end;
//Is called when something is in the socket connection
procedure TServer_Form.ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var Query: TQuery;
begin
//Reads from the Socket (cant use ServerSocket.Socket.ReceiveBuf whysoever, but this is another thread)
Socket.ReceiveBuf(Query, SizeOf(Query));
case Query.Action of
//If Query.Action = 0, which means the client tries to login call UserCheckExist
0: UserCheckExist(Query.Login, Query.Passwort);
//Otherwise, getfuckedup
else ShowMessage('Query Action not defined');
end;
end;
One strange thing is that I have to send the login + pw from the client two times.
The first time send (Client), I get onClientConnect and onAccept at the server.
The second time i send (Client), the server executes the code until the line I marked . I get a 10057 WSA Exception.
Why do I get this error? Strange however is, that if I open the socket on the server right before the line where I get the Exception saying that 'socket not open', I get it anyways
The code you have shown will not work on both the client and server sides due to several bugs in your code.
When TClientSocket is set to ctNonBlocking mode (which I am assuming you are using), Open() will not trigger the OnConnect event until after btnLoginClick() has exited and flow has returned to the message queue. It is not valid to read or write data from a socket until the OnConnect event has fired. So you should move your sending code into the OnConnect event itself. You also need to take into account that SendBuf() may not be able to send all of the data in a single packet. If SendBuf() returns -1 and WSAGetLastError() returns WSAEWOULDBLOCK afterwards (which will always be true if the OnError event was not triggered), then data was not sent in its entirety. You must buffer any unsent bytes somewhere, and then wait for the OnWrite event to fire before trying to write the buffered bytes again, or anything else for the matter, to the socket.
As for your server code, you are trying to write outbound data to the wrong object. You must read and write data using the TCustomWinSocket object that the OnRead event provided. You are trying to write data to the server's TServerWinSocket object instead, which does not represent a valid socket endpoint for any connected client. You also need to look at the return value of ReceiveBuf() in order to handle partial transmissions as well.
Try something more like the following:
Common:
type
// helper class that holds buffered input/output data
SocketBuffers = class
public
constructor Create;
destructor Destroy;
Inbound: TMemoryStream;
Outbound: TMemoryStream;
end;
constructor SocketBuffers.Create;
begin
inherited;
Inbound := TMemoryStream.Create;
Outbound := TMemoryStream.Create;
end;
destructor SocketBuffers.Destroy;
begin
Inbound.Free;
Outbound.Free;
inherited;
end;
// removes processed bytes from a buffer
procedure CompactBuffer(Buffer: TMemoryStream);
begin
if Buffer.Position > 0 then
begin
// bytes have been processed, remove them from the buffer...
if Buffer.Position < Buffer.Size then
begin
// move unprocessed bytes to the front of the buffer...
Move(Pointer(Longint(Buffer.Memory)+Buffer.Position)^, Buffer.Memory^, Buffer.Size - Buffer.Position);
// reduce the buffer size just the remaining bytes...
Buffer.Size := Buffer.Size - Buffer.Position;
end else
begin
// all bytes have been processed, clear the buffer...
Buffer.Clear;
end;
end;
end;
// sends raw bytes to the specified socket, buffering any unsent bytes
function SendDataToSocket(Socket: TCustomWinSocket; Data: Pointer; DataSize: Integer; Buffer: TMemoryStream): Integer;
var
DataPtr: PByte;
NumSent: Integer;
begin
Result := 0;
DataPtr := PByte(Data);
if DataSize > 0 then
begin
if Buffer.Size = 0 then
begin
// the buffer is empty, send as many bytes as possible...
repeat
NumSent := Socket.SendBuf(DataPtr^, DataSize);
if NumSent <= 0 then Break; // error or disconnected
Inc(DataPtr, NumSent);
Dec(DataSize, NumSent);
Inc(Result, NumSent);
until DataSize = 0;
if DataSize = 0 then Exit; // nothing left to send or buffer
end;
// add unsent bytes to the end of the buffer...
Buffer.Seek(0, soFromEnd);
Buffer.WriteBuf(DataPtr^, DataSize);
Inc(Result, DataSize);
end;
end;
// sends buffered bytes to the specified socket
procedure SendBufferToSocket(Socket: TCustomWinSocket; Buffer: TMemoryStream);
var
DataPtr: PByte;
NumSent: Integer;
begin
// start at the beginning of the buffer
Buffer.Position := 0;
DataPtr := PByte(Buffer.Memory);
while Buffer.Position < Buffer.Size do
begin
NumSent := Socket.SendBuf(DataPtr^, Buffer.Size - Buffer.Position);
if NumSent <= 0 then Break; // error or disconnected
Inc(DataPtr, NumSent);
Buffer.Seek(NumSent, soFromCurrent);
end;
// remove bytes that were sent...
CompactBuffer(Buffer);
end;
// reads raw bytes from the specified socket ands buffers them
procedure ReadBufferFromSocket(Socket: TCustomWinSocket; Buffer: TMemoryStream);
var
NumRecv: Integer;
OldSize: Integer;
begin
repeat
NumRecv := Socket.ReceiveLength;
if NumRecv <= 0 then Exit; // error or no data available
// increase the size of the buffer
OldSize := Buffer.Size;
Buffer.Size := Buffer.Size + NumRecv;
// read bytes into the new memory space
NumRecv := Socket.ReceiveBuf(Pointer(Longint(Buffer.Memory)+OldSize)^, NumRecv);
if NumRecv <= 0 then
begin
// nothing read, free the unused memory
Buffer.Size := OldSize;
Exit;
end;
until False;
end;
Client:
var
Buffers: SocketBuffers = nil;
procedure TLogin_Form.FormCreate(Sender: TObject);
begin
Buffers := SocketBuffers.Create;
end;
procedure TLogin_Form.FormDestroy(Sender: TObject);
begin
LoginSocket.Close;
Buffers.Free;
end;
procedure TLogin_Form.btnLoginClick(Sender: TObject);
begin
if not LoginSocket.Active then
begin
Buffers.Inbound.Clear;
Buffers.Outbound.Clear;
LoginSocket.Open;
end;
end;
procedure TLogin_Form.LoginSocketConnect(Sender: TObject; Socket: TCustomWinSocket);
var
LoginQuery: TQuery;
begin
LoginQuery.Login := ledtName.Text;
LoginQuery.Passwort := ledtPasswort.Text;
LoginQuery.IP := LoginSocket.Socket.LocalAddress;
// send query, buffering unsent bytes if needed...
SendDataToSocket(Socket, #LoginQuery, SizeOf(LoginQuery), Buffers.Outbound);
end;
procedure TLogin_Form.LoginSocketRead(Sender: TObject; Socket: TCustomWinSocket);
var
Buffer: TmemoryStream;
Available: Integer;
Query: TQuery;
begin
Buffer := Buffers.Inbound;
// read available bytes into the buffer...
ReadBufferFromSocket(Socket, Buffer);
// process complete queries, ignore unfinished queries until later...
Buffer.Position := 0;
repeat
Available := Buffer.Size - Buffer.Position;
if Available < SizeOf(Query) then Break;
Buffer.ReadBuf(Query, SizeOf(Query));
// process query as needed ...
until False;
// remove processed bytes from the buffer...
CompactBuffer(Buffer);
end;
procedure TLogin_Form.LoginSocketWrite(Sender: TObject; Socket: TCustomWinSocket);
begin
// can send any buffered bytes now...
SendBufferToSocket(Socket, Buffers.Outbound);
end;
Server:
procedure TServer_Form.btnStartStopClick(Sender: TObject);
begin
if not ServerSocket.Active then
begin
btnStartStop.Caption := 'stop server';
ServerSocket.Open;
end
else if ServerSocket.Socket.ActiveConnections > 0 then
begin
ShowMessage('Clients still logged in');
end
else
begin
ServerSocket.Close;
end;
end;
procedure UserCheckExist(Socket: TCustomWinSocket; Login, Password: string);
var
LoginReply: TReply;
begin
...
LoginReply.Value := ...;
// send query, buffering unsent bytes if needed...
SendDataToSocket(Socket, #LoginReply, Sizeof(LoginReply), SocketBuffers(Socket.Data).Outbound);
...
end;
procedure TServer_Form.ServerSocketClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Socket.Data := SocketBuffers.Create;
end;
procedure TServer_Form.ServerSocketClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
SocketBuffers(Socket.Data).Free;
Socket.Data := nil;
end;
procedure TServer_Form.ServerSocketClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
Buffer: TmemoryStream;
Available: Integer;
Query: TQuery;
begin
Buffer := SocketBuffers(Socket.Data).Inbound;
// read available bytes into the buffer...
ReadBufferFromSocket(Socket, Buffer);
// process complete queries, ignore unfinished queries until later...
Buffer.Position := 0;
repeat
Available := Buffer.Size - Buffer.Position;
if Available < SizeOf(Query) then Break;
Buffer.ReadBuf(Query, SizeOf(Query));
// process query as needed ...
case Query.Action of
0: UserCheckExist(Socket, Query.Login, Query.Password);
...
end;
until False;
// remove processed bytes from the buffer...
CompactBuffer(Buffer);
end;
procedure TServer_Form.ServerSocketClientWrite(Sender: TObject; Socket: TCustomWinSocket);
begin
// can send any buffered bytes now...
SendBufferToSocket(Socket, SocketBuffers(Socket.Data).Outbound);
end;