I am not a Delphi programmer and I need to do some changes in a program and re-compile. But, the problem is that I can not re-compile the source I already have. I have traced the problem, and it seems to be because of Delphi XE7 using Indy 10 instead of Indy 9. And since TIdPeerThread does not exist in Indy 10 I get errors.
I'll really appreciate it if you help me on how to modify the code so it is compatible with Indy 10 and I can recompile it in Delphi XE7.
library TCPServer;
uses
SysUtils,
Classes,
Forms,
IdTCPServer,
IdTCPClient,
Dialogs;
{$R *.res}
const
nInputs = 60;
nOutputs = 60;
type
ts = array[0..255] of char;
array_in = array[1..nInputs] of single;
array_out = array[1..nOutputs] of single;
Thelper = class
IdTCPServer: TIdTCPServer;
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure IdTCPServer1Connect(AThread: TIdPeerThread);
procedure IdTCPServer1DisConnect(AThread: TIdPeerThread);
end;
var
helper: Thelper;
server_to_be_send: string = '';
server_lastread: string = '';
firsttimecall : boolean = true;
inputvector_delay : array_in;
outputvector_delay : array_out;
time_old : single = -1.0;
procedure Thelper.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
try
Write('Connect from '+AThread.Connection.Socket.Binding.IP+':'+IntToStr(AThread.Connection.Socket.Binding.Port));
WriteLn(' (peer '+AThread.Connection.Socket.Binding.PeerIP+':'+IntToStr(AThread.Connection.Socket.Binding.PeerPort)+')');
except
end;
end;
procedure Thelper.IdTCPServer1DisConnect(AThread: TIdPeerThread);
begin
try
Write('Disconnect to '+AThread.Connection.Socket.Binding.IP+':'+IntToStr(AThread.Connection.Socket.Binding.Port));
WriteLn(' (peer '+AThread.Connection.Socket.Binding.PeerIP+':'+IntToStr(AThread.Connection.Socket.Binding.PeerPort)+')');
except
end;
end;
procedure Thelper.IdTCPServer1Execute(AThread: TIdPeerThread);
var
ii : Integer;
begin
IdTCPServer.OnExecute := nil;
while true do
begin
Application.ProcessMessages();
if (server_to_be_send<>'') then
begin
AThread.Connection.WriteLn(server_to_be_send);
server_to_be_send := '';
server_lastread := AThread.Connection.ReadLn('*',5000);
if server_lastread='' then
for ii:=1 to nInputs do server_lastread := server_lastread + '0;';
end;
end;
end;
Procedure tcplink(na:integer;var inputvector : array_in;
nb:integer;var outputvector: array_out);stdcall;
var
i : Integer;
st : string;
begin
// Ensure English locale decimal separator symbol
DecimalSeparator := '.';
if firsttimecall then
begin
firsttimecall := false;
helper := Thelper.Create();
helper.IdTCPServer := TIdTCPServer.Create(nil);
helper.IdTCPServer.OnExecute := helper.IdTCPServer1Execute;
helper.IdTCPServer.OnConnect := helper.IdTCPServer1Connect;
helper.IdTCPServer.OnDisconnect := helper.IdTCPServer1DisConnect;
helper.IdTCPServer.DefaultPort := 1239;
try
helper.IdTCPServer.Active := true;
if helper.IdTCPServer.Active then
Writeln('TCP/IP host ready, default port: '+IntToStr(helper.IdTCPServer.DefaultPort));
except
Writeln('*** Could not start TCP/IP server ***');
end;
end;
st := IntToStr(nInputs)+';'; for i:=1 to nInputs do st := st + FloatToStr(inputvector[i])+';';
server_lastread := '';
server_to_be_send := st;
while (server_lastread='') do Application.ProcessMessages();
st := server_lastread;
server_lastread := '';
for i:=1 to nOutputs do
begin
if Length(st) < 1 then
begin
outputvector[i] := 0;
end
else
begin
outputvector[i] := StrToFloat(copy(st,1,AnsiPos(';',st)-1));
st := copy(st,AnsiPos(';',st)+1,MaxInt);
end;
end;
end;
// Only call tcplink when time has changed
Procedure tcplink_delay(na:integer;var inputvector : array_in;
nb:integer;var outputvector: array_out);stdcall;
var
i : Integer;
begin
if inputvector[1] > time_old then
begin
tcplink(na, inputvector_delay, nb, outputvector_delay);
time_old := inputvector[1];
end;
for i :=1 to nInputs do inputvector_delay[i] := inputvector[i];
for i :=1 to nOutputs do outputvector[i] := outputvector_delay[i];
end;
Procedure tcplink_init(var string256:ts; length:integer);stdcall;
var
init_str : string[255];
onPos : Integer;
begin
init_str:=strpas(string256);
// Crop trailing blanks
onPos := AnsiPos(' ', init_str);
SetLength(init_str, onPos-1);
if firsttimecall then
begin
firsttimecall := false;
helper := Thelper.Create();
helper.IdTCPServer := TIdTCPServer.Create(nil);
helper.IdTCPServer.OnExecute := helper.IdTCPServer1Execute;
helper.IdTCPServer.OnConnect := helper.IdTCPServer1Connect;
helper.IdTCPServer.OnDisconnect := helper.IdTCPServer1DisConnect;
helper.IdTCPServer.DefaultPort := StrToInt(init_str);
try
helper.IdTCPServer.Active := true;
if helper.IdTCPServer.Active then
Writeln('TCP/IP host ready, selected port: '+IntToStr(helper.IdTCPServer.DefaultPort));
except
Writeln('*** Could not start TCP/IP server ***');
end;
end;
end;
Procedure tcplink_delay_init(var string256:ts; length:integer);stdcall;
begin
tcplink_init(string256, length);
end;
exports
tcplink, tcplink_delay, tcplink_init, tcplink_delay_init;
begin
end.
As you noted, the original code was written for Indy 9, so it needs to be updated to Indy 10.
It also appears to have been written for a pre-Unicode version of Delphi. ts is an array of Char, which is AnsiChar in Delphi 2007 and earlier, and WideChar in Delphi 2009 and later. And Indy 9 does not support Unicode versions of Delphi. So I would assume that Char in this case is intended to be AnsiChar.
There are also some small logic issues being made as well.
Here is an Indy 10 version, with some additional fixes/tweaks:
library TCPServer;
uses
SysUtils,
Classes,
Forms,
IdContext,
IdTCPServer,
Dialogs;
{$R *.res}
const
nInputs = 60;
nOutputs = 60;
type
ts = array[0..255] of AnsiChar;
array_in = array[1..nInputs] of Single;
array_out = array[1..nOutputs] of Single;
Thelper = class
IdTCPServer: TIdTCPServer;
destructor Destroy; override;
procedure IdTCPServer1Execute(AContext: TIdContext);
procedure IdTCPServer1Connect(AContext: TIdContext);
procedure IdTCPServer1DisConnect(AContext: TIdContext);
end;
var
helper: Thelper = nil;
server_to_be_send: string = '';
server_lastread: string = '';
inputvector_delay : array_in;
outputvector_delay : array_out;
time_old : single = -1.0;
destructor Thelper.Destroy;
begin
IdTCPServer.Active := false;
IdTCPServer.Free;
inherited;
end;
procedure Thelper.IdTCPServer1Connect(AContext: TIdContext);
var
s: string;
begin
s := Format('Connect on %s:%d (peer %s:%d)', [AContext.Binding.IP, AContext.Binding.Port, AContext.Binding.PeerIP, AContext.Binding.PeerPort]);
WriteLn(s);
end;
procedure Thelper.IdTCPServer1DisConnect(AContext: TIdContext);
var
s: string;
begin
s := Format('Disconnect from %s:%d (peer %s:%d)', [AContext.Binding.IP, AContext.Binding.Port, AContext.Binding.PeerIP, AContext.Binding.PeerPort]);
WriteLn(s);
end;
procedure Thelper.IdTCPServer1Execute(AContext: TIdContext);
var
ii : Integer;
s : string;
begin
if (server_to_be_send <> '') then
begin
try
AContext.Connection.IOHandler.WriteLn(server_to_be_send);
finally
server_to_be_send := '';
end;
s := AContext.Connection.IOHandler.ReadLn('*', 5000);
if s = '' then
begin
for ii := 1 to nInputs do
s := s + '0;';
end;
server_lastread := s;
end else begin
Sleep(10);
end;
end;
procedure tcplink(na: Integer; var inputvector: array_in;
nb: Integer; var outputvector: array_out); stdcall;
var
i : Integer;
st : string;
t: Cardinal;
begin
if helper = nil then
begin
helper := Thelper.Create;
helper.IdTCPServer := TIdTCPServer.Create(nil);
helper.IdTCPServer.OnExecute := helper.IdTCPServer1Execute;
helper.IdTCPServer.OnConnect := helper.IdTCPServer1Connect;
helper.IdTCPServer.OnDisconnect := helper.IdTCPServer1DisConnect;
helper.IdTCPServer.DefaultPort := 1239;
helper.IdTCPServer.MaxConnections := 1;
end;
if not helper.IdTCPServer.Active then
try
helper.IdTCPServer.Active := true;
Writeln('TCP/IP host ready, default port: '+IntToStr(helper.IdTCPServer.DefaultPort));
except
Writeln('*** Could not start TCP/IP server ***');
Exit;
end;
st := IntToStr(nInputs)+';';
for i:=1 to nInputs do st := st + FloatToStr(inputvector[i])+';';
server_lastread := '';
server_to_be_send := st;
t := Ticks;
while (server_lastread = '') and (GetTickDiff(t, Ticks) < 10000) do
Application.ProcessMessages;
st := server_lastread;
server_lastread := '';
for I := 1 to nOutputs do
begin
if Length(st) < 1 then begin
outputvector[i] := 0;
end else
begin
outputvector[i] := StrToFloat(Copy(st,1,Pos(';',st)-1));
st := Copy(st,Pos(';',st)+1,MaxInt);
end;
end;
end;
// Only call tcplink when time has changed
procedure tcplink_delay(na: Integer; var inputvector : array_in;
nb: Integer; var outputvector: array_out); stdcall;
var
i : Integer;
begin
if inputvector[1] > time_old then
begin
tcplink(na, inputvector_delay, nb, outputvector_delay);
time_old := inputvector[1];
end;
for i :=1 to nInputs do inputvector_delay[i] := inputvector[i];
for i :=1 to nOutputs do outputvector[i] := outputvector_delay[i];
end;
procedure tcplink_init(var string256: ts; length: Integer); stdcall;
var
init_str : string;
onPos : Integer;
begin
init_str := strpas(string256);
// Crop trailing blanks
onPos := Pos(' ', init_str);
SetLength(init_str, onPos-1);
if helper = nil then
begin
helper := Thelper.Create;
helper.IdTCPServer := TIdTCPServer.Create(nil);
helper.IdTCPServer.OnExecute := helper.IdTCPServer1Execute;
helper.IdTCPServer.OnConnect := helper.IdTCPServer1Connect;
helper.IdTCPServer.OnDisconnect := helper.IdTCPServer1DisConnect;
helper.IdTCPServer.MaxConnections := 1;
end;
if not helper.IdTCPServer.Active then
try
helper.IdTCPServer.DefaultPort := StrToInt(init_str);
helper.IdTCPServer.Active := true;
Writeln('TCP/IP host ready, selected port: '+IntToStr(helper.IdTCPServer.DefaultPort));
except
Writeln('*** Could not start TCP/IP server ***');
Exit;
end;
end;
procedure tcplink_delay_init(var string256: ts; length: Integer); stdcall;
begin
tcplink_init(string256, length);
end;
procedure tcplink_cleanup; stdcall;
begin
FreeAndNil(helper);
end;
exports
tcplink, tcplink_delay, tcplink_init, tcplink_delay_init, tcplink_cleanup;
begin
// Ensure English locale decimal separator symbol
FormatSettings.DecimalSeparator := '.';
end.
That being said, since the original code appears to be designed for a single TCP connection at a time, and tcplink() sends a command and waits for a reply, this code could probably be re-written to use TIdSimpleServer instead of TIdTCPServer. Unlike TIdTCPServer, TIdSimpleServer is not a multi-threaded component, so it would allow tcplink() to be more self-contained and linear: wait for a connection, send a command, read a reply, done. No need for global string variables, event handlers, busy waits, etc.