unit rpTcpClientBase;

interface

uses
  Classes, Windows, Dialogs, SysUtils, Graphics, IniFiles;

Type
  TBaseModule = class;
  TPortHolder = class;
  TWorkThread = class;

  TWorkRecTagProp = (tpNormal, tpIrregular);
  TWorkRecTagFlag = (tfNone, tfInUse);

  PWorkRec =^TWorkRec;
  TWorkRec = record
    ptrMdl: TBaseModule;
    OpcTagMarker: Integer;
    TagVarType: integer;
    ValIn: Integer;
    ValOut: Integer;
    Changed: Boolean;
    GotOut: Boolean;
    Flags: Word;
    Address: string[6];
    TagName: string;
    Quality: word;
    Explotable: Boolean;
    TagProp: TWorkRecTagProp;
    TagFlag: TWorkRecTagFlag;
  end;


  TModuleStatusRec = record
    Tag: TWorkRec;
    Data: ^Integer;
  end;


  TBaseModuleClass = class of TBaseModule;

  TBaseModule = class(TObject)
  private
    procedure CustomIniLoad(IniFile: TCustomIniFile; IniGroupName: string);
    procedure CustomIniSave(IniFile: TCustomIniFile; IniGroupName: string);
  public
    AttempMax: Integer;
    Description: string;
    EmmulateModule: Boolean;
    Enable: Boolean;
    ErrorCount: Integer;
    ErrorFlag: Boolean;
    Name: string;
    NetAddr: integer;
    PortHolder: TPortHolder;
    TagCount: Integer;
    Tags: array of TWorkRec;
    StatusCount: Integer;
    Statuss: array of TModuleStatusRec;
    TimeCycle: Integer;
    TimePeriod: Integer;
    TypeName: string[16];

    DelayMs: Cardinal;
    DelayMsCnt: Cardinal;

    constructor Create; virtual;
    procedure DataReceive; virtual;
    function EditProps: Boolean; virtual;
    procedure Emmulate; virtual;
    procedure Load(IniFile: TIniFile; IniGroupName: string); virtual;
    procedure LoadSaveVals;
    procedure LoadTags; virtual;
    procedure Save(IniFile: TIniFile; IniGroupName: string); virtual;
    procedure GetCfg(var s: string); virtual;
    procedure SetCfg(s: string); virtual;
    procedure UnloadSaveVals;
    procedure UnloadTags; virtual;
    function GetFullTagName(idx: integer): string; virtual;
    function GetFullModuleName: string; virtual;
    procedure FirstPass;

    procedure UpdateStatusTags; virtual;
  protected
    procedure AddModuleStatusTag(sTagName: string; p: pointer; pTagVarType: integer);
  end;



  TPortHolder = class(TObject)
  private
    procedure CustomIniLoad(IniFile: TCustomIniFile; IniGroupName: string);
    procedure CustomIniSave(IniFile: TCustomIniFile; IniGroupName: string);
  public
    Count: Integer;
    EmmulateMode: Boolean;
    Enable: Boolean;
    Module: array of TBaseModule;
    Period: Cardinal;          
    InitOk: boolean;

    Thrd: TWorkThread;
    ThreadEnable: Boolean;
    Working: Boolean;

    constructor Create; virtual;
    destructor Destroy; override;
    function CanAddModule: boolean; virtual;
    procedure AddModule(M: TBaseModule); virtual;
    procedure DelModule(M: TBaseModule); virtual;
    function EditProps: Boolean; virtual;
    function GetAddMenuItem(idx: integer; var s: string): Boolean; virtual;
    function GetTextName: string; virtual;
    procedure Load(IniFile: TIniFile; IniGroupName: string); virtual;
    procedure Save(IniFile: TIniFile; IniGroupName: string); virtual;
    procedure GetCfg(var s: string); virtual;
    procedure SetCfg(s: string); virtual;
    function  Init: boolean; virtual;
    procedure StartAfterInit; virtual;
    procedure Stop; virtual;
    procedure ThreadDone(Sender: TObject); virtual;
  end;
  

  TWorkThread = class(TThread)
  protected
    PortHolder: TPortHolder;

    procedure Execute; override;
  public
    constructor CreateThread(P: TPortHolder);
  end;
  


implementation
uses
//  PComm,
  rpTcpClientGlobals,
  Numbers,
//  opcda,
  hyperstr;



//=======================================================================
{ TPortHolder }
//=======================================================================
{
********************************* TPortHolder **********************************
}
constructor TPortHolder.Create;
begin
  inherited Create;
  Enable := true;
  Working := false;
  Module := nil;
  Count := 0;
  EmmulateMode := false;
  Thrd := nil;
  ThreadEnable := false;
  Period := 500;
end;

destructor TPortHolder.Destroy;
var
  i: Integer;
begin
  for i:=0 to Count-1 do Module[i].Free;
  inherited;
end;

procedure TPortHolder.AddModule(M: TBaseModule);
begin
  inc(Count);
  SetLength(Module, Count);
  Module[Count-1] := M;
  Module[Count-1].PortHolder := self;
end;

procedure TPortHolder.DelModule(M: TBaseModule);
var
  i: Integer;
begin
  for i:=0 to Count-1 do
    if Module[i] = M then begin
      Module[i].Free;
      dec(Count);
      Module[i] := Module[Count];
      SetLength(Module, Count);
      break;
    end;
end;

function TPortHolder.EditProps: Boolean;
begin
  ShowMessage(GetTextName + ' EditProps');
  Result := false;
end;

function TPortHolder.GetAddMenuItem(idx: integer; var s: string): Boolean;
begin
  s := '';
  result:=false;
end;

function TPortHolder.GetTextName: string;
begin
  result := 'Abstact Port Holder';
end;

procedure TPortHolder.CustomIniLoad(IniFile: TCustomIniFile; IniGroupName: string);
begin
  Enable := IniFile.ReadBool(IniGroupName, 'Enable', true);
  Period := IniFile.ReadInteger(IniGroupName, 'Period', 500);
  EmmulateMode := IniFile.ReadBool(IniGroupName, 'EmmulateMode', false);
end;

procedure TPortHolder.CustomIniSave(IniFile: TCustomIniFile; IniGroupName: string);
begin
  IniFile.WriteString(IniGroupName, 'ClassName', ClassName);
  IniFile.WriteBool(IniGroupName, 'Enable', Enable);
  IniFile.WriteInteger(IniGroupName, 'Period', Period);
  IniFile.WriteBool(IniGroupName, 'EmmulateMode', EmmulateMode);
end;

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

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

procedure TPortHolder.GetCfg(var s: string);
var
  sl: TStringList;
  IniFile: TMemIniFile;
begin
//  inherited GetCfg(s)
  IniFile := TMemIniFile.Create('');
  CustomIniSave(IniFile, 'TPortHolder');

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

  IniFile.Free;
end;


procedure TPortHolder.SetCfg(s: string);
var
  sl: TStringList;
  IniFile: TMemIniFile;
begin
  IniFile := TMemIniFile.Create('');

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

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


procedure TPortHolder.StartAfterInit;
begin
  Working := true;
end;

procedure TPortHolder.Stop;
begin
  Working := false;
end;

procedure TPortHolder.ThreadDone(Sender: TObject);
var
  i: integer;
begin
  ThreadEnable := false;
  for i:=0 to Count-1 do Module[i].UnloadTags;
end;










//-----------------------------------------------------------------------
{ TWorkThread }
//-----------------------------------------------------------------------
{
********************************* TWorkThread **********************************
}
constructor TWorkThread.CreateThread(P: TPortHolder);
begin
  inherited Create(true);
  PortHolder := P;
end;

procedure TWorkThread.Execute;
var
  i: Integer;
  timeleft: cardinal;
begin
  PortHolder.ThreadEnable := true;

  while PortHolder.Working do begin
    timeleft := GetTickCount;

    for i:=0 to PortHolder.Count-1 do if PortHolder.Enable then begin
      if not PortHolder.Working then break;

      with PortHolder.Module[i] do
        if DelayMs>0 then
          if GetTickCount - DelayMsCnt > DelayMs then
            DelayMsCnt := GetTickCount
          else
            continue;


      if PortHolder.EmmulateMode then
        PortHolder.Module[i].Emmulate
      else
        PortHolder.Module[i].DataReceive;

    end;

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





//-----------------------------------------------------------------------
{ TBaseModule }
//-----------------------------------------------------------------------
{
********************************* TBaseModule **********************************
}
constructor TBaseModule.Create;
begin
  Name := '';
  TypeName := '';
  ErrorCount := -1;
  ErrorFlag := false;
  TimePeriod := 0;
  AttempMax := 3;
  Enable := true;

  TagCount := 0;
  Tags := nil;
  StatusCount := 0;
  Statuss := nil;

  DelayMs := 0;
end;

procedure TBaseModule.DataReceive;
begin
  UpdateStatusTags;
end;

function TBaseModule.EditProps: Boolean;
begin
  ShowMessage(Name + ' ' + Description + ' EditProps');
  result := false;
end;

procedure TBaseModule.Emmulate;
var
  i: Integer;
begin
  if not Enable then exit;
  
  if (ErrorCount<0) and (ErrorCount>-5) then begin
    dec(ErrorCount);
    exit;
  end else
    ErrorCount:=0;
  
  for i:=0 to TagCount-1 do with Tags[i] do begin
    if GotOut then begin
      ValIn := ValOut;
      GotOut := false;
      Changed := true;
    end;

  end;

  TimePeriod := random(500);

  UpdateStatusTags;
end;


function TBaseModule.GetFullTagName(idx: integer): string;
begin
  if idx<TagCount then
    result := Name + '.' + Tags[idx].TagName
  else
    result := '';
end;


procedure TBaseModule.LoadSaveVals;
var
  a, i, j, k, v: Integer;
  F: file of integer;
  s: string;
begin
  // Загрузка значений режима эммуляции
    s := rpTcpClientTempDir + Name + '.val';
    if FileExists(s) then begin
      AssignFile(F, s);
      try
        Reset(F);
        j:=0;
        while not eof(F) do begin
          Read(F, k, v);
          a := HexToInt( uppercase( '0' + Tags[j].Address ));
          if j<TagCount then
            if a = k then begin
              Tags[j].ValIn := v;
              inc(j);
              continue;
            end;
  
          for i:=0 to TagCount-1 do
            if a = k then begin
              Tags[j].ValIn := v;
              j := i+1;
              break;
            end;
        end;
      finally
        CloseFile(F);
      end;
    end;
end;



procedure TBaseModule.AddModuleStatusTag(sTagName: string; p: pointer; pTagVarType: integer);
begin
  SetLength(Statuss, StatusCount+1);

  with Statuss[StatusCount].Tag do begin
    ptrMdl := self;
    OpcTagMarker := 0;
    TagVarType := pTagVarType;
    ValIn := 0;
    ValOut := 0;
    Quality := 192;
    Changed := false;
    GotOut := false;
    Address := 's'+DecHexW(StatusCount);
    TagName := 'SYSTEM.' + sTagName;
  end;

  Statuss[StatusCount].Data := p;

  inc(StatusCount);
end;


procedure TBaseModule.LoadTags;
begin
  ErrorCount := -1;

  // Создание массива статус-тегов
  AddModuleStatusTag('ErrorCount', @ErrorCount, vtInteger);
  AddModuleStatusTag('ErrorFlag', @ErrorFlag, vtBoolean);
  AddModuleStatusTag('NetAddr', @NetAddr, vtInteger);
  AddModuleStatusTag('TimePeriod', @TimePeriod, vtInteger);

  UpdateStatusTags;
end;


procedure TBaseModule.CustomIniLoad(IniFile: TCustomIniFile; IniGroupName: string);
begin
  NetAddr        := HexToInt(uppercase(IniFile.ReadString(
                                        IniGroupName,       'Addr', '')));
  Name           := IniFile.ReadString( IniGroupName,       'Name', 'Module');
  Description    := IniFile.ReadString( IniGroupName,       'Descr', '');
  Enable         := IniFile.ReadBool(   IniGroupName,       'Enable', true);
  EmmulateModule := IniFile.ReadBool(   IniGroupName,       'Emmu', false);
  AttempMax      := IniFile.ReadInteger(IniGroupName,       'Retr', 5);
end;

procedure TBaseModule.CustomIniSave(IniFile: TCustomIniFile; IniGroupName: string);
begin
  IniFile.WriteString(  IniGroupName, 'ClassName', ClassName);
  IniFile.WriteString(  IniGroupName, 'Addr',   DecHexB(NetAddr));
  IniFile.WriteString(  IniGroupName, 'Name',   Name);
  IniFile.WriteString(  IniGroupName, 'Descr',  Description);
  IniFile.WriteBool(    IniGroupName, 'Enable', Enable);
  IniFile.WriteBool(    IniGroupName, 'Emmu',   EmmulateModule);
  IniFile.WriteInteger( IniGroupName, 'Retr',   AttempMax);
end;


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

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


procedure TBaseModule.GetCfg(var s: string);
var
  sl: TStringList;
  IniFile: TMemIniFile;
begin
  IniFile := TMemIniFile.Create('');
  CustomIniSave(IniFile, 'TBaseModule');

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


procedure TBaseModule.SetCfg(s: string);
var
  sl: TStringList;
  IniFile: TMemIniFile;
begin
  IniFile := TMemIniFile.Create('');

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

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


procedure TBaseModule.UnloadSaveVals;
var
  F: file of integer;
  i, k: Integer;
begin
  CreateDir(rpTcpClientTempDir);
  AssignFile(F, rpTcpClientTempDir + Name + '.val');
  try
    Rewrite(F);
    for i:=0 to TagCount-1 do begin
      k := HexToInt(uppercase(Tags[i].Address));
      write(F, k, Tags[i].ValIn);
    end;
  finally
    CloseFile(F);
  end;
end;

procedure TBaseModule.UnloadTags;
begin
  TagCount := 0;
  Tags := nil;
  StatusCount := 0;
  Statuss := nil;
end;



procedure TBaseModule.UpdateStatusTags;
var
  v,i: integer;

  procedure UpdateStatusTag;
  begin
    if Statuss[i].Tag.ValIn <> v then begin
      Statuss[i].Tag.ValIn := v;
      Statuss[i].Tag.Changed := true;
    end;
  end;

begin
  for i:=0 to StatusCount-1 do begin

    if Statuss[i].Tag.TagVarType = vtInteger then begin
      v := Statuss[i].Data^;
      UpdateStatusTag;
    end else
    if Statuss[i].Tag.TagVarType = vtBoolean then begin
      v := numbers.iif( pboolean(Statuss[i].Data)^, 1, 0);
      UpdateStatusTag;
    end;
  end;

end;

function TBaseModule.GetFullModuleName: string;
begin
  result := TypeName + ' - ' + Name;
end;

function TPortHolder.CanAddModule: boolean;
begin
  result := true;
end;

function TPortHolder.Init: boolean;
begin
  result := true;
end;

procedure TBaseModule.FirstPass;
begin
 //
end;

end.
