{
  Autor: Michael Springwald

  Datum: Sonntag, 14.August.2016
}


unit updv;


{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, lNet, Crt, contnrs, uplLogFile;

type

  PLLNetClientOnResiver = procedure(const aMessage:String) of object;

  { TPLInfoItem }

  TPLInfoItem = class
  private
    fID: String;
    fPfad: String;
    fValue: String;

  protected

  public

    constructor Create;
    destructor Destroy; override;
  published
    property Pfad:String read fPfad write fPfad;
    property Value:String read fValue write fValue;
    property ID:String read fID write fID;
  end; // TPLInfoItem

  { TPLInfoList }
  TPLInfoList = class
  private
    function GetCount: Integer;
    function GetItem(index: Integer): TPLInfoItem;

  protected

  public
    Items:TObjectList;
    constructor Create;
    destructor Destroy; override;

    function AddItem(const Pfad:String; const Value:String; const ID:String):TPLInfoItem;
    function FindItem(const Pfad:String):Integer;

    property Item[index:Integer]:TPLInfoItem read GetItem; default;
    property Count:Integer read GetCount;
  published
  end; // TPLInfoList

  { TPLLnetServer }
  TPLLnetServer = class
  private
    fEnabled: boolean;
    fPort: Integer;
    Quit:Boolean;
//    log:TFileStream;
//    oldLogFile:String;
    LogFile:TPLLogFile;
    procedure ChangeLogStream;
    procedure WriteInLogFile(const aMessage:String);
    procedure OnEr(const msg: string; aSocket: TLSocket);
    procedure OnAc(aSocket: TLSocket);
    procedure OnRe(aSocket: TLSocket);
    procedure OnDs(aSocket: TLSocket);

    procedure SetEnabled(AValue: boolean);
  protected

  public
    FCon: TLTCP;
//    NoLog:Boolean;
    AppDir:String;
    constructor Create(const aNoLog:Boolean);
    destructor Destroy; override;
  published
    property Enabled:boolean read fEnabled write SetEnabled;
    property Port:Integer read fPort write fPort;
  end; // TPLLnetServer

  { TPLLnetClient }
  TPLLnetClient = class
  private
    fClientOnResiver: PLLNetClientOnResiver;
    fEnabled: Boolean;
    fHost: String;
    fPort: Integer;
    FQuit: boolean;
    procedure OnDs(aSocket: TLSocket);
    procedure OnRe(aSocket: TLSocket);
    procedure OnEr(const msg: string; aSocket: TLSocket);
    procedure SetEnabled(AValue: Boolean);

    procedure Run;
  protected

  public
    FCon: TLTcp;
    constructor Create;
    destructor Destroy; override;

    procedure SendAMessage(const aValue:string);
  published
    property Enabled:Boolean read fEnabled write SetEnabled;
    property Port:Integer read fPort write fPort;
    property Host:String read fHost write fHost;
    property ClientOnResiver:PLLNetClientOnResiver read fClientOnResiver write fClientOnResiver;
  end; // TPLLnetClient

  procedure ExtractData(const aValue: String; var ModulID: String; var ModulName:string; var ModulValue: String; var ModulPfad:String);
  procedure ExtractDataModul(const aValue: String; var ModulName: String; var ModulValue: String; var ModulCommand:String);

implementation

procedure ExtractData(const aValue: String; var ModulID: String; var ModulName:string; var ModulValue: String; var ModulPfad:String);
var
  x, len, TokenIndex:Integer;
  TempID, TempValue, TempPfad, TempName:String;
begin
  TempID:=''; TempValue:=''; TempPfad:=''; TempName:='';

  TokenIndex:=0;
  len:=Length(aValue);
  for x:=len downto 1 do begin
    if (aValue[x] = '/') and (TokenIndex+1 <=3) then begin
      inc(TokenIndex)
    end
    else begin
      if TokenIndex = 0 then TempValue:=aValue[x]+TempValue;
      if TokenIndex = 1 then TempID:=aValue[x]+TempID;
      if TokenIndex = 2 then TempName:=aValue[x]+TempName;
      if TokenIndex >= 3 then TempPfad:=aValue[x]+TempPfad;
    end;
  end; // for x

  ModulID:=TempID;
  ModulName:=TempName;
  ModulValue:=TempValue;
  ModulPfad:=TempPfad+'/';
end; // ExtractData

procedure ExtractDataModul(const aValue: String; var ModulName: String; var ModulValue: String; var ModulCommand:String);
var
  x, len, TokenIndex:Integer;
  TempValue, TempName, TempModulCommand:String;
begin
  TempValue:=''; TempModulCommand:=''; TempName:='';

  TokenIndex:=0;
  len:=Length(aValue);
  for x:=len downto 1 do begin
    if (aValue[x] = '/') then begin
      inc(TokenIndex)
    end
    else begin
      if TokenIndex = 0 then TempValue:=aValue[x]+TempValue;
      if TokenIndex = 1 then TempModulCommand:=aValue[x]+TempModulCommand;
      if TokenIndex = 2 then TempName:=aValue[x]+TempName;
    end;
  end; // for x

  ModulName:=TempName;
  ModulValue:=TempValue;
  ModulCommand:=TempModulCommand;
end; // ExtractData

{ TPLInfoList }
function TPLInfoList.GetCount: Integer;
begin
  result:=Items.Count;
end; // TPLInfoList.GetCount

function TPLInfoList.GetItem(index: Integer): TPLInfoItem;
begin
  result:=Items[index] as TPLInfoItem;
end; // TPLInfoList.GetItem

constructor TPLInfoList.Create;
begin
  inherited Create;
  Items:=TObjectList.Create;
end; // TPLInfoList.Create

destructor TPLInfoList.Destroy;
begin
  Items.Free;
  inherited Destroy;
end; // TPLInfoList.Destroy

function TPLInfoList.AddItem(const Pfad: String; const Value:String; const ID:String): TPLInfoItem;
var
  TempIndex:Integer;
begin
  TempIndex:=FindItem(Pfad);
  //writeln('TempIndex:',TempIndex, ' Pfad:',Pfad);
  if TempIndex > -1 then
    result:=item[TempIndex]
  else
    result:=Item[Items.Add(TPLInfoItem.Create)];

  result.Pfad:=Pfad;
  result.Value:=Value;
  result.ID:=id;
end; // TPLInfoList.AddItem

function TPLInfoList.FindItem(const Pfad: String): Integer;
var
  i:integer;
begin
  result:=-1;
  for i:=0 to Count-1 do begin
//    writeln('"',Item[i].Pfad,'" "', Pfad,'"',#13);
    if Item[i].Pfad = Pfad then begin
      result:=i;
      break;
    end;
  end; // for i
end; // TPLInfoList.FindItem

{ TPLInfoItem }
constructor TPLInfoItem.Create;
begin
  inherited Create;
  Pfad:='';
  Value:='';
  id:='';
end; // TPLInfoItem.Create

destructor TPLInfoItem.Destroy;
begin
  inherited Destroy;
end; // TPLInfoItem.Destroy

procedure TPLLnetClient.OnDs(aSocket: TLSocket);
begin

end; // TPLLnetClient.OnDs

procedure TPLLnetClient.OnRe(aSocket: TLSocket);
var
  s: string;
begin
  try
    if aSocket.GetMessage(s) > 0 then begin
      if Assigned(ClientOnResiver) then ClientOnResiver(trim(s));
    end;
  finally
  end;
end; // TPLLnetClient.OnRe

procedure TPLLnetClient.OnEr(const msg: string; aSocket: TLSocket);
begin
  Writeln(msg);
  FQuit := true;
end; // TPLLnetClient.OnEr

procedure TPLLnetClient.SetEnabled(AValue: Boolean);
begin
  if fEnabled=AValue then Exit;
  fEnabled:=AValue;

  if (Enabled) or (FCon.Active) then
    FCon.Disconnect;

  if Enabled then begin
    FCon.Connect(Host, Port);
    repeat
      FCon.CallAction;
      if KeyPressed then
        FQuit := True;
    until FCon.Connected or FQuit;
  end;
end; // TPLLnetClient.SetEnabled

procedure TPLLnetClient.Run;
begin
  repeat
    FCon.CallAction;
    if KeyPressed then
      FQuit := True;
  until FCon.Connected or FQuit;
end;

constructor TPLLnetClient.Create;
begin
  inherited Create;

  FCon := TLTCP.Create(nil);
  FCOn.Host:='10.10.10.10';
  FCon.OnError := @OnEr;
  FCon.OnReceive := @OnRe;
  FCOn.OnDisconnect := @OnDs;
  FCon.Timeout := 100;
  fClientOnResiver:=nil;
end; // TPLLnetClient.Create

destructor TPLLnetClient.Destroy;
begin
  FCon.Disconnect(true);
  inherited Destroy;
end; // TPLLnetClient.Destroy

procedure TPLLnetClient.SendAMessage(const aValue: string);
begin
  try
    if aValue <> '' then
      FCon.SendMessage(aValue);
  finally
  end;
end; // TPLLnetClient.SendAMessage

procedure TPLLnetServer.ChangeLogStream;
//var
//  DD,MM,YY:Word;
//  LogDir, LogFile:string;
begin
{  LogDir:=AppDir+'log/pdv';

  DecodeDate(Date,YY,MM,DD);
  LogFile:=FormatDateTime('DD-MM-YYYY',Date)+'.txt';
  if oldLogFile <> LogFile then begin
    if not DirectoryExists(LogDir) then MkDir(LogDir); // Basis Verzeichnis

    LogDir:=LogDir+'/'+Format('%D',[YY]);
    if not DirectoryExists(LogDir) then MkDir(LogDir); // Jahres Verzeichnis

    LogDir:=LogDir+'/'+Format('%2.D',[MM]);
    if not DirectoryExists(LogDir) then MkDir(LogDir); // Monats Verzeichnis

    if not NoLog then begin
      if Assigned(Log) then FreeAndNil(log);
      if not FileExists(LogDir+'/'+LogFile) then
        log:=TFileStream.Create(LogDir+'/'+LogFile,fmCreate)
      else begin
        log:=TFileStream.Create(LogDir+'/'+LogFile,fmOpenWrite);
        log.Position:=log.Size;
      end;
    end
    else
      log:=nil;
  end;

  oldLogFile:=LogFile;}
end; // TPLLnetServer.ChangeLogStream

procedure TPLLnetServer.WriteInLogFile(const aMessage: String);
//var
//  str:string;
begin
{  if not NoLog then begin
    ChangeLogStream();
    str:='['+DateToStr(Date) + ' ' + TimeToStr(Time) + '] ' + trim(aMessage) + #10;
    log.Position:=log.Size;
    log.Write(PChar(str)^,Length(str));
  end;}
end; // TPLLnetServer.WriteInLogFile

{ TPLLnetServer }
procedure TPLLnetServer.OnEr(const msg: string; aSocket: TLSocket);
begin

end; // TPLLnetServer.OnEr

procedure TPLLnetServer.OnAc(aSocket: TLSocket);
begin

end; // TPLLnetServer.OnAc

procedure TPLLnetServer.OnRe(aSocket: TLSocket);
var
  s: string;
begin
  try
    s:='';
    if aSocket.GetMessage(s) > 0 then begin
//      writeln(s);
      LogFile.WriteInLogFile(s);
      //WriteInLogFile(s);

      FCon.IterReset;
      while FCon.IterNext do begin
        FCon.SendMessage(Trim(s)+#13#10, FCon.Iterator);
      end;
    end;
  finally
  end;
end; // TPLLnetServer.OnRe

procedure TPLLnetServer.OnDs(aSocket: TLSocket);
begin

end; // TPLLnetServer.OnDs

procedure TPLLnetServer.SetEnabled(AValue: boolean);
begin
  if fEnabled=AValue then Exit;
  fEnabled:=AValue;
  if (FCon.Active) or (not Enabled) then
    FCon.Disconnect;

  if Enabled then begin
    if FCon.Listen(Port) then begin
      WriteInLogFile('Verbunden mit: ' + FCon.Host + ' ' + IntToStr(Port))
    end;

  end;
end; // TPLLnetServer.SetEnabled


constructor TPLLnetServer.Create(const aNoLog:Boolean);
begin
  inherited Create;
  AppDir:=ExtractFileDir(ParamStr(0)) + DirectorySeparator;
  LogFile:=TPLLogFile.Create(AppDir,'pdv',aNoLog);
  LogFile.ChangeLogStream;
//  NoLog:=aNoLog;
//  oldLogFile:='';
//  ChangeLogStream();
  FCon := TLTCP.Create(nil);
  FCon.OnError := @OnEr;
  FCon.OnReceive := @OnRe;
  FCon.OnDisconnect := @OnDs;
  FCon.OnAccept := @OnAc;
  FCon.Timeout := 100;
  FCon.ReuseAddress := True;

  fEnabled:=false;
end; // TPLLnetServer.Create

destructor TPLLnetServer.Destroy;
begin
  LogFile.Free;
  if FCon.Active then FCon.Disconnect(true);
  inherited Destroy;
end; // TPLLnetServer.Destroy

end.