-1

我不是 Delphi 程序员，我需要对程序进行一些更改并重新编译。但是，问题是我无法重新编译已有的源代码。我已经追踪了这个问题，这似乎是因为 Delphi XE7 使用 Indy 10 而不是 Indy 9。而且由于 Indy 10 中不存在 TIdPeerThread 我得到错误。

如果您帮助我修改代码以使其与 Indy 10 兼容并且我可以在 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.
4

1 回答 1

2

如您所述，原始代码是为 Indy 9 编写的，因此需要将其更新为 Indy 10。

它似乎也是为预 Unicode 版本的 Delphi 编写的。ts是 的数组Char，AnsiChar在 Delphi 2007 及更早版本中，WideChar在 Delphi 2009 及更高版本中。而且 Indy 9 不支持 Unicode 版本的 Delphi。所以我会假设Char在这种情况下是AnsiChar.

也有一些小的逻辑问题。

这是一个 Indy 10 版本，有一些额外的修复/调整：

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.

话虽如此，由于原始代码似乎是为一次单个 TCP 连接而设计的，并且tcplink()发送命令并等待回复，因此可能会重写此代码以TIdSimpleServer使用TIdTCPServer. 不像TIdTCPServer,TIdSimpleServer不是一个多线程组件，所以它tcplink()可以更加独立和线性：等待连接，发送命令，读取回复，完成。不需要全局字符串变量、事件处理程序、忙等待等。

于 2015-02-11T18:59:21.903 回答