I've been using TIdTCPClient for sending data to a server, sometimes using SSL, and now I have the task to do it using IPsec.
I found some classes like TIdTunnelMaster and TIdTunnelSlave, but without obvious connection to other parts of the library.
Is there a proper approach to integrate IPsec to Indy packets? Or is that just impossible and should be done without Indy at all?
Current method:
procedure SendData;
var
idClient: TidTCPClient;
indySSLIOHandlerSocketOpenSSL: TIdSSLIOHandlerSocketOpenSSL;
begin
indySSLIOHandlerSocketOpenSSL := TIdSSLIOHandlerSocketOpenSSL.Create;
indySSLIOHandlerSocketOpenSSL.SSLOptions.Method := sslvTLSv1_2;
idClient := TidTCPClient.Create(nil);
try
idClient.Host := 'localhost';
idClient.Port := 1111;
idClient.IOHandler := indySSLIOHandlerSocketOpenSSL;
idClient.Connect;
idClient.IOHandler.Write(12345);
idClient.Disconnect;
finally
idClient.Free;
indySSLIOHandlerSocketOpenSSL.Free;
end;
end;
Related
I'm learning about Inno Setup to make a simple installer. I need to download a file from a website during the installation, so it's important check if there is Internet connection. How can I check or take some alert to connect Internet during the process of the installation?
Thanks!
The best check is to try to actually download the file.
"Internet" is hardly a real thing that you can connect to. So it's hard to test, if you are connected to "Internet". You actually do not need a connection to "Internet", you need a connection to your server. So test that.
See also
How to check if internet connection is present in java?
What is the best way to check for Internet connectivity using .NET?
An equivalent implementation in Inno Setup would be like:
function InitializeSetup(): Boolean;
var
WinHttpReq: Variant;
Connected: Boolean;
begin
Connected := False;
repeat
Log('Checking connection to the server');
try
WinHttpReq := CreateOleObject('WinHttp.WinHttpRequest.5.1');
{ Use your real server host name }
WinHttpReq.Open('GET', 'https://www.example.com/', False);
WinHttpReq.Send('');
Log('Connected to the server; status: ' + IntToStr(WinHttpReq.Status) + ' ' +
WinHttpReq.StatusText);
Connected := True;
except
Log('Error connecting to the server: ' + GetExceptionMessage);
if WizardSilent then
begin
Log('Connection to the server is not available, aborting silent installation');
Result := False;
Exit;
end
else
if MsgBox('Cannot reach server. Please check your Internet connection.',
mbError, MB_RETRYCANCEL) = IDRETRY then
begin
Log('Retrying');
end
else
begin
Log('Aborting');
Result := False;
Exit;
end;
end;
until Connected;
Result := True;
end;
I have a important problem with building Indy Server/Clients realtime monitoring system...
I am using DELPHI 2010, and Indy version is 10.5.5.........
My purpose is that many client side PCs send screenshots continuosely(4~10fps) to Server, and Server have to send these screenshots frames to some monitoring PCs.
In other words....
Many clients -----send streams--------> to Server
Some monitors <---receive streams----- from Server
Of course, In the case of one client and one monitor with server works well...
But if connecting another clients or monitors, then server have been raising exceptions "Access violation at address 000000000.....", or "Invalid pointer operations" and disconnects client's connection or monitor's one.
At the result, client or monitor will be disconnected from server....
I have used idTCPClient component, described client and monitor code using thread for sending and receiving stream.
I am sure there is no problem with client and monitor side's Code...
But I think that there will be absolutely problem with server side.
For server side, I have used two TidTCPServer controls...
One is to receive streams from client PCs.And another is to send streams to monitor PCs.
server code is like below...
{one side----idTCPServerRecv is to receive screenshot streams from clients}
procedure TIndyServerForm.IdTCPServer_RecvExecute(AContext: TIdContext);
var
Hb: TIdIOHandler;
TempStr: TStrings;
begin
Hb := AContext.Connection.IOHandler;
if Not Hb.InputBufferIsEmpty then
Begin
Hb.CheckForDisconnect(True, True);
AContext.Connection.IOHandler.CheckForDisconnect(True, True);
recv_Stream := TMemoryStream.Create;
recv_Stream.Clear;
if (ReceiveStream(AContext, TStream(recv_Stream)) = False) then
begin
ROutMsg :=AContext.Binding.PeerIP+' -> receiving failed: ' + IntToStr(recv_Stream.Size)+'byte';
recv_Stream.Free;
Exit;
end;
if recv_Stream.Size < 1024 then
begin
recv_Stream.Seek(0, soFromBeginning);
ROutMsg :=AContext.Binding.PeerIP+' -> captionString received('+
IntToStr(recv_Stream.Size)+' byte) : "'+StringFromStream(TStream(recv_Stream))+'"';
recv_Stream.Free;
end
else
begin
ROutMsg :=AContext.Binding.PeerIP+' -> screenshot received: ' + KBStr(recv_Stream.Size)+' KB';
if G_Sendable = False then
begin
send_Stream:=TMemoryStream.Create;
send_Stream.Clear;
recv_Stream.Seek(0, soFromBeginning);
send_Stream.Seek(0, soFromBeginning);
send_Stream.CopyFrom(recv_Stream, recv_Stream.Size);
G_Sendable :=True;
end;
recv_Stream.Free;
end;
end;
Application.ProcessMessages;
WaitForSingleObject(Handle, 1);
end;
{another side----idTCPServerSend is to send screenshot streams to monitors}
procedure TIndyServerForm.IdTCPServer_SendExecute(AContext: TIdContext);
begin
if G_Sendable then
begin
send_Stream.Seek(0,soFromBeginning);
if (SendStream(AContext, TStream(send_Stream)) = False) then
begin
SOutMsg :=AContext.Binding.PeerIP+' -> sending failed -> ' + KBStr(send_Stream.Size)+' KB';
send_Stream.Free;
G_Sendable :=False;
Exit;
end;
SOutMsg :=AContext.Binding.PeerIP+' -> sending successful-> ' + KBStr(send_Stream.Size)+' KB';
send_Stream.Free;
G_Sendable :=False;
end;
Application.ProcessMessages;
WaitForSingleObject(Handle, 1);
end;
What should I do for multi-clients connections with realtime exchange of streams...
Every client PC send screenshot stream 4~10 times per second...
And these streams must be sent to monitors corresponding
Please give me advice....
Your code is not even close to being thread-safe, which is why you are having errors. Every client thread in IdTCPServer_Recv is receiving their respective screeshots to a single shared recv_Stream variable, and then copying that data to a single shared send_Stream variable. All clients connected to IdTCPServer_Send are then reading and sending the same send_Stream at the same time. You are trampling memory all over the place.
You need to use a local variable instead of a shared variable to receive each screenshot, and you need to use a separate TStream object for each monitor client. Don't use a shared TStream for sending, and certainly don't use a global boolean variable to let each monitor client go at it. Have IdTCPServer_RecvExecute() actively create and pass along a new TMemoryStream object to each monitor client that needs to send the current screenshot.
Try something more like this:
uses
..., IdThreadSafe;
type
TMonitorContext = class(TIdServerContext)
public
Screenshots: TIdThreadSafeObjectList;
ScreenshotEvent: THandle;
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil); override;
destructor Destroy; override;
end;
TScreenshotInfo = class
public
ClientIP: string;
ClientPort: TIdPort;
Data: TMemoryStream;
constructor Create;
destructor Destroy; override;
end;
constructor TMonitorContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList);
begin
inherited;
Screenshots := TIdThreadSafeObjectList.Create;
Screenshots.OwnsObjects := True;
ScreenshotEvent := CreateEvent(null, True, False, nil);
end;
destructor TMonitorContext.Destroy;
begin
Screenshots.Free;
CloseHandle(ScreenshotEvent);
inherited;
end;
constructor TScreenshotInfo.Create;
begin
inherited;
Data := TMemoryStream.Create;
end;
destructor TScreenshotInfo.Destroy;
begin
Data.Free;
inherited;
end;
{one side----idTCPServerRecv is to receive screenshot streams from clients}
procedure TIndyServerForm.IdTCPServer_RecvExecute(AContext: TIdContext);
var
recv_stream: TMemoryStream;
monitors, queue: TList;
i: Integer;
screenshot: TScreenshotInfo;
monitor: TMonitorContext;
begin
recv_stream := TMemoryStream.Create;
try
if not ReceiveStream(AContext, recv_stream) then
begin
ROutMsg := AContext.Binding.PeerIP + ' -> receiving failed: ' + IntToStr(recv_Stream.Size) + ' byte';
Exit;
end;
if recv_Stream.Size < 1024 then
begin
recv_Stream.Position := 0;
ROutMsg := AContext.Binding.PeerIP + ' -> captionString received(' +
IntToStr(recv_Stream.Size) + ' byte) : "' + StringFromStream(recv_Stream) + '"';
end
else
begin
ROutMsg := AContext.Binding.PeerIP + ' -> screenshot received: ' + KBStr(recv_Stream.Size) + ' KB';
monitors := IdTCPServer_Send.Contexts.LockList;
try
// alternatively, only queue the screenshot to particular monitors
// that are actually interested in this client...
for i := 0 to monitors.Count-1 do
begin
monitor := TMonitorContext(monitors[i]);
screenshot := TScreenshotInfo.Create;
try
recv_Stream.Position := 0;
screenshot.Data.CopyFrom(recv_stream, 0);
screenshot.Data.Position := 0;
queue := monitor.Screenshots.LockList;
try
queue.Add(screenshot);
SetEvent(monitor.ScreenshotEvent);
finally
monitor.Screenshots.UnlockList;
end;
except
screenshot.Free;
end;
end;
finally
IdTCPServer_Send.Contexts.UnlockList;
end;
end;
finally
recv_stream.Free;
end;
end;
{another side----idTCPServerSend is to send screenshot streams to monitors}
procedure TIndyServerForm.FormCreate(Sender: TObject);
begin
IdTCPServer_Send.ContextClass := TMonitorContext;
end;
procedure TIndyServerForm.IdTCPServer_SendExecute(AContext: TIdContext);
var
monitor: TMonitorContext;
queue: TList;
i: Integer;
screenshot: TScreenshotInfo;
begin
monitor := TMonitorContext(AContext);
if WaitForSingleObject(monitor.ScreenshotEvent, 1000) <> WAIT_OBJECT_0 then Exit;
screenshot := nil;
try
queue := monitor.Screenshots.LockList;
try
if queue.Count > 0 then
begin
screenshot := TScreenshotInfo(queue[0]);
queue.Delete(0);
end;
if queue.Count = 0 then
ResetEvent(monitor.ScreenshotEvent);
finally
monitor.Screenshots.UnlockList;
end;
if screenshot = nil then Exit;
// you should send screenshot.ClientIP and screenshot.ClientPort to
// this monitor so it knows which client the screenshot came from...
if not SendStream(AContext, screenshot.Data) then
begin
SOutMsg := AContext.Binding.PeerIP + ' -> sending failed -> ' + KBStr(screenshot.Data.Size) + ' KB';
Exit;
end;
SOutMsg := AContext.Binding.PeerIP + ' -> sending successful-> ' + KBStr(screenshot.Data.Size) + ' KB';
finally
screenshot.Free;
end;
end;
On the 'monitor' side, a TIdTCPClient in a thread can listen for incoming screenshot data from the server. I have posted a blog article about server-side push messaging technique with Indy (source code) here:
Indy 10 TIdTCPServer: Server-side message push example
Additional server-side code is required to direct the incoming data to the monitoring clients. Actually you only need to add 'tags' (which could be boolean flags) to the context, indicating wether this connection is sending or monitoring screenshot data. How to assign custom properties to connection context and iterating over them is already answered in other questions here on SO.
I've been trying to figure this error our for about 4 days now. I'm using Delphi XE and have created a little tool for translators to use. I got the idea of using the Microsoft Translation API to help make things easier and a bit less tedious.
I created a class that accesses the Microsoft translator API, but I wanted to make it Thread Safe so the requests could be made in the background. I have no problem sending a request to get an Access Token, however, I run that request in a separate thread. When the user clicks a button, I spawn a new thread and run the http request to translate the term from in there. However, it times out every single time. If I run it from the same thread there's no problem.
Here is the method I use for sending the http requests (the THttpCli object that is passed is shared among threads)
function sendHTTPRequest(APost: Boolean; AURI: UTF8string;
AContentType: UTF8string; APostData: UTF8String; AHttpCli: TSSLHttpCli): UTF8string;
var
DataOut: TMemoryStream;
DataIn: TMemoryStream;
lHTMLStream: TStringStream;
lencoding: TUTF8Encoding;
lownClient: boolean;
begin
lownClient := false;
if AHttpCli = nil then
begin
AHttpCli := TSSLHttpCli.Create(nil);
AHttpCli.SslContext := TSSLContext.Create(nil);
with AHttpCli.SslContext do
begin
SSLCipherList := 'ALL:!ADH:RC4+RSA:+SSLv2:#STRENGTH';
SSLVersionMethod := sslV23_CLIENT;
SSLVerifyPeerModes := [SslVerifyMode_PEER]
end;
AHttpCli.MultiThreaded := true;
lownClient := true;
end;
AHttpCli.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
if APost then
begin
DataOut := TMemoryStream.Create;
DataOut.Write(APostData[1], Length(APostData));
DataOut.Seek(0, soFromBeginning);
end;
AHttpCli.URL := AURI;
AHttpCli.ContentTypePost := AContentType;
DataIn := TMemoryStream.Create;
if APost then AHttpCli.SendStream := DataOut;
AHttpCli.RcvdStream := DataIn;
try
if apost then
AHttpCli.Post
else
AHttpCli.Get;
lHTMLStream := TStringStream.Create('', TEncoding.UTF8);
lHtmlStream.LoadFromStream(AHttpCli.RcvdStream);
result := lHtmlStream.DataString;
lHtmlStream.Free;
finally
AHttpCli.Close;
AHttpCli.RcvdStream := nil;
AHttpCli.SendStream := nil;
DataIn.Free;
if APost then
DataOut.Free;
if lownClient then
AHttpCli.free;
end;
end;
I suppose the obvious solution is to just have one thread that waits for a signal to execute, but I was hoping to get an explanation as to why the timeout happens. I have no way to explain why the second thread times out and the first does not.
The HTTP component seems to get stuck on the dnslookup. OverbyteICS uses the Windows function WSAAsyncGetHostByName to lookup the name.
Any help is much appreciated
UPDATE May 13, 2013:
So, as it turns out, sharing the THttpCli object among threads seems to be what causes the timeout. The Solution is simply to pass nil into the AHttpCli parameter in my function above.
I'll still accept an answer as to WHY this causes a timeout. As far as I could tell the WSAAsyncGetHostByName method doesn't use any synchronous objects and the other thread was not running at the same time so there shouldn't be anything blocking the threads.
On Windows, OverbyteICS uses WSAAsyncSelect (here) and MsgWaitForMultipleObjects (here) to allow asynchronous notification of the socket events (FD_READ, FD_WRITE, FD_CLOSE and FD_CONNECT). Part of the design of WSAAsyncSelect requires a window that will receive the event messages, and to that end, a control class is registered using RegisterClass here, and an instance created using CreateWindowEx here, both in the call to THttpCli.Create.
This is where the issue arises; as alluded to in the documentation for GetMessage, PeekMessage and PostMessage, the message queue itself is per thread.
I've tested various permutations of each discrete step of the process (listed below) shared between 2 threads, and the only combinations that fail are when the call to CreateWindowEx and MsgWaitForMultipleObjects are performed on different threads, which reinforces the idea that a given message queue can only be accessed on the same thread.
Seemingly, without a rewrite of the OverbyteICS library itself, the only way to use it in a threaded environment is to create the THttpCli instance in the same thread as the subsequent request calls (THttpCli.Get, THttpCli.Post etc).
Appendix
Call to RegisterClass
procedure Up0(S: PState);
var
WndClass: TWndClass;
begin
FillChar(WndClass, SizeOf(TWndClass), 0);
WndClass.lpfnWndProc := #DefWindowProc;
WndClass.hInstance := hInstance;
WndClass.lpszClassName := 'test';
if RegisterClass(WndClass) = 0 then
ExitProcess(GetLastError);
end;
Call to CreateWindowEx
procedure Up1(S: PState);
begin
S.Window := CreateWindowEx(WS_EX_TOOLWINDOW, 'test', '', WS_POPUP, 0, 0, 0, 0, 0, 0, hInstance, nil);
if S.Window = 0 then
ExitProcess(GetLastError);
end;
Call to Ics_socket
procedure Up2(S: PState);
begin
S.Socket := Ics_socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if S.Socket = INVALID_SOCKET then
ExitProcess(Ics_WSAGetLastError);
end;
Call to Ics_WSAAsyncSelect
procedure Up3(S: PState);
begin
if Ics_WSAAsyncSelect(S.Socket, S.Window, WM_USER, FD_CONNECT) = SOCKET_ERROR then
ExitProcess(Ics_WSAGetLastError);
end;
Call to Ics_connect
procedure Up4(S: PState);
var
Error: Integer;
Sin: TSockAddrIn;
begin
FillChar(Sin, SizeOf(TSockAddrIn), 0);
Sin.sin_family := AF_INET;
Sin.sin_port := Ics_htons(42);
if Ics_connect(S.Socket, PSockAddr(#Sin)^, SizeOf(TSockAddrIn)) = SOCKET_ERROR then
begin
Error := Ics_WSAGetLastError;
if Error <> WSAEWOULDBLOCK then
ExitProcess(Error);
end;
end;
Call to MsgWaitForMultipleObjects
procedure Up5(S: PState);
var
Msg: TMsg;
WaitResult: Cardinal;
begin
WaitResult := MsgWaitForMultipleObjects(0, Pointer(nil)^, False, 1000, QS_ALLINPUT);
if WaitResult = WAIT_TIMEOUT then
begin
S.Result := 0;
Exit;
end;
while PeekMessage(Msg, S.Window, WM_USER, WM_USER, PM_REMOVE) do
if LOWORD(Msg.lParam) = FD_CONNECT then
begin
S.Result := 1;
Exit;
end;
end;
I am using Russell Libby Pipes last modified in 2010. I have a TpServer sending/receiving messages with multiple TpClients. This worked fine under Delphi7 but now in XE (recently upgraded Pipes also to 2010) a string comes through with #0 between characters eg. '9'#0'8'#0'. I suspect Unicode is the problem but the solution has evaded me. Here are my Server send and Client receive routines. Any help is appreciated.
procedure TfrmServer.CommSend(aStr: String);
begin // Broadcast message; Messages are kept as short as possible
editSend.Text := aStr;
try
Size := editSend.GetTextBuf(Buffer, 250); // Put text into buffer
PipeServer.Broadcast(Buffer^, Size*2); // Send the message to the Clients
Application.ProcessMessages;
except
end;
end;
PROCEDURE TfrmClient.PipeMessage(Sender: TObject; Pipe: Cardinal; Stream: TStream);
VAR // Incoming message
xInStream: TStringStream;
xSize: Integer;
BEGIN // Message received from network
xInStream := TStringStream.Create('');
TRY
xSize := Stream.Size;
xInStream.CopyFrom(Stream, xSize); // Copy stream to local variable
editRcvd.Text := xInStream.DataString;
frmOptions.NetMessage(editRcvd.Text);
EXCEPT
ShowMessage('DMS Client - Message Error: ' + editRcvd.Text); // Debug
END;
xInStream.Free; // Erases any contents
END;
This is my first post here - so be gentle :-)
I want to build a client/server application that uses datasnap for data transport.
This is a fairly simple task - and there are lots of examples to learn from.
BUT - Having a Datasnap server (build from Delphi XE wizard) I find myself running into a problem, and I hope someone can guide me into the right direction.
Server and Client run on same PC (that is the design for now).
Server is running Session lifecycle.
Server and Client shares a class (posted below)..
The Server provides a simple method - GetServerObject which uses the GetNewObject method.
The Server itself is a VCL application - main form is fmServer.
OnCreate instatiates the Servers FormObject property (FormObject := TMyDataObject.Create);
function TServerMethods2.GetNewObject: TMyDataObject;
begin
Result := TMyDataObject.Create;
end;
function TServerMethods2.GetServerObject: TMyDataObject;
begin
Result := GetNewObject;
if not Result.Assign(fmServer.FormObject) then
raise Exception.Create('Server error : Assign failed!');
end;
All this is pretty trivial - and my problem only appears if I twist my Client application into a multithreaded monster :-) (read - more than 1 thread).
So here is the Thread code for the client.
TDataThread = class(TThread)
private
DSConn: TSQLConnection;
protected
procedure Execute; override;
public
constructor Create(aConn: TSQLConnection); overload;
end;
constructor TDataThread.Create(aConn: TSQLConnection);
begin
inherited Create(False);
DSConn := aConn.CloneConnection;
FreeOnTerminate := true;
end;
procedure TDataThread.Execute;
var
DSMethod: TServerMethods2Client;
aDataObject : TMyDataObject;
begin
NameThreadForDebugging('Data');
{ Place thread code here }
DSMethod := nil;
try
while not terminated do
begin
sleep(10);
if DSConn.Connected then
begin
try
if DSMethod = nil then
DSMethod := TServerMethods2Client.Create(DSConn.DBXConnection,false);
if DSMethod <> nil then
try
aDataObject := DSMethod.GetserverObject;
finally
freeandnil(aDataObject);
end;
except
freeandnil(DSMethod);
DSConn.Connected := False;
end
end
else
begin
// connect
try
sleep(100);
DSConn.Open;
except
;
end;
end;
end;
finally
freeandnil(DSMethod);
DSConn.Close;
freeandnil(DSConn);
end;
When I create more than 1 of these threads - eventually I will get an error (being "cannot instatiate ... " or some "remote dbx error ..." .. and so on.
I simply cannot get this to work - so that I can spawn hundreds of threads/connections to a datasnap server.
I know this question is tricky - but my hope is that someone is smarter than me :-)
If I try the same client thread code - but accessing a more simple server method (lets say echostring from sample) then I can run it with hundreds of threads.
Perhaps Im answering myself here - but Im too blind to realize it :-)
unit uDataObject;
interface
uses
SysUtils;
Type
TMyDataObject = class(TObject)
private
fString: String;
fInteger: Integer;
public
constructor Create; virtual;
destructor Destroy; override;
function Assign(aSource: TMyDataObject): boolean;
property aString: String read fString write fString;
property aInteger: Integer read fInteger write fInteger;
end;
implementation
{ TMyDataObject }
function TMyDataObject.Assign(aSource: TMyDataObject): boolean;
begin
if aSource <> nil then
begin
try
fString := aSource.aString;
fInteger := aSource.aInteger;
Result := True;
except
Result := false;
end;
end
else
Result := false;
end;
constructor TMyDataObject.Create;
begin
inherited;
Randomize;
fString := 'The time of creation is : ' + FormatDateTime('ddmmyyyy hh:nn:ss:zzz', Now);
fInteger := Random(100);
end;
destructor TMyDataObject.Destroy;
begin
inherited;
end;
end.
All help is appreciated
This has mostly been answered in the comments and the bug report, but... The problem you are seeing is caused by a multithreading issue in XE's marshaller code. If two threads (or two clients) call a server server method which takes in or return user defined types (any type which will use the marshaller/unmarshaller) at the same time, then an exception could happen.
I am unaware of a perfect workaround for XE, but if it is possible to not use user-defined types, then you shouldn't see multithreading issues.
Mat
When the simple server method is working, i think your problem has to be found i somethin the "real" code is doing or using.
It could be in the connection (try changing your simpler code to use the connection)
Your problem can also be then CloneConnection. The Cloned connection is freed, when the connection it is cloned from is freed. See
http://docwiki.embarcadero.com/VCL/en/SqlExpr.TSQLConnection.CloneConnection