unit TcpPortHolder;

interface

uses
  rpTcpClientBase, Classes, Windows, Dialogs, SysUtils, Graphics, IniFiles, Controls,
  IdTCPClient;


type
  TTcpPortHolder = class(TPortHolder)
  private
    function  ConnectToServer(msg_mode: boolean): boolean;
    procedure CustomIniLoad(IniFile: TCustomIniFile; IniGroupName: string);
    procedure CustomIniSave(IniFile: TCustomIniFile; IniGroupName: string);
  public
    Host: string;
    Port: integer;
    TimeReconnect: cardinal;
    Clnt: TIdTCPClient;
    ConnectBad: integer;
    ConnectBadCounter: integer;
    CommandModeConnected: boolean;

    constructor Create; override;
    function GetTextName: string; override;
    procedure Load(IniFile: TIniFile; IniGroupName: string); override;
    procedure Save(IniFile: TIniFile; IniGroupName: string); override;

    procedure GetCfg(var s: string); override;
    procedure SetCfg(s: string); override;

    function  Init: boolean; override;
    procedure StartAfterInit; override;
    procedure ThreadDone(Sender: TObject); override;

    function CanAddModule: boolean; override;

    function CommandModeConnect: boolean; virtual;
    procedure CommandModeDisconnect; virtual;
    function SendCommand(cmdnum: integer; cmdtext: string): string; virtual;
  end;


  TTcpPortThread = class(TWorkThread)
  protected
    procedure Execute; override;
  end;


implementation
uses
  infodlg,
  rpTcpClientGlobals,
  Numbers,
  hyperstr,
  TcpImportClient;


{
******************************** TTcpPortHolder ********************************
}
constructor TTcpPortHolder.Create;
begin
  inherited Create;
  Clnt := nil;
  Host := 'localhost';
  Port := 3033;
  TimeReconnect := 60;
  CommandModeConnected := false;
end;


function TTcpPortHolder.GetTextName: string;
begin
  result := 'TCP ' + Host + ':' + inttostr(port);
end;

procedure TTcpPortHolder.CustomIniLoad(IniFile: TCustomIniFile; IniGroupName: string);
begin
  Host := IniFile.ReadString(IniGroupName, 'Host', 'localhost');
  Port := IniFile.ReadInteger(IniGroupName, 'Port', 3033);
  TimeReconnect := IniFile.ReadInteger(IniGroupName, 'TimeReconnect', 60);
end;

procedure TTcpPortHolder.CustomIniSave(IniFile: TCustomIniFile; IniGroupName: string);
begin
  IniFile.WriteString(IniGroupName, 'Host', Host);
  IniFile.WriteInteger(IniGroupName, 'Port', Port);
  IniFile.WriteInteger(IniGroupName, 'TimeReconnect', TimeReconnect);
end;

procedure TTcpPortHolder.Load(IniFile: TIniFile; IniGroupName: string);
begin
  inherited;
  CustomIniLoad(IniFile, IniGroupName);
end;

procedure TTcpPortHolder.Save(IniFile: TIniFile; IniGroupName: string);
begin
  inherited;
  CustomIniSave(IniFile, IniGroupName);
end;

procedure TTcpPortHolder.GetCfg(var s: string);
var
  sl: TStringList;
  IniFile: TMemIniFile;
begin
  inherited GetCfg(s);

  IniFile := TMemIniFile.Create('');
  CustomIniSave(IniFile, 'TTcpPortHolder');

  sl := TStringList.Create;
  IniFile.GetStrings(sl);
  s := s + sl.text;
  sl.Free;

  IniFile.Free;
end;


procedure TTcpPortHolder.SetCfg(s: string);
var
  sl: TStringList;
  IniFile: TMemIniFile;
begin
  inherited SetCfg(s);

  IniFile := TMemIniFile.Create('');

  sl := TStringList.Create;
  sl.text := s;
  IniFile.SetStrings(sl);
  sl.Free;

  CustomIniLoad(IniFile, 'TTcpPortHolder');
  IniFile.Free;
end;


function TTcpPortHolder.Init: boolean;
var
  fl: boolean;
  i: integer;
begin
  result := false;
  InitOk := false;
  if not Enable then
    exit;

  // отключаем командный режим, если тот включен
  CommandModeDisconnect;

  fl := true;
  if not EmmulateMode then begin
    if Clnt=nil then
      Clnt := TIdTCPClient.Create;
    Clnt.Port := Port;
    Clnt.Host := Host;
    fl := ConnectToServer(false);
  end;

  for i:=0 to Count-1 do begin
    Module[i].LoadTags;
  end;
  
  Working := true;
  ConnectBad := iif(fl, 0, 1);
  InitOk := fl;
  result := fl;
end;

procedure TTcpPortHolder.StartAfterInit;
begin
  inherited;
  if InitOk then begin
    Thrd := TTcpPortThread.CreateThread(Self);
    Thrd.OnTerminate := ThreadDone;
    sleep(100);
    Thrd.Resume;
  end;
end;


function TTcpPortHolder.ConnectToServer(msg_mode: boolean): boolean;
var
  s: string;
  fl: boolean;
begin
  fl := true;

  if fl then
    try
      Clnt.Connect;
      Clnt.IOHandler.ReadTimeout := 60000;
    except
      if msg_mode then ShowInfoDlg('Ошибка соединения с сервером ' + Host + ':' + IntToStr(Port),
            mtError, [mbOk], 0);
      fl:=false;
    end;

  if fl then
    try
      if Clnt.IOHandler.ReadLnTimedout then
        if msg_mode then showmessage('ReadLnTimedout');
      Clnt.IOHandler.ReadLn;
      s := Clnt.IOHandler.ReadLn;
    except
      if msg_mode then ShowInfoDlg('Сервер ' + Host + ':' + IntToStr(Port) + ' не отвечает',
            mtError, [mbOk], 0);
      fl:=false;
    end;

  if fl then
    if not SameText( uppercase(trim(s)), '100 RPSVRTCP VER3') then begin
      if msg_mode then ShowInfoDlg('Сервер ' + Host + ':' + IntToStr(Port) + ' использует другую '+
            'версию протокола - "'+s+'"',
            mtError, [mbOk], 0);
      fl:=false;
    end;

  result := fl;
end;


procedure TTcpPortHolder.ThreadDone(Sender: TObject);
begin
  inherited ThreadDone(Sender);

  // Выключение TCP-клиента
  if not(EmmulateMode) then begin
    try
      Clnt.Disconnect;
    except end;
      
    Clnt.Free;
    Clnt := nil;
  end;

end;





{ TTcpPortThread }

procedure TTcpPortThread.Execute;
var
  i,k: integer;
  timeleft, timegood: cardinal;
  fl: boolean;
begin
  timegood := 0;

  PortHolder.ThreadEnable := true;
  (PortHolder as TTcpPortHolder).ConnectBadCounter := 0;

  while PortHolder.Working do begin
    timeleft := GetTickCount;

    // проверка связи
    fl := false;
    try
      fl := (PortHolder as TTcpPortHolder).Clnt.Connected;
    except
    end;

    (PortHolder as TTcpPortHolder).ConnectBad := iif(fl, 0, 1);

    if fl then begin
      (PortHolder as TTcpPortHolder).ConnectBadCounter := 0;

      // если есть связь
      // то выполнить прием/передачу
      for i:=0 to PortHolder.Count-1 do begin
        if PortHolder.EmmulateMode then
          PortHolder.Module[i].Emmulate
        else
          PortHolder.Module[i].DataReceive;
      end;
      timegood := GetTickCount;
    end

    else with PortHolder as TTcpPortHolder do begin

      // если нет связи
      // более времени переподключения, то отключится и подключиться снова
      for i:=0 to PortHolder.Count-1 do
        PortHolder.Module[i].UpdateStatusTags;

      if (GetTickCount-timegood) > (TimeReconnect * 1000) then
      try
        timegood := GetTickCount;

        try
          Clnt.Disconnect;
        except
        end;  

        if ConnectToServer(false) then begin
          // если успешно подключились, выполнить сверку списков тегов
          // для каждого модуля
          for i:=0 to PortHolder.Count-1 do
            if PortHolder.Module[i] is TTcpImportClientModule then begin
              k := (PortHolder.Module[i] as TTcpImportClientModule).CustomLoadTags(true);

              // если сверка не прошла, загнать во все теги модуля -1.
              if k in [1,2] then begin
                for k:=0 to PortHolder.Module[i].TagCount-1 do

                  if PortHolder.Module[i].Tags[k].ValIn <> -1 then begin
                    PortHolder.Module[i].Tags[k].ValIn := -1;
                    PortHolder.Module[i].Tags[k].Changed := true;
                  end;
              end;

             (PortHolder.Module[i] as TTcpImportClientModule).NeedToGetAll := true;
            end;
        end else
          inc(ConnectBadCounter);

        timegood := GetTickCount;
      except
      end;
    end;

    repeat
      sleep(1);
    until GetTickCount - timeleft >= PortHolder.Period;
  end;

end;

function TTcpPortHolder.CanAddModule: boolean;
begin
  result := Count=0;
  if not result then
    ShowInfoDlg('TCP-порт может иметь не более одного клиента', mtError, [mbOk], 0);
end;


////////////////////////////////////////////////////////////////////////////////
//                              COMMAND MODE
////////////////////////////////////////////////////////////////////////////////
// Командный режим включается вместо стандарного режима обмена данными.
// Эти режимы не могут использоваться одновременно - либо один, либо другой.
////////////////////////////////////////////////////////////////////////////////
// SEND COMMAND
function TTcpPortHolder.SendCommand(cmdnum: integer;
  cmdtext: string): string;
var
  s: string;
begin
  if not Enable then exit;
  if EmmulateMode then exit;
  try
    clnt.IOHandler.WriteLn(cmdtext);
    s := Clnt.IOHandler.ReadLn;
  except
    s:='';
  end;
  result := s;
end;

// CONNECT COMMAND MODE
function TTcpPortHolder.CommandModeConnect: boolean;
begin
  result := true;
  if CommandModeConnected then exit;

  CommandModeConnected := true;
  if EmmulateMode then exit;

  result := false;
  CommandModeConnected := false;
  if not Enable then exit;
  if Clnt<>nil then exit;

  try
    if Clnt=nil then
      Clnt := TIdTCPClient.Create;
    Clnt.Port := Port;
    Clnt.Host := Host;
    CommandModeConnected := ConnectToServer(false);
  except
    CommandModeConnected := false;
  end;

  if not CommandModeConnected then begin
    Clnt.Free;
    Clnt := nil;
  end;

  result := CommandModeConnected;  
end;

// DISCONNECT COMMAND MODE
procedure TTcpPortHolder.CommandModeDisconnect;
begin
  if not CommandModeConnected then exit;
  if EmmulateMode then exit;
  if not Enable then exit;
  if Clnt=nil then exit;

  try
    Clnt.Disconnect;
  except
  end;

  CommandModeConnected := false;
  Clnt.Free;
  Clnt := nil;
end;

end.
