unit rpTcpServer;

interface
uses
  Forms,
  IdContext,
  IdCmdTCPServer,
  IdCommandHandlers,
  IdBaseComponent,
  SysUtils,
  Classes,
  Dialogs,
//  rpTcpBase,
  Controls,
  inifiles,
  TcpPortHolder;


type
  TTcpExportSvr = class;

  TrpTcpServerSetTagEvent = procedure(TagIndex: integer; Data: integer; Value: integer) of object;
  TrpTcpServerGetTagEvent = procedure(TagIndex: integer; Data: integer; var Value: integer) of object;

  PrpTcpServerExportTagRec =^TrpTcpServerExportTagRec;
  TrpTcpServerExportTagRec = record
    Path: string;
    Name: string;
    Data: integer;
  end;

////////////////////////////////////////////////////////////////////////////////
  TrpTcpServer = class
  private
    FOnSetTagValue: TrpTcpServerSetTagEvent;
    FOnGetTagValue: TrpTcpServerGetTagEvent;
  public

    svr: TTcpExportSvr;
    Connected: boolean;
    ExportTags: array of PrpTcpServerExportTagRec;

    constructor Create;
    destructor Destroy; override;

    procedure Load(IniFileName: string; IniGroupName: string); virtual;
    procedure Save(IniFileName: string; IniGroupName: string); virtual;

    procedure Start;
    procedure Stop;
    function EditProp: boolean;

    procedure ClearExportTags;
    function AddExportTag( Path: string; Name: string; Data: integer): integer;

  published
    property OnSetTagValue: TrpTcpServerSetTagEvent read FOnSetTagValue write FOnSetTagValue;
    property OnGetTagValue: TrpTcpServerGetTagEvent read FOnGetTagValue write FOnGetTagValue;
  end;
////////////////////////////////////////////////////////////////////////////////





////////////////////////////////////////////////////////////////////////////////
  TCustomExportSvr = class;

  PExportTagRec =^TExportTagRec;
  TExportTagRec = record
    Path: string;
    Name: string;
    Data: Integer;
    ValIn: Integer;
    ValOld: Integer;
    ValOut: Integer;
    Changed: Boolean;
    GotOut: Boolean;
  end;

  TCustomExportClient = class(TObject)
  protected
    procedure KillTags;
  public
    ExportSvr: TCustomExportSvr;
    CntRequest: Integer;
    DtConnect: TDateTime;
    Info: string;
    TagCount: Integer;
    TagFilterStr: string;
    Tags: array of PExportTagRec;
    ExtraList: TStringList;


    constructor Create;
    destructor Destroy; override;
    procedure CreateTagList; virtual;
    function FixAllValues: Integer; virtual;
    procedure GetAllValues(start_item_num: integer; var tagvals: string); virtual;
    procedure GetChangedValues(start_item_num: integer; var tagvals: string); virtual;
    procedure GetTagList(start_item_num: integer; var tagnames: string); virtual;
    procedure GetTagNameByNum(item_num: integer; var tagname: string); virtual;
    procedure GetTagValueByNum(item_num: integer; var tagval: string); virtual;
    function SetTagValueByNum(item_num, value: integer): Boolean; virtual;
  end;


  TCustomExportSvr = class(TObject)
  public
    parent: TrpTcpServer;
    
    ClientCount: Integer;
    Clients: array of TCustomExportClient;
    Enable: Boolean;
    Name: string;
    MaxSendLength: integer;

    constructor Create; virtual;
    destructor Destroy; override;
    procedure Load(IniFile: TIniFile; IniGroupName: string); virtual;
    procedure Save(IniFile: TIniFile; IniGroupName: string); virtual;
    procedure Start; virtual;
    procedure Stop; virtual;
  end;
////////////////////////////////////////////////////////////////////////////////

  TTcpExportClient = class(TCustomExportClient)
  public
    Context: TIdContext;
  end;

  TTcpExportSvr = class(TCustomExportSvr)
  private
    function CreateCommandHandler(pCommand, pCode, pText: string; pProc:
            TIdCommandEvent): TidCommandHandler;
    procedure CreateCommandHandlers;
    function FindModuleByContext(AContext:TIdContext): TTcpExportClient;

    procedure OnClientConnect(AContext:TIdContext);
    procedure OnClientDisconnect(AContext:TIdContext);

    procedure OnCommandCREATETAGLIST(ASender: TIdCommand);
    procedure OnCommandFIXALL(ASender: TIdCommand);
    procedure OnCommandGETALL(ASender: TIdCommand);
    procedure OnCommandGETCHG(ASender: TIdCommand);
    procedure OnCommandGETFILTER(ASender: TIdCommand);
    procedure OnCommandGETTAGLIST(ASender: TIdCommand);
    procedure OnCommandGETTAGNAMENM(ASender: TIdCommand);
    procedure OnCommandRNM(ASender: TIdCommand);
    procedure OnCommandSETFILTER(ASender: TIdCommand);
    procedure OnCommandADDEXTRATAG(ASender: TIdCommand);
    procedure OnCommandCLEAREXTRALIST(ASender: TIdCommand);
    procedure OnCommandWNM(ASender: TIdCommand);
    procedure SvrFree;
  public
    Ip6: Boolean;
    MaxClients: Integer;
    Port: Integer;
    Svr: TIdCmdTCPServer;

    constructor Create; override;
    destructor Destroy; override;
    procedure Load(IniFile: TIniFile; IniGroupName: string); override;
    procedure Save(IniFile: TIniFile; IniGroupName: string); override;
    procedure Start; override;
    procedure Stop; override;
  end;
  
////////////////////////////////////////////////////////////////////////////////

implementation
uses
//  TcpImportClient,
//  rpTcpGlobals,
  numbers,
  hyperstr,
  TcpExportSvrProp;


function TrpTcpServer.EditProp: boolean;
var
  w: TTcpExportSvrPropForm;
begin
  w := TTcpExportSvrPropForm.Create(nil);
  try
    w.P := svr;
    result := w.ShowModal = mrOk;
  finally
    w.Free;
  end;
end;

constructor TrpTcpServer.Create;
begin
  Connected := false;
  svr := TTcpExportSvr.Create;
  svr.parent := self;
  svr.Name := 'TcpExportSvr';
  svr.Port := 3033;
  svr.Enable := true;
end;

destructor TrpTcpServer.Destroy;
begin
//  if Connected then Stop;
  ClearExportTags;
  svr.Free;
  inherited;
end;

procedure TrpTcpServer.Load(IniFileName: string; IniGroupName: string);
var
  ini: TIniFile;
begin
  ini := Tinifile.Create(IniFileName);
  svr.Load(ini, IniGroupName);
  ini.Free;
end;

procedure TrpTcpServer.Save(IniFileName: string; IniGroupName: string);
var
  ini: TIniFile;
begin
  ini := Tinifile.Create(IniFileName);
  svr.Save(ini, IniGroupName);
  ini.Free;
end;

procedure TrpTcpServer.Start;
begin
  svr.Start;
  Connected := true;
end;

procedure TrpTcpServer.Stop;
begin
  svr.Stop;
  Connected := false;
end;

function TrpTcpServer.AddExportTag(Path, Name: string; Data: integer): integer;
var
  k: integer;
begin
  k := length(ExportTags);
  SetLength(ExportTags, k+1);
  new(ExportTags[k]);
  ExportTags[k].Path := Path;
  ExportTags[k].Name := Name;
  ExportTags[k].Data := Data;
  result := k;
end;

procedure TrpTcpServer.ClearExportTags;
var
  i: integer;
begin
  for i:=0 to length(ExportTags)-1 do
    dispose(ExportTags[i]);
  ExportTags := nil;
end;


////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
constructor TTcpExportSvr.Create;
begin
  inherited;
  Svr := nil;
end;

destructor TTcpExportSvr.Destroy;
begin
  SvrFree;
  inherited;
end;

procedure TTcpExportSvr.Load(IniFile: TIniFile; IniGroupName: string);
begin
  inherited;
  Port := IniFile.ReadInteger(IniGroupName, 'Port', 3033);
  MaxClients := IniFile.ReadInteger(IniGroupName, 'MaxClients', 15);
  Ip6 := IniFile.ReadBool(IniGroupName, 'Ip6', false);
end;

procedure TTcpExportSvr.Save(IniFile: TIniFile; IniGroupName: string);
begin
  inherited;
  IniFile.WriteInteger(IniGroupName, 'Port', Port);
  IniFile.WriteInteger(IniGroupName, 'MaxClients', MaxClients);
  IniFile.WriteBool(IniGroupName, 'Ip6', Ip6);
end;

////////////////////////////////////////////////////////////////////////////////
// ЗАПУСК
////////////////////////////////////////////////////////////////////////////////
procedure TTcpExportSvr.Start;
begin
  inherited;
  if not Enable then exit;
  if Svr=nil then Svr := TIdCmdTCPServer.Create;
  Svr.DefaultPort := Port;
  Svr.MaxConnections := MaxClients;
  Svr.OnConnect := OnClientConnect;
  Svr.OnDisconnect := OnClientDisconnect;
  CreateCommandHandlers;
  Svr.Active := true;
end;

////////////////////////////////////////////////////////////////////////////////
// ОСТАНОВ
////////////////////////////////////////////////////////////////////////////////
procedure TTcpExportSvr.Stop;
begin
  inherited;
  SvrFree;
end;

////////////////////////////////////////////////////////////////////////////////

function TTcpExportSvr.CreateCommandHandler(pCommand, pCode, pText: string;
  pProc: TIdCommandEvent): TidCommandHandler;
begin
  result := Svr.CommandHandlers.Add;
  with result do begin
    Command := pCommand;
    NormalReply.Code := pCode;
    NormalReply.Text.Text := pText;
    OnCommand := pProc;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// Создание обработчиков команд
////////////////////////////////////////////////////////////////////////////////
procedure TTcpExportSvr.CreateCommandHandlers;
begin
  if Svr=nil then exit;

  // Greeting
  Svr.Greeting.Code := '100';
  Svr.Greeting.Text.Text := 'Roboplant OPC Server (TCP)'#13#10'RpSvrTcp ver3';

  //
  CreateCommandHandler('SETFILTER',     '101', 'OK', OnCommandSETFILTER);
  CreateCommandHandler('GETFILTER',     '102', '',   OnCommandGETFILTER);
  CreateCommandHandler('CREATETAGLIST', '103', '',   OnCommandCREATETAGLIST);
  CreateCommandHandler('GETTAGLIST',    '104', '',   OnCommandGETTAGLIST);
  CreateCommandHandler('FIXALL',        '105', '',   OnCommandFIXALL);
  CreateCommandHandler('GETALL',        '106', '',   OnCommandGETALL);
  CreateCommandHandler('GETCHG',        '107', '',   OnCommandGETCHG);
  CreateCommandHandler('RNM',           '108', '',   OnCommandRNM);
  CreateCommandHandler('WNM',           '109', '',   OnCommandWNM);
  CreateCommandHandler('GETTAGNAMENM',  '110', '',   OnCommandGETTAGNAMENM);
  CreateCommandHandler('ADDEXTRATAG',   '111', 'OK', OnCommandADDEXTRATAG);
  CreateCommandHandler('CLEAREXTRALIST','112', 'OK', OnCommandCLEAREXTRALIST);
end;

function TTcpExportSvr.FindModuleByContext(AContext: TIdContext): TTcpExportClient;
var
  i: Integer;
begin
  result:=nil;
  for i:=0 to ClientCount-1 do
    if AContext = (Clients[i] as TTcpExportClient).Context then begin
      result := Clients[i] as TTcpExportClient;
      exit;
    end;
  raise Exception.Create('FindModuleByContext error');
end;

////////////////////////////////////////////////////////////////////////////////
// Добавление клиента
////////////////////////////////////////////////////////////////////////////////
procedure TTcpExportSvr.OnClientConnect(AContext: TIdContext);
var
  Client: TTcpExportClient;
begin
  Client := TTcpExportClient.Create;
  //  AContext.Data := Client;
  Client.ExportSvr := Self;
  Client.Context := AContext;
  Client.TagFilterStr := '';
  Client.TagCount := 0;
  Client.Tags := nil;

  Client.Info := AContext.Connection.Socket.Binding.PeerIP;
  Client.DtConnect := now;
  Client.CntRequest :=0;

  SetLength(Clients, ClientCount+1);
  Clients[ClientCount] := Client;
  inc(ClientCount);
end;

////////////////////////////////////////////////////////////////////////////////
// Удаление клиента
////////////////////////////////////////////////////////////////////////////////
procedure TTcpExportSvr.OnClientDisconnect(AContext: TIdContext);
var
  i, k: Integer;
begin
  k:=-1;
  for i:=0 to ClientCount-1 do
    if (Clients[i] as TTcpExportClient).Context = AContext then begin
      k:=i;
      break;
    end;

  if k<0 then exit;

  Clients[k].Free;
  Clients[k] := Clients[ClientCount-1];
  dec(ClientCount);
  SetLength(Clients, ClientCount);
end;

// CREATETAGLIST
procedure TTcpExportSvr.OnCommandCREATETAGLIST(ASender: TIdCommand);
var
  clnt: TTcpExportClient;
begin
  clnt := FindModuleByContext( ASender.Context );
  if clnt<>nil then with clnt do begin
    CreateTagList;
    ASender.Reply.Text.Text := IntToHex(TagCount,1);

    inc(CntRequest);
  end;
end;

// ADDTAGTOLIST
procedure TTcpExportSvr.OnCommandADDEXTRATAG(ASender: TIdCommand);
var
  s: string;
  clnt: TTcpExportClient;
begin
  clnt := FindModuleByContext( ASender.Context );
  if clnt<>nil then with clnt do begin
    s := ASender.UnparsedParams;
    delete( s, 1, pos('''',s) );
    delete( s, pos('''',s), length(s) );
    ExtraList.Add( s );
  end;
end;

// CLEARTAGLIST
procedure TTcpExportSvr.OnCommandCLEAREXTRALIST(ASender: TIdCommand);
var
  clnt: TTcpExportClient;
begin
  clnt := FindModuleByContext( ASender.Context );
  if clnt<>nil then with clnt do begin
    ExtraList.Clear;
  end;
end;



// FIXALL
procedure TTcpExportSvr.OnCommandFIXALL(ASender: TIdCommand);
var
  clnt: TTcpExportClient;
begin
  clnt := FindModuleByContext( ASender.Context );
  if clnt<>nil then with clnt do begin
    ASender.Reply.Text.Text := IntToHex(FixAllValues, 1);

    inc(CntRequest);
  end;
end;

// GETALL
procedure TTcpExportSvr.OnCommandGETALL(ASender: TIdCommand);
var
  i: Integer;
  s: string;
  clnt: TTcpExportClient;
begin
  clnt := FindModuleByContext( ASender.Context );
  if clnt<>nil then with clnt do begin
    s := ASender.UnparsedParams;
    i := HexToInt(uppercase(s));
    GetAllValues(i, s);
    ASender.Reply.Text.Text := s;

    inc(CntRequest);
  end;
end;

// GETCHG
procedure TTcpExportSvr.OnCommandGETCHG(ASender: TIdCommand);
var
  i: Integer;
  s: string;
  clnt: TTcpExportClient;
begin
  clnt := FindModuleByContext( ASender.Context );
  if clnt<>nil then with clnt do begin
    s := ASender.UnparsedParams;
    i := HexToInt(uppercase(s));
    GetChangedValues(i, s);
    ASender.Reply.Text.Text := s;

    inc(CntRequest);
  end;
end;

// GETFILTER
procedure TTcpExportSvr.OnCommandGETFILTER(ASender: TIdCommand);
var
  clnt: TTcpExportClient;
begin
  clnt := FindModuleByContext( ASender.Context );
  if clnt<>nil then with clnt do begin
    ASender.Reply.Text.Text := ''''+TagFilterStr+'''';

    inc(CntRequest);
  end;
end;

// GETTAGLIST
procedure TTcpExportSvr.OnCommandGETTAGLIST(ASender: TIdCommand);
var
  i: Integer;
  s: string;
  clnt: TTcpExportClient;
begin
  clnt := FindModuleByContext( ASender.Context );
  if clnt<>nil then with clnt do begin
    s := ASender.UnparsedParams;
    i := HexToInt(uppercase(s));
    GetTagList(i, s);
    ASender.Reply.Text.Text := s;

    inc(CntRequest);
  end;
end;

// GETTAGNAMENM
procedure TTcpExportSvr.OnCommandGETTAGNAMENM(ASender: TIdCommand);
var
  i: Integer;
  s: string;
  clnt: TTcpExportClient;
begin
  clnt := FindModuleByContext( ASender.Context );
  if clnt<>nil then with clnt do begin
    s := ASender.UnparsedParams;
    i := HexToInt(uppercase(s));
    GetTagNameByNum(i, s);
    ASender.Reply.Text.Text := s;

    inc(CntRequest);
  end;
end;

// RNM
procedure TTcpExportSvr.OnCommandRNM(ASender: TIdCommand);
var
  i: Integer;
  s: string;
  clnt: TTcpExportClient;
begin
  clnt := FindModuleByContext( ASender.Context );
  if clnt<>nil then with clnt do begin
    s := ASender.UnparsedParams;
    i := HexToInt(uppercase(s));
    GetTagValueByNum(i, s);
    ASender.Reply.Text.Text := s;

    inc(CntRequest);
  end;
end;

// SETFILTER
procedure TTcpExportSvr.OnCommandSETFILTER(ASender: TIdCommand);
var
  s: string;
  clnt: TTcpExportClient;
begin
  clnt := FindModuleByContext( ASender.Context );
  if clnt<>nil then with clnt do begin
    s := ASender.UnparsedParams;
    delete( s, 1, pos('''',s) );
    delete( s, pos('''',s), length(s) );
    TagFilterStr := s;

    inc(CntRequest);
  end;
end;

// WNM
procedure TTcpExportSvr.OnCommandWNM(ASender: TIdCommand);
var
  i: Integer;
  s: string;
  clnt: TTcpExportClient;
label
  M;
begin
  clnt := FindModuleByContext( ASender.Context );
  if clnt<>nil then with clnt do begin

    ASender.Reply.Text.Text := '?';

    if ASender.Params.Count>=3 then begin

      s := ASender.Params[0] + ' ' + ASender.Params[1];
      if (ASender.Params[2]='****') then goto M;
      if CRC16($FFFF, s) = HexToInt(uppercase(ASender.Params[2])) then
  M:  begin
        s := ASender.Params[1];
        i:=1;
        if length(s)>0 then if s[1]='-' then begin
          i:=-1;
          delete(s,1,1);
        end;
        if SetTagValueByNum(
                HexToInt(uppercase(ASender.Params[0])),
                i*HexToInt(uppercase(s))
              )
        then
          ASender.Reply.Text.Text := '!';
      end;
    end;

    inc(CntRequest);
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// Уничтожение сервера
////////////////////////////////////////////////////////////////////////////////
procedure TTcpExportSvr.SvrFree;
var
  i: Integer;
begin
  if Svr=nil then exit;

  if Svr.Active then  with Svr do begin
    if Contexts <> nil then begin
      with Contexts.LockList do try
        for i := 0 to Count - 1 do
          TIdContext(Items[i]).Connection.Disconnect(true);
      finally
        Contexts.UnLockList;
      end;
    end;

    Free;
  end;

  Svr := nil;
end;




////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
destructor TCustomExportClient.Destroy;
begin
  ExtraList.Free;
  KillTags;
  inherited;
end;

constructor TCustomExportClient.Create;
begin
  ExtraList := TStringList.Create;
  ExtraList.Sorted := true;
  ExtraList.Duplicates := dupIgnore;
end;

procedure TCustomExportClient.CreateTagList;
var
  i,j,k: Integer;
  s: string;
  l: TStringList;
begin
  KillTags;

  // добавление по фильтру
  for i:=0 to length(ExportSvr.parent.ExportTags)-1 do begin
    s := ExportSvr.parent.ExportTags[i].Path + '.' + ExportSvr.parent.ExportTags[i].Name;

    if CheckFilterA(s, TagFilterStr) then begin
      SetLength(Tags, TagCount+1);
      new(Tags[TagCount]);

      with Tags[TagCount]^ do begin
        Path := ExportSvr.parent.ExportTags[i].Path;
        Name := ExportSvr.parent.ExportTags[i].Name;
        Data := ExportSvr.parent.ExportTags[i].Data;

        ValIn := 0;
        ValOld := 0;
        ValOut := 0;
        Changed := false;
        GotOut := False;
      end;

      inc(TagCount);
    end;
  end;


  // добавление по списку AddTagList
  l := TStringList.Create;
  l.Sorted := true;
  l.Duplicates := dupIgnore;

  if ExtraList.Count>0 then
    for i:=0 to length(ExportSvr.parent.ExportTags)-1 do begin
      s := ExportSvr.parent.ExportTags[i].Path + '.' + ExportSvr.parent.ExportTags[i].Name;
      if not CheckFilterA(s, TagFilterStr) then begin
        l.AddObject(s, pointer(i));
      end;
    end;

  for i:=0 to ExtraList.Count-1 do begin
    s := ExtraList[i];


    if l.Find(s, j) then begin

      SetLength(Tags, TagCount+1);
      new(Tags[TagCount]);

      with Tags[TagCount]^ do begin
        k := integer(l.Objects[j]);
        Path := ExportSvr.parent.ExportTags[k].Path;
        Name := ExportSvr.parent.ExportTags[k].Name;
        Data := ExportSvr.parent.ExportTags[k].Data;

        ValIn := 0;
        ValOld := 0;
        ValOut := 0;
        Changed := false;
        GotOut := False;
      end;

      inc(TagCount);
    end;
  end;

  l.Free;


end;

function TCustomExportClient.FixAllValues: Integer;
var
  i, k: Integer;
begin
  k := 0;
  for i:=0 to TagCount-1 do begin
    Tags[i].ValOld := Tags[i].ValIn;

    if Assigned( ExportSvr.parent.OnGetTagValue) then
      ExportSvr.parent.OnGetTagValue( i, Tags[i].Data, Tags[i].ValIn)
    else
      Tags[i].ValIn := 0;

    Tags[i].Changed := Tags[i].ValOld <> Tags[i].ValIn;
    if Tags[i].Changed then inc(k);
  end;

  result := k;
end;

procedure TCustomExportClient.GetAllValues(start_item_num: integer; var
        tagvals: string);
var
  i, k: Integer;
  s: string;
  fl_breaked: Boolean;
begin
  if start_item_num<0 then start_item_num:=0;
  tagvals := '';
  k:=0;
  fl_breaked := false;

  for i:=start_item_num to TagCount-1 do begin
    s := format('%x', [abs(Tags[i].ValIn)]);
    if Tags[i].ValIn<0 then s:='-'+s;
    if s='0' then s:='';
    if length(tagvals)+length(s)>ExportSvr.MaxSendLength then begin
      fl_breaked := true;
      break;
    end;
    tagvals := tagvals + s + ';';
    inc(k);
  end;

  if copy(tagvals, length(tagvals), 1)=';' then delete(tagvals, length(tagvals), 1);
  tagvals := DecHex(k) + '#' + DecHex(start_item_num) + '!' + tagvals;

  tagvals := tagvals + iif(fl_breaked,'~','=') + DecHex(CRC16($FFFF, tagvals));
end;

procedure TCustomExportClient.GetChangedValues(start_item_num: integer; var
        tagvals: string);
var
  i, ii, k, kk: Integer;
  s, ss: string;
  fl_breaked: Boolean;

  procedure add_ss;
  begin
    if kk>0 then begin
      delete(ss, length(ss), 1);
      tagvals := tagvals + '#' + DecHex(ii) + '!' + ss;
      k:=k+kk;
      kk:=0;
      ss:='';
    end;
  end;

begin
  if start_item_num<0 then start_item_num:=0;

  // поиск первого измененного тега
  ii:=start_item_num;
  for i:=start_item_num to TagCount-1 do
    if Tags[i].Changed then
      break
    else
      ii:=i+1;
  start_item_num:=ii;

  tagvals := '';
  k:=0;
  kk:=0;
  ss:='';
  fl_breaked := false;

  if start_item_num < TagCount then begin
    for i:=start_item_num to TagCount-1 do begin

      if Tags[i].Changed then begin
//        s := DecHex(abs(Tags[i].ValIn));
        s := format('%x', [abs(Tags[i].ValIn)]);
        if Tags[i].ValIn<0 then s:='-'+s;

        if s='0' then s:='';

        if length(tagvals)+length(ss)+length(s)>ExportSvr.MaxSendLength then begin
          fl_breaked := true;
          break;
        end;

        ss := ss + s + ';';
        inc(kk);
      end else begin
        add_ss;
        ii:=i+1;
      end;
    end;
    add_ss;
  end;

  if k=0 then
    tagvals := '0#' + DecHex(start_item_num) + '!'
  else
    tagvals := DecHex(k) + tagvals;

  tagvals := tagvals + iif(fl_breaked,'~','=') + DecHex(CRC16($FFFF, tagvals));

end;

procedure TCustomExportClient.GetTagList(start_item_num: integer; var tagnames:
        string);
var
  i, k: Integer;
  s: string;
  fl_breaked: Boolean;
begin
  if start_item_num<0 then start_item_num:=0;
  tagnames := '';
  k:=0;
  fl_breaked := false;

  for i:=start_item_num to TagCount-1 do begin

    s := Tags[i].Path + '.' + Tags[i].Name;
      
    if length(tagnames)+length(s)>ExportSvr.MaxSendLength then begin
      fl_breaked := true;
      break;
    end;

    tagnames := tagnames + s + ';';
    inc(k);
  end;

  if copy(tagnames, length(tagnames), 1)=';' then delete(tagnames, length(tagnames), 1);
  tagnames := DecHex(k) + '#' + DecHex(start_item_num) + '!' + tagnames;

  tagnames := tagnames + iif(fl_breaked,'~','=') + DecHex(CRC16($FFFF, tagnames));
end;


procedure TCustomExportClient.GetTagNameByNum(item_num: integer; var tagname:
        string);
begin
  if (item_num>=0) and (item_num < TagCount) then begin
    tagname := Tags[item_num].Path + '.' + Tags[item_num].Name;
  end else
    tagname := '?';
end;


procedure TCustomExportClient.GetTagValueByNum(item_num: integer; var tagval:
        string);
var
  value: integer;
begin
  if (item_num>=0) and (item_num < TagCount) then begin

    if Assigned( ExportSvr.parent.OnGetTagValue) then
      ExportSvr.parent.OnGetTagValue( item_num, Tags[item_num].Data, value)
    else
      value := 0;

    tagval := DecHex(abs(value));

    if value < 0 then tagval := '-' + tagval;
  end else
    tagval := '?';

  tagval := tagval + ' ' + DecHex(CRC16($FFFF, tagval));
end;


procedure TCustomExportClient.KillTags;
var
  i: Integer;
begin
  for i:=0 to TagCount-1 do dispose(Tags[i]);
  Tags := nil;
  TagCount := 0;
end;


function TCustomExportClient.SetTagValueByNum(item_num, value: integer):
        Boolean;
var
  value_cur: integer;        
begin
  result := false;
  if (item_num<0) or (item_num >= TagCount) then exit;

  if Assigned( ExportSvr.parent.OnGetTagValue) then
    ExportSvr.parent.OnGetTagValue( item_num, Tags[item_num].Data, value_cur)
  else
    value_cur := 0;

  if value_cur <> value then begin
    if assigned(ExportSvr.parent.OnSetTagValue) then
      ExportSvr.parent.OnSetTagValue(item_num, Tags[item_num].Data, value);
      
  end;
  result := true;
end;



{
******************************* TCustomExportSvr *******************************
}
constructor TCustomExportSvr.Create;
begin
  inherited Create;
  ClientCount :=0 ;
  Clients := nil;
  MaxSendLength := 16000;
end;

destructor TCustomExportSvr.Destroy;
var
  i: Integer;
begin
  for i:=0 to ClientCount-1 do Clients[i].Free;
  inherited;
end;

procedure TCustomExportSvr.Load(IniFile: TIniFile; IniGroupName: string);
begin
  inherited;
  Enable := IniFile.ReadBool(IniGroupName, 'Enable', false);
end;

procedure TCustomExportSvr.Save(IniFile: TIniFile; IniGroupName: string);
begin
  inherited;
  IniFile.WriteString(IniGroupName, 'ClassName', ClassName);
  IniFile.WriteBool(IniGroupName, 'Enable', Enable);
end;

procedure TCustomExportSvr.Start;
begin
end;

procedure TCustomExportSvr.Stop;
begin
end;




end.
