unit TcpImportClient;

interface

uses
  IdTCPClient,
  IdIOHandler,
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, rpTcpClientBase, inifiles;

Const
  TcpImp_Final_Mark: char = '=';
  TcpImp_Continue_Mark: char = '~';

type
  TTcpImportClientModule = class(TBaseModule)
  private
    strCrcH: AnsiString;
    strCrcL: AnsiString;
    crcH,crcL: Integer;
    useCrcTags: boolean;
    crcTags: string;
    crcErrorCnt: Integer;
    NeedToReadTagProps: boolean;

    function CheckClientObject: boolean;
    function GetAnswer(answ: string; check_crc: boolean; var s: string;
          var end_mark: char): boolean;
    procedure CustomIniLoad(IniFile: TCustomIniFile; IniGroupName: string);
    procedure CustomIniSave(IniFile: TCustomIniFile; IniGroupName: string);
    function parseRecievedValues(clnt: TIdTCPClient; get_cmd, get_answ: string): boolean;
  public
    TagFilterStr: string;
    ReadOnly: boolean;
    NeedToGetAll: boolean;

    ParsedTagnames: array of string;
    DataValid: integer;       // 0-ok, 1-загружены из файла, 2-недостоверны

    ExtraTagList: TStringList;
    TagList: TStringList;

    constructor Create; override;
    destructor Destroy; override;
    procedure DataReceive; override;

    procedure Emmulate; override;
    procedure Load(IniFile: TIniFile; IniGroupName: string); override;
    procedure LoadTags; override;
    function  CustomLoadTags(check_mode: boolean): integer;
    procedure Save(IniFile: TIniFile; IniGroupName: string); override;

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

    procedure UnloadTags; override;
    function GetFullTagName(idx: integer): string; override;

    function GetTagIndex(TagName: string): integer;

  end;


implementation
uses
//  TcpImportClientProp,
  TcpPortHolder,
  numbers,
  hyperstr,
//  OpcTagnameParser,
  rpTcpClientGlobals;

{
**************************** TTcpImportClientModule ****************************
}
constructor TTcpImportClientModule.Create;
begin
  inherited Create;
  TypeName := 'ImportClient';
  Name := 'Module';
  TagFilterStr := '*';
  ReadOnly := false;
  ParsedTagnames := nil;

  ExtraTagList := TStringList.Create;
  ExtraTagList.Sorted := true;
  ExtraTagList.Duplicates := dupIgnore;

  TagList := TStringList.Create;
  TagList.Sorted := true;
  TagList.Duplicates := dupIgnore;

end;


procedure TTcpImportClientModule.Emmulate;
begin
  inherited Emmulate;
end;

procedure TTcpImportClientModule.CustomIniLoad(IniFile: TCustomIniFile; IniGroupName: string);
begin
  TagFilterStr := IniFile.ReadString(IniGroupName, 'TagFilterStr', '*');
  ReadOnly := IniFile.ReadBool(IniGroupName, 'ReadOnly', false);
end;

procedure TTcpImportClientModule.CustomIniSave(IniFile: TCustomIniFile; IniGroupName: string);
begin
  IniFile.WriteString(IniGroupName, 'TagFilterStr', TagFilterStr);
  IniFile.WriteBool(IniGroupName, 'ReadOnly', ReadOnly);
end;

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

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

procedure TTcpImportClientModule.UnloadTags;
begin
  inherited UnloadTags;
end;


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

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

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

  IniFile.Free;
end;

procedure TTcpImportClientModule.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, 'TTcpImportClientModule');
  IniFile.Free;
end;

function TTcpImportClientModule.CheckClientObject: boolean;
begin
  result := false;
  with PortHolder as TTcpPortHolder do begin
    if Clnt = nil then exit;
    if Clnt.IOHandler = nil then exit;
  end;
  result := true;
end;



function TTcpImportClientModule.GetAnswer(answ: string; check_crc: boolean;
  var s: string; var end_mark: char): boolean;
var
  i,j,k: integer;  
begin
  result:=false;
{
  with (PortHolder as TTcpPortHolder).Clnt do begin
    try
      s := IOHandler.ReadLn;
    except
      s := '';
    end;
    if (IOHandler.ReadLnTimedout) or (not SameText(copy(s,1,length(answ)), answ)) then begin
      s := s + #13 + IOHandler.ReadLn;
      exit;
    end;
  end;
 }

  try
   with (PortHolder as TTcpPortHolder).Clnt do begin
    s := IOHandler.ReadLn;

    while( not IOHandler.InputBufferIsEmpty ) do begin
      s := s + IOHandler.ReadLn;
//      LoggerSaveMessage('TcpImportClient ' + GetFullModuleName + ' GetAnswer double line: ' + s  );
    end;

    if (IOHandler.ReadLnTimedout) then begin
//      LoggerSaveMessage('TcpImportClient ' + GetFullModuleName + ' GetAnswer timeout: ' + s );
      exit;
    end;

    if (not SameText(copy(s,1,length(answ)), answ)) then begin
//      LoggerSaveMessage('TcpImportClient ' + GetFullModuleName + ' GetAnswer bad answer: ' +
//            copy(s,1,length(answ)) + ' != ' + s );
      exit;
    end;
   end;
  except
    s := '';
    exit;
  end;

  delete(s,1,4);

  if check_crc then begin

    k:=pos(TcpImp_Continue_Mark, s);
    if k=0 then begin
      end_mark := TcpImp_Final_Mark;
      k:=pos(TcpImp_Final_Mark, s);
    end else
      end_mark := TcpImp_Continue_Mark;

    j:=length(s)-k;
    i:=HexToInt(uppercase(copy(s,k+1,j)));
    delete(s,k,j+1);
    if CRC16($FFFF, s) <> i then exit;
  end;

  result:=true;
end;

////////////////////////////////////////////////////////////////////////////////
// Загрузка тегов с удаленного сервера
////////////////////////////////////////////////////////////////////////////////
procedure TTcpImportClientModule.LoadTags;
var
  prt: TTcpPortHolder;
  i,n: Integer;
begin
  inherited LoadTags;
  CustomLoadTags(false);

  prt := PortHolder as TTcpPortHolder;

  StatusCount := 0;

  AddModuleStatusTag(prt.Host + '_' + inttostr(prt.Port)+'_HostError', @prt.ConnectBad, vtInteger);
  AddModuleStatusTag(prt.Host + '_' + inttostr(prt.Port)+'_DataValid', @DataValid, vtInteger);
  AddModuleStatusTag('CrcErrorCnt', @crcErrorCnt, vtInteger);

  n := Length(Tags)-1;
  TagList.Clear;
  for i:=0 to n do
    TagList.AddObject(tags[i].TagName, Pointer(i));

  NeedToReadTagProps := true;
end;


function TTcpImportClientModule.CustomLoadTags(check_mode: boolean): integer;
var
  clnt: TIdTCPClient;
  attempt, i,j,k,n: integer;
  s,ss: string;
  c: char;
//  prs: TOpcTagnameParser;
  F: TextFile;
begin
  useCrcTags := true;

  result:=255;

  if CheckClientObject then begin
    clnt := (PortHolder as TTcpPortHolder).Clnt;
    attempt := 0;

    while attempt<AttempMax do begin
      try
        // SETFILTER
        clnt.IOHandler.WriteLn('SETFILTER ' + TagFilterStr );
        if not GetAnswer('101 OK', false, s, c) then raise Exception.Create('');

        // GETFILTER
        clnt.IOHandler.WriteLn('GETFILTER');
        if not GetAnswer('102 '''+TagFilterStr+'''', false, s, c) then raise Exception.Create('');



        // CLEAREXTRALIST
        clnt.IOHandler.WriteLn('CLEAREXTRALIST');
        if GetAnswer('112 OK', false, s, c) then begin
        
          // ADDEXTRATAG
          for i:=0 to ExtraTagList.Count-1 do begin
            clnt.IOHandler.WriteLn('ADDEXTRATAG ' + ExtraTagList[i]);
            if not GetAnswer('111 OK', false, s, c) then raise Exception.Create('');
          end;
        end;


        // CREATETAGLIST
        clnt.IOHandler.WriteLn('CREATETAGLIST');
        if not GetAnswer('103', false, s, c) then
          raise Exception.Create('');

        n := HexToInt(uppercase(s));

        if check_mode then begin
          if n > TagCount then begin
            result := 1;
            DataValid := 2;
            exit;
          end;
        end else begin
          TagCount := n;
          SetLength(Tags, TagCount);
          SetLength(strCrcH, TagCount);
          SetLength(strCrcL, TagCount);
          SetLength(ParsedTagnames, TagCount);
        end;

        if not check_mode then for i:=0 to TagCount-1 do Tags[i].TagName:='';


        // GETTAGLIST
        i:=0;
        repeat
          clnt.IOHandler.WriteLn('GETTAGLIST ' + IntToHex(i, 1));
          if not GetAnswer('104', true, s, c) then raise Exception.Create('');

          k := pos('#',s);
          n := HexToInt(uppercase(copy(s,1,k-1)));
          delete(s,1,k);
          if n=0 then break;

          k := pos('!',s);
          j := HexToInt(uppercase(copy(s,1,k-1)));
          delete(s,1,k);

          n := n+j-1;
          if (j<i) or (n>=TagCount) then Exception.Create('');

          k:=1;
          for i:=j to n do begin
            ss := trim(Parse(s,';',k));
            if (length(ss)=0) or (k<1) or (k>length(s)) then Exception.Create('');

            with Tags[i] do if check_mode then begin
              if not( (SameText(TagName, ss)) and (SameText(Address,DecHexW(i))) ) then begin
                result := 2;
                DataValid := 2;
                exit;
              end;
            end else begin
              ptrMdl := self;
              OpcTagMarker := 0;
              TagVarType := varInteger;
              ValIn := 0;
              ValOut := 0;
              Changed := false;
              GotOut := false;
              Flags := 0;
              Address := DecHexW(i);
              TagName := ss;
              Explotable := False;
              TagProp := tpNormal;
              TagFlag := tfNone;
            end;

          end;

          i:=n+1;
        until i>=TagCount;

        // Создание ParsedTagnames
        for i:=0 to TagCount-1 do begin
          s := Tags[i].TagName;
          ParsedTagnames[i] := s;
        end;



        // запись списка имен тегов в файл
        CreateDir(rpTcpClientTempDir);
        AssignFile(F, rpTcpClientTempDir + TypeName + '_' + Name + '.dat');
        try
          rewrite(F);
          writeln(F, inttostr(TagCount) );
          for i:=0 to TagCount-1 do begin
            writeln(F, Tags[i].TagName);
            writeln(F, ParsedTagnames[i]);
          end;
        finally
          try
            CloseFile(F);
          except end;
        end;


        result := 0;
        DataValid := 0;
        break;
      except
      end;

      inc(attempt);
    end;
  end;

  // загрузка списка тегов из файла
  if result = 255 then begin
    if fileexists(rpTcpClientTempDir + TypeName + '_' + Name + '.dat') then begin
      AssignFile(F, rpTcpClientTempDir + TypeName + '_' + Name + '.dat');
      try
        Reset(F);
        readln(F, s);
        val(s, TagCount, i);
        SetLength(Tags, TagCount);
        SetLength(ParsedTagnames, TagCount);
        SetLength(strCrcH, TagCount);
        SetLength(strCrcL, TagCount);

        if TagCount > 0 then
          for i:=0 to TagCount-1 do begin

            readln(F, s);
            with Tags[i] do begin
              ptrMdl := self;
              OpcTagMarker := 0;
              TagVarType := varInteger;
              ValIn := 0;
              ValOut := 0;
              Changed := false;
              GotOut := false;
              Flags := 0;
              Address := DecHexW(i);
              TagName := s;
            end;

            readln(F, s);
            ParsedTagnames[i] := s;
          end;
      finally
        try
          CloseFile(F);
        except end;
      end;
    end;
    DataValid := 1;
  end;

  NeedToGetAll := true;
end;


procedure TTcpImportClientModule.DataReceive;
var
  clnt: TIdTCPClient;
  attempt, i: integer;
  s, get_cmd, get_answ: string;
  c: char;
  err_rd, err_wr: boolean;
  l: Cardinal;
begin
  if not Enable then exit;

  if EmmulateModule then begin
    Emmulate;
    exit;
  end;

  l := GetTickCount;
//  err_rd := false;
  err_wr := false;

  if not CheckClientObject then begin
    NeedToGetAll := true;
    err_rd := true;
  end else begin

    clnt := (PortHolder as TTcpPortHolder).Clnt;

    // Запись значений тегов
    attempt := 0;
    if not ReadOnly then while attempt<AttempMax do begin
      try

        for i:=0 to TagCount-1 do begin

          // Запись тега если он изменился
          if Tags[i].GotOut then begin
            s := IntToHex(i, 1) + ' ' + iif(Tags[i].ValOut<0, '-', '') + IntToHex(abs(Tags[i].ValOut), 1);
            clnt.IOHandler.WriteLn( 'WNM ' + s + ' ' + IntToHex(CRC16($FFFF, s), 1) );
            if not GetAnswer('109 !', false, s, c) then raise Exception.Create('');
            Tags[i].GotOut := false;
          end;


          // Передача флага для irregular тегов
          if (Tags[i].TagProp = tpIrregular) and (Tags[i].TagFlag <> tfNone) then begin
            s := IntToHex(i, 1) + ' ' + IntToHex(integer(Tags[i].TagFlag), 1);
            clnt.IOHandler.WriteLn( 'SETFLAG ' + s + ' ' + IntToHex(CRC16($FFFF, s), 1) );
            if not GetAnswer('117 !', false, s, c) then raise Exception.Create('');
            Tags[i].TagFlag := tfNone;
          end;


        end;

        err_wr := false;
        break;
      except
        err_wr := true;
      end;
      inc(attempt);                      
    end;

    // читаем свойства тегов только один раз
    if NeedToReadTagProps then
      NeedToReadTagProps := parseRecievedValues(clnt, 'GETPROPS ', '116');

    get_cmd  := iif( NeedToGetAll, 'GETALL ', 'GETCHG ');
    get_answ := iif( NeedToGetAll, '106', '107');
    err_rd := parseRecievedValues(clnt, get_cmd, get_answ);
    {
    // Прием значений тегов
    while attempt<AttempMax do begin
      try
        // FIXALL
        clnt.IOHandler.WriteLn('FIXALL' );
        if not GetAnswer('105', false, s, c) then raise Exception.Create('');

        get_cmd  := iif( NeedToGetAll, 'GETALL ', 'GETCHG ');
        get_answ := iif( NeedToGetAll, '106', '107');

        i:=0;
        repeat
          clnt.IOHandler.WriteLn(get_cmd + IntToHex(i, 1));
          if not GetAnswer(get_answ, true, s, c) then raise Exception.Create('');



          k := pos('#',s);
          n := HexToInt(uppercase(copy(s,1,k-1)));
          delete(s,1,k-1);
          s := s + ';';
          if n=0 then break;

          c1:=' ';
          c2:=' ';
          k1:=1;
          k2:=1;
          for k:=1 to length(s) do begin
            if s[k] in ['#','!',';'] then begin
              c1:=c2;
              k1:=k2;
              c2:=s[k];
              k2:=k;

              sv := copy(s, k1+1, k2-k1-1);
              iv:=1;
              if length(sv)>0 then if sv[1]='-' then begin
                iv:=-1;
                delete(sv,1,1);
              end;

              if sv='' then
                v := 0
              else
                v := iv*HexToInt(uppercase(sv));

              if (c1='#') and (c2='!') then i:=v;

              if ((c1='!') and (c2=';')) or
                 ((c1='!') and (c2='#')) or
                 ((c1=';') and (c2='#')) or
                 ((c1=';') and (c2=';')) then if i<TagCount then
              begin
                Tags[i].ValIn := v;
                Tags[i].Changed := true;
                inc(i);
              end;

            end;
          end;

        until c = TcpImp_Final_Mark;

        NeedToGetAll := false;
        err_rd := false;
        break;

      except
        err_rd := true;
      end;
      inc(attempt);
    end;
    }

  end;


  if ErrorCount=-1 then ErrorCount:=0;

  ErrorFlag := err_rd or err_wr;
  if ErrorFlag then inc(ErrorCount);

  TimePeriod := GetTickCount - l;

  UpdateStatusTags;
end;



destructor TTcpImportClientModule.Destroy;
begin
  ExtraTagList.Free;
  TagList.Free;
  inherited;
end;

function TTcpImportClientModule.GetFullTagName(idx: integer): string;
begin
  if idx<TagCount then with Tags[idx] do begin
    result := ParsedTagnames[idx];
  end else
    result := '';
end;



function TTcpImportClientModule.parseRecievedValues(clnt: TIdTCPClient; get_cmd, get_answ: string): boolean;
var
  attempt,j,i,k,n, k1, k2, v, iv: integer;
  s,sv: string;
  c, c1, c2: char;
  err_rd: boolean;
  modeValues: boolean;
begin
  err_rd := false;
  attempt := 0;
  while attempt<AttempMax do begin
    try
      modeValues := (get_cmd='GETALL ') or (get_cmd='GETCHG ');

      // FIXALL
      if modeValues then begin
        clnt.IOHandler.WriteLn('FIXALL' );
        if not GetAnswer('105', false, s, c) then 
          raise Exception.Create('');

        if useCrcTags then begin
          clnt.IOHandler.WriteLn('GETCRC' );
          if GetAnswer('118', false, s, c) then
            crcTags := s
          else begin
            crcTags := '';
            if copy(s,1,3)='400' then begin
              useCrcTags := false;
//              GetAnswer('', false, s, c);
            end;
          end;
        end;
          
      end;

      i:=0;
      repeat
        clnt.IOHandler.WriteLn(get_cmd + IntToHex(i, 1));

        if not GetAnswer(get_answ, true, s, c) then begin

          if copy(s,1,3)='400' then begin
//            GetAnswer('400', false, s, c);
            Result := False;
            exit;
          end;
            
          raise Exception.Create('')       
        end;



        k := pos('#',s);
        n := HexToInt(uppercase(copy(s,1,k-1)));
        delete(s,1,k-1);
        s := s + ';';
        if n=0 then break;

//        c1:=' ';
        c2:=' ';
//        k1:=1;
        k2:=1;
        for k:=1 to length(s) do begin
          if s[k] in ['#','!',';'] then begin
            c1:=c2;
            k1:=k2;
            c2:=s[k];
            k2:=k;

            sv := copy(s, k1+1, k2-k1-1);
            iv:=1;
            if length(sv)>0 then if sv[1]='-' then begin
              iv:=-1;
              delete(sv,1,1);
            end;

            if sv='' then
              v := 0
            else
              v := iv*HexToInt(uppercase(sv));

            if (c1='#') and (c2='!') then i:=v;

            if ((c1='!') and (c2=';')) or
               ((c1='!') and (c2='#')) or
               ((c1=';') and (c2='#')) or
               ((c1=';') and (c2=';')) then if i<TagCount then
            begin
              if modeValues then begin
                Tags[i].ValIn := v;
                Tags[i].Changed := true;
              end else begin
                Tags[i].TagProp := TWorkRecTagProp( v );
              end;
              inc(i);
            end;

          end;
        end;

      until c = TcpImp_Final_Mark;

      if modeValues then
        NeedToGetAll := false;
        
      if useCrcTags then
        if modeValues then begin
          j := 0;
          for i:=0 to TagCount-1 do begin
            inc(j);
            strCrcH[j] := chr(Tags[i].ValIn shr 8);
            strCrcL[j] := chr(Tags[i].ValIn and $FF);
          end;
          crcH := CRC16($FFFF, strCrcH);
          crcL := CRC16($FFFF, strCrcL);

          s := IntToHex(crcH, 4) + IntToHex(crcL, 4);

          if crcTags <> s then begin
            NeedToGetAll := true;
            Inc(crcErrorCnt);
          end;

        end;

      err_rd := false;
      break;

    except
      err_rd := true;
    end;
    inc(attempt);
  end;

  result := err_rd;
end;


function TTcpImportClientModule.GetTagIndex(TagName: string): integer;
var
  i: Integer;
begin
  Result := -1;

  if taglist.Find(TagName, i) then
    Result := integer(taglist.Objects[i]);

end;

end.
