{
  Autor: Michael Springwald

  Datum: Dienstag, 05.05.2015
}

unit uplTCP_Synapse;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, contnrs, synsock,blcksock, dateutils,
  uplmyDate;

type
  TPLTCP_Client = class;
  TPLTCP_Server = class;

  TPLTCP_OnReseived = procedure (Client:TPLTCP_Client; const msg:string) of object;

  TPLTCP_AddNewClient = procedure (const NewClient:TPLTCP_Client) of object;

  { TPLTCP_Client }
  TPLTCP_Client = class(TThread)
  private
    fFromHost: String;
    fID: string;
    fIndex: integer;
    fOnReceived: TPLTCP_OnReseived;
    LastMessage:string;
  protected
    procedure DoResivedMsg;

    procedure Execute; override;
  public
    Socket: TTCPBlockSocket;
    constructor Create(CreateSuspended: Boolean; const StackSize: SizeUInt=DefaultStackSize);
    destructor Destroy; override;

    procedure Send(aMSG:String);
    procedure SendStream(const aStream:TStream);
    procedure StartSocket(IP: String; Port: Integer);
  published
    property OnReceived:TPLTCP_OnReseived read fOnReceived write fOnReceived;
    property FromHost:String read fFromHost write fFromHost;
    property Index:integer read fIndex write fIndex;
    property ID:string read fID write fID;
  end; // TPLTCP_Client

  { TPLTCP_ClientList }
  TPLTCP_ClientList = class
  private
    fOnReceived: TPLTCP_OnReseived;
    function GetCount: Integer;
    function GetItem(index: integer): TPLTCP_Client;
  protected
    procedure Reseived(Client:TPLTCP_Client; const msg:string);
  public
    Items:TObjectLIst;
    Server:TPLTCP_Server;
    constructor Create;
    destructor Destroy; override;

    function AddClient(const FromHost, aID:String):TPLTCP_Client;
    function SendAText(const aText:String; const ClientIndex:Integer = -1):boolean;

    property Item[index:integer]:TPLTCP_Client read GetItem; default;
    property Count:Integer read GetCount;

  published
    property OnReceived:TPLTCP_OnReseived read fOnReceived write fOnReceived;
  end; // TPLTCP_ClientList

  { TPLTCPFile_Sender }
  TPLTCPFile_Sender = class(TThread)
  private
  protected

  public
    CurrDate: TMyDate;
    EndDate: TMyDate;
    StartDate: TMyDate;

    StartDateStr, EndDateStr, ModulName:String;
    OwnerClient:TPLTCP_Client;
    DataDir:String;

    procedure Execute; override;

    constructor Create(CreateSuspended: Boolean; const StackSize: SizeUInt=DefaultStackSize);
    destructor Destroy; override;

  published
  end; // TPLTCPFile_Sender

  { TPLTCP_Server }
  TPLTCP_Server = class(TThread)
  private
    fHost: String;
    fOnAddClient: TPLTCP_AddNewClient;
    fOnReseived: TPLTCP_OnReseived;
    fPort: Integer;
  protected
    procedure Execute; override;
  public
    Socket: TTCPBlockSocket;
    ClientList:TPLTCP_ClientList;

    constructor Create(CreateSuspended: Boolean; const StackSize: SizeUInt=DefaultStackSize);
    destructor Destroy; override;

    procedure StartServer(const aHost:string; const aPort:Integer);
    procedure Stop;

  published
    property Port:Integer read fPort write fPort;
    property Host:String read fHost write fHost;
    property OnAddClient:TPLTCP_AddNewClient read fOnAddClient write fOnAddClient;
    property OnReseived:TPLTCP_OnReseived read fOnReseived write fOnReseived;
  end; // TPLTCP_Server

implementation

{ TPLTCPFile_Sender }
procedure TPLTCPFile_Sender.Execute;
var
  TTagEnd, Year,fsSize:Integer;
  FileName:String;
  fs:TFileStream;
  StrList:TStringList;
  ch:Char;
begin
  StartDate.Day:=-1; StartDate.Month:=-1; StartDate.Year:=-1;
  EndDate.Day:=-1; EndDate.Month:=-1; EndDate.Year:=-1;
  myStrToDate(StartDateStr, StartDate); myStrToDate(EndDateStr, EndDate);
  writeln('StartDate:',StartDateStr, '| EndDate: ', EndDateStr);

  while (not Terminated) or (not Suspended) do begin
    CurrDate.Month:=StartDate.Month; CurrDate.Day:=StartDate.Day;
    for Year:=StartDate.Year to EndDate.Year do begin
      TTagEnd:=DaysInAMonth(CurrDate.Year,CurrDate.Month);
      CurrDate.Year:=Year;
      repeat
//        writeln(CurrDate.Day,'.',CurrDate.Month,'.',CurrDate.Year);
        FileName:=ModulName+DirectorySeparator+'data2'+DirectorySeparator+IntToStr(CurrDate.Year)+DirectorySeparator+
                                                                         IntToStr(CurrDate.Month)+DirectorySeparator+
                                                                         IntToStr(CurrDate.Day)+'.txt';
        if FileExists(DataDir+FileName) then begin
          fs:=TFileStream.Create(DataDir+FileName,fmOpenReadWrite or fmShareDenyNone);
          fs.Position:=0;
          fsSize:=fs.Size;
          StrList:=TStringList.Create;
          StrList.LoadFromStream(fs);
          OwnerClient.Send('$SaveFileName,'+FileName+','+IntToStr(fsSize)+','+StrList.Text+'@');
          fs.Free;
        end
        else begin
          fsSize:=0;
          OwnerClient.Send('$SaveFileName,'+FileName+',0, @');
        end;

        if CurrDate.Day = TTagEnd then begin
          TTagEnd:=DaysInAMonth(CurrDate.Year,CurrDate.Month);
          CurrDate.Month:=CurrDate.Month+1;
          CurrDate.Day:=1;
        end
        else
         CurrDate.Day:=CurrDate.Day+1;
      until ((StartDate.Year <> EndDate.Year) and (CurrDate.Month> 12))  or ((CurrDate.Year = EndDate.Year) and (CurrDate.Day= EndDate.Day+1) and (CurrDate.Month = EndDate.Month));
      CurrDate.Day:=1;
      if CurrDate.Month+1 >= 12 then
        CurrDate.Month:=1
      else
        CurrDate.Month:=CurrDate.Month+1;
    end; //  for i
    break;
  end;
  writeln('TPLTCPFile_Sender.Execute');
end; // TPLTCPFile_Sender.Execute

constructor TPLTCPFile_Sender.Create(CreateSuspended: Boolean; const StackSize: SizeUInt);
begin
  FreeOnTerminate:=True;
  inherited Create(CreateSuspended,StackSize);

  myDateinit(StartDate);
  myDateinit(EndDate);
  myDateinit(CurrDate);
  StartDateStr:='';
  EndDateStr:='';
end; // TPLTCPFile_Sender.Create

destructor TPLTCPFile_Sender.Destroy;
begin
  writeln('TPLTCPFile_Sender.Destroy');
  inherited Destroy;
end; // TPLTCPFile_Sender.Destroy

{ TPLTCP_ClientList }

function TPLTCP_ClientList.GetCount: Integer;
begin
  result:=Items.Count;
end; // TPLTCP_ClientList.GetCount

function TPLTCP_ClientList.GetItem(index: integer): TPLTCP_Client;
begin
  result:=Items[index] as TPLTCP_Client;
end; // TPLTCP_ClientList.GetItem

procedure TPLTCP_ClientList.Reseived(Client: TPLTCP_Client; const msg: string);
begin
  if Assigned(OnReceived) then begin
    if Assigned(fOnReceived) then
      fOnReceived(Client,msg);

    if pos('LogOut',msg) > 0 then begin
      writeln('Client wird aus Liste entfernt!!!');
      Items.Remove(Client);
//      writeln(Items.Count);
    end;

  end;
end; // TPLTCP_ClientList.Reseived

constructor TPLTCP_ClientList.Create;
begin
  inherited Create;
  Items:=TObjectList.create(false);
  Server:=nil;
end; // TPLTCP_ClientList.Create

destructor TPLTCP_ClientList.Destroy;
var
  i:integer;
begin
  for i:=0 to Count-1 do begin
    Item[i].Terminate;
  end;
  items.Clear;
  Items.Free;
  inherited Destroy;
end; // TPLTCP_ClientList.Destroy

function TPLTCP_ClientList.AddClient(const FromHost, aID: String): TPLTCP_Client;
begin
  Result:=Item[Items.Add(TPLTCP_Client.Create(true))];
  Result.FromHost:=FromHost;
  Result.Index:=Count;
  Result.ID:=aID;
  Result.OnReceived:=@Reseived;
end; // TPLTCP_ClientList.AddClient

function TPLTCP_ClientList.SendAText(const aText: String; const ClientIndex: Integer): boolean;
var
  i:Integer;
begin
  if ClientIndex = -1 then begin
    for i:=0 to Count-1 do begin
      Item[i].Send(aText);
    end; // for i
  end
  else begin
    Item[ClientIndex].Send(aText);
  end;
end; // TPLTCP_ClientList.SendAText

procedure TPLTCP_Client.DoResivedMsg;
var
  x:integer;
  str:String;
begin
  x:=Pos('NewClient:',LastMessage);
  if x >= 0 then begin
    str:=copy(LastMessage,x+10,Length(LastMessage));
    ID:=str;
  end;

  if Assigned(fOnReceived) then
    fOnReceived(self,LastMessage);

  LastMessage:='';
end; // TPLTCP_Client.DoResivedMsg

{ TPLTCP_Client }
constructor TPLTCP_Client.Create(CreateSuspended: Boolean; const StackSize: SizeUInt=DefaultStackSize);
begin
  inherited Create(CreateSuspended,StackSize);
  fOnReceived:=nil;
  fIndex:=-1;
  fFromHost:='';
  LastMessage:='';
  fID:='';
end; // TPLTCP_Client.Create

destructor TPLTCP_Client.Destroy;
begin
  Terminate;
  Send('LogOut:'+ID);
  FreeAndNil(Socket);
  inherited Destroy;
end; // TPLTCP_Client.Destroy

procedure TPLTCP_Client.Send(aMSG: String);
begin
  if (Assigned(Socket)) then
    Socket.SendBlock(aMSG);
end; // TPLTCP_Client.Send

procedure TPLTCP_Client.SendStream(const aStream: TStream);
begin
  if (Assigned(Socket)) then
    Socket.SendStream(aStream);
end; // TPLTCP_Client.SendStream

procedure TPLTCP_Client.StartSocket(IP: String; Port: Integer);
begin
  Socket:= TTCPBlockSocket.Create;
  Socket.Connect(IP,InttoStr(Port));
  writeln(Socket.LastErrorDesc);
  Start;
end; // TPLTCP_Client.Start

procedure TPLTCP_Client.Execute;
var
  aMessage:String;
begin
  while (not Terminated) or (not Suspended) do begin
//    if Socket.CanRead(1000) then begin
      aMessage := Socket.RecvBlock(100);
      if Socket.LastError = 0 then begin
        LastMessage:=aMessage;
//      writeln(LastMessage);
        @DoResivedMsg;
      //Synchronize(@DoResivedMsg);
      end;


      // end;
    sleep(1);
  end;
//  end;
end; // TPLTCP_Client.Execute

procedure TPLTCP_Server.Execute;
var
  newconnection:TSocket;
  newclient:TPLTCP_Client;
begin
  while (not Terminated) or (not Suspended) do begin
    if (Assigned(Socket)) and (Socket.CanRead(400)) then begin
      newconnection := Socket.Accept;
      if (not Terminated) then begin
        newclient:=ClientList.AddClient('','');
        newclient.Socket := TTCPBlockSocket.Create;
        newclient.Socket.Socket:= newconnection;
        newclient.ID:='Test1';
        newclient.FromHost:=newclient.Socket.GetLocalSinIP;
        newclient.Start;

        if Assigned(OnAddClient) then OnAddClient(newclient);
      end
      else
        break;
    end
    else
      sleep(1);
  end;
end; // TPLTCP_Server.Execute

{ TPLTCP_Server }
constructor TPLTCP_Server.Create(CreateSuspended: Boolean; const StackSize: SizeUInt);
begin
  inherited Create(CreateSuspended,StackSize);
  Socket:=nil;
  ClientList:=TPLTCP_ClientList.Create;
  ClientList.Server:=self;
  fOnAddClient:=nil;
  fOnReseived:=nil;
  fPort:=-1;
  fHost:='';
end; // TPLTCP_Server.Create

destructor TPLTCP_Server.Destroy;
begin
  Terminate;
  if Assigned(Socket) then begin
    Socket.StopFlag:=true;
    Socket.CloseSocket;
  end;
  FreeAndNil(Socket);
  ClientList.Free;
  inherited Destroy;
end; // TPLTCP_Server.Destroy

procedure TPLTCP_Server.StartServer(const aHost:string; const aPort:Integer);
begin
  Host:=aHost;
  Port:=aPort;
  Socket := TTCPBlockSocket.Create;
  Socket.Bind(aHost,InttoStr(aPort));
  Socket.Listen;
  Start;
end; // TPLTCP_Server.StartServer

procedure TPLTCP_Server.Stop;
begin
  Terminate;
end; // TPLTCP_Server.Stop

end.