BSOne.SFC/Tocsg.Lib/VCL/CS/Tocsg.Packet.pas

{*******************************************************}
{                                                       }
{       Tocsg.Packet                                    }
{                                                       }
{       Copyright (C) 2022 kku                          }
{                                                       }
{*******************************************************}

unit Tocsg.Packet;

interface

uses
  Tocsg.Obj, Tocsg.Exception, System.SysUtils, Winapi.Windows,
  superobject, System.Classes;

const
  SIZE_INTEGER = SizeOf(Integer);
  CTX_PACKET_SIGNATURE: AnsiString = '@OC$.G';
  LEN_CTX_PACKET_SIGNATURE = 6;

type
// Server -> Client
  PCtxPacketHeader = ^TCtxPacketHeader;
  TCtxPacketHeader = packed record
    sSig: array [0..5] of AnsiChar;  // #SPK.$$
    wRank: WORD;
    dwId,
    dwSize: DWORD;
  end;


// 종류 추가 되면 패킷 해더의 wRank 수정해야함
  TTgPacketKind = (pkNormal, pkFileQueue, pkIgnore, pkCritical);
  TTgPacketHeader = record
    Cmd,
    Result: Integer;
    Toss,
    Handle,
    WndMessage: LONGLONG;
    ResultMsg: String;
    PacketKind: TTgPacketKind;
  end;

  TSnTextEncoding = System.SysUtils.TEncoding;
  TSnBytes = TBytes;

  ETgPacket = class(ETgException);
  ITgPacket = interface
    ['{5F9E8D1B-7371-41D2-AA7A-E8DDAE3788B9}']
    function _GetPacketHeader: TTgPacketHeader;
    function _GetJsonObject: ISuperObject;

    function ToJsonString: String;
    function ToBytes(var SnBytes: TSnBytes): Integer;
    function ToBytesDataOnly(var SnBytes: TSnBytes): Integer;
    function SaveToFile(sPath: String): Boolean;
  end;

  ISendPacket = interface(ITgPacket)
    ['{0322E57A-C699-40BE-B0DF-64B9A69A5701}']
    function GetCommand: Integer;
    procedure SetPacketKind(aPacketKind: TTgPacketKind);
    function GetPacketKind: TTgPacketKind;
    procedure SetHandle(llHandle: LONGLONG);
    procedure SetWndMessage(llWndMessage: LONGLONG);
    procedure SetToss(llToss: LONGLONG);
    procedure SetResult(nResult: Integer);
    procedure SetResultMsg(const sResultMsg: String);
    function GetResult: Integer;
    function GetResultMsg: String;
    function GetSocket: TObject;
    procedure SetSocket(aSocket: TObject);

    function GetO(const sPath: String): ISuperObject;

    procedure PutO(const sPath: String; const Value: ISuperObject);
    procedure PutB(const sPath: String; Value: Boolean);
    procedure PutI(const sPath: String; Value: SuperInt);
    procedure PutC(const sPath: String; Value: Currency);
    procedure PutD(const sPath: String; Value: Double);
    procedure PutS(const sPath: String; const Value: String);

    property Command: Integer read GetCommand;
    property Handle: LONGLONG write SetHandle;
    property WndMessage: LONGLONG write SetWndMessage;
    property Toss: LONGLONG write SetToss;
    property Result: Integer read GetResult write SetResult;
    property ResultMsg: String read GetResultMsg write SetResultMsg;
    property PacketKind: TTgPacketKind read GetPacketKind write SetPacketKind;
    property Socket: TObject read GetSocket write SetSocket;

    property O[const sPath: String]: ISuperObject read GetO write PutO; default;
    property B[const sPath: String]: Boolean write PutB;
    property I[const sPath: String]: SuperInt write PutI;
    property D[const sPath: String]: Double write PutD;
    property C[const sPath: String]: Currency write PutC;
    property S[const sPath: String]: String write PutS;
  end;

  IRcvPacket = interface(ITgPacket)
    ['{C1BFCE0F-1B34-4FCC-84AC-4F24CA6D72A5}']
    function GetCommand: Integer;
    function GetPacketKind: TTgPacketKind;
    function GetHandle: LONGLONG;
    function GetWndMessage: LONGLONG;
    function GetToss: LONGLONG;
    function GetResult: Integer;
    function GetResultMsg: String;
    function GetSocket: TObject;
    function GetRcvPacketSize: DWORD;

    function ToJsonString: String;

    function GetO(const sPath: String): ISuperObject;
    function GetB(const sPath: String): Boolean;
    function GetI(const sPath: String): SuperInt;
    function GetD(const sPath: String): Double;
    function GetC(const sPath: String): Currency;
    function GetS(const sPath: String): String;
    function GetA(const sPath: String): TSuperArray;

    property Command: Integer read GetCommand;
    property PacketKind: TTgPacketKind read GetPacketKind;
    property Handle: LONGLONG read GetHandle;
    property WndMessage: LONGLONG read GetWndMessage;
    property Toss: LONGLONG read GetToss;
    property Result: Integer read GetResult;
    property ResultMsg: String read GetResultMsg;
    property Socket: TObject read GetSocket;
    property RcvPacketSize: DWORD read GetRcvPacketSize;

    property O[const sPath: String]: ISuperObject read GetO; default;
    property B[const sPath: String]: Boolean read GetB;
    property I[const sPath: String]: SuperInt read GetI;
    property D[const sPath: String]: Double read GetD;
    property C[const sPath: String]: Currency read GetC;
    property S[const sPath: String]: String read GetS;
    property A[const sPath: String]: TSuperArray read GetA;
  end;

  TTgPacket = class(TInterfacedObject, ITgPacket, ISendPacket, IRcvPacket)
  protected
    Socket_: TObject;
    PacketHeader_: TTgPacketHeader;
    SuperObject_: ISuperObject;
    dwRcvLen_: DWORD;

    function _GetPacketHeader: TTgPacketHeader;
    function _GetJsonObject: ISuperObject;

    procedure PutO(const sPath: String; const Value: ISuperObject);
    procedure PutB(const sPath: String; Value: Boolean);
    procedure PutI(const sPath: String; Value: SuperInt);
    procedure PutC(const sPath: String; Value: Currency);
    procedure PutD(const sPath: String; Value: Double);
    procedure PutS(const sPath: String; const Value: String);

    function GetO(const sPath: String): ISuperObject;
    function GetB(const sPath: String): Boolean;
    function GetI(const sPath: String): SuperInt;
    function GetD(const sPath: String): Double;
    function GetC(const sPath: String): Currency;
    function GetS(const sPath: String): String;
    function GetA(const sPath: String): TSuperArray;

    function GetCommand: Integer;
    procedure SetPacketKind(aPacketKind: TTgPacketKind);
    function GetPacketKind: TTgPacketKind;
    procedure SetHandle(llHandle: LONGLONG);
    function GetHandle: LONGLONG;
    procedure SetWndMessage(llWndMessage: LONGLONG);
    function GetWndMessage: LONGLONG;
    procedure SetToss(llToss: LONGLONG);
    function GetToss: LONGLONG;
    procedure SetResult(nResult: Integer);
    function GetResult: Integer;
    procedure SetResultMsg(const sResultMsg: String);
    function GetResultMsg: String;
    function GetSocket: TObject;
    procedure SetSocket(aSocket: TObject);
    function GetRcvPacketSize: DWORD;  // for IRcvPacket
  public
    Constructor Create; overload;
    Constructor Create(const aCmd: Integer; PacketKind: TTgPacketKind = pkNormal); overload;
    Constructor Create(aPacket: ITgPacket; PacketKind: TTgPacketKind = pkNormal); overload;
    Constructor Create(const aRcvData: Pointer; nRcvLen: Integer); overload;
    Constructor Create(const aRcvData: TSnBytes; bIncludeLen: Boolean = false; aSocket: TObject= nil{for ClientContext}); overload;
    Constructor Create(aSocket: TObject{for ClientContext}; const aRcvData: Pointer; nRcvLen: Integer); overload;
    Constructor Create(const sJsonData: String); overload;
    function ToJsonString: String;
    function ToBytes(var SnBytes: TSnBytes): Integer;
    function ToBytesDataOnly(var SnBytes: TSnBytes): Integer;
    function SaveToFile(sPath: String): Boolean;

    property Command: Integer read GetCommand;
    property PacketKind: TTgPacketKind read GetPacketKind;
    property Toss: LONGLONG read GetToss write SetToss;
    property Handle: LONGLONG read GetHandle write SetHandle;
    property WndMessage: LONGLONG read GetWndMessage write SetWndMessage;
    property Result: Integer read GetResult write SetResult;
    property ResultMsg: String read GetResultMsg write SetResultMsg;
    property Socket: TObject read GetSocket write SetSocket;

    property O[const sPath: String]: ISuperObject read GetO write PutO; default;
    property B[const sPath: String]: Boolean read GetB write PutB;
    property I[const sPath: String]: SuperInt read GetI write PutI;
    property D[const sPath: String]: Double read GetD write PutD;
    property C[const sPath: String]: Currency read GetC write PutC;
    property S[const sPath: String]: String read GetS write PutS;
  end;

const
  LEN_CTX_PACKET_HEADER = SizeOf(TCtxPacketHeader);
  BUFFER_SIZE = 32 * 1024;
  MAX_BUF_LEN = BUFFER_SIZE;

implementation

uses
  Tocsg.Safe, Tocsg.JSON;

{ TTgPacket }

Constructor TTgPacket.Create;
begin
  Inherited Create;
  ZeroMemory(@PacketHeader_, SizeOf(PacketHeader_));
  dwRcvLen_ := 0;
end;

Constructor TTgPacket.Create(const aCmd: Integer; PacketKind: TTgPacketKind = pkNormal);
begin
  Create;
  PacketHeader_.Cmd := aCmd;
  PacketHeader_.PacketKind := PacketKind;
  SuperObject_ := TSuperObject.Create;
end;

Constructor TTgPacket.Create(aPacket: ITgPacket; PacketKind: TTgPacketKind = pkNormal);
begin
  Create;
  PacketHeader_ := aPacket._GetPacketHeader;
  SuperObject_ := aPacket._GetJsonObject;
  PacketHeader_.PacketKind := PacketKind;
end;

Constructor TTgPacket.Create(const aRcvData: TSnBytes; bIncludeLen: Boolean = false; aSocket: TObject = nil{for ClientContext});

  procedure ExtractData;
  var
    nDataLen: Integer;
    sJsonData: UTF8String;
  begin
    nDataLen := 0;

    if bIncludeLen then
    begin
      dwRcvLen_ := Length(aRcvData);
      if dwRcvLen_ < 4 then
        raise ETgPacket.Create('Rcv 버퍼가 손상되었습니다.');

      CopyMemory(@nDataLen, @aRcvData[0], SIZE_INTEGER);

      if nDataLen <> (dwRcvLen_ - SIZE_INTEGER) then
      begin
        raise ETgPacket.CreateFmt('Rcv 데이터 크기가 잘못되었습니다. (DataLen = %d, RcvBufLen = %d',
                                    [nDataLen, dwRcvLen_ - SIZE_INTEGER]);
      end;

      SetLength(sJsonData, nDataLen);
      CopyMemory(@sJsonData[1], @aRcvData[4], nDataLen);
    end else begin
      nDataLen := Length(aRcvData);
      dwRcvLen_ := nDataLen;
      SetLength(sJsonData, nDataLen);
      CopyMemory(@sJsonData[1], @aRcvData[0], nDataLen);
    end;

    SuperObject_ := SO(sJsonData);

    try
      with SuperObject_['Header'], PacketHeader_ do
      begin
        Cmd        := I['Cmd'];
        Handle     := I['Handle'];
        WndMessage := I['WndMessage'];
        PacketKind := TTgPacketKind(I['PacketKind']);
        Result     := I['Result'];
        Toss       := I['Toss'];
        ResultMsg  := S['ResultMsg'];
      end;
    except
      raise ETgPacket.Create('Invalid packet ..');
    end;
  end;

begin
  Create;
  Socket_ := aSocket;
  ExtractData;
end;

Constructor TTgPacket.Create(aSocket: TObject{for ClientContext}; const aRcvData: Pointer; nRcvLen: Integer);
begin
  Create(aRcvData, nRcvLen);
  Socket_ := aSocket;
end;

Constructor TTgPacket.Create(const aRcvData: Pointer; nRcvLen: Integer);

  procedure ExtractData;
  var
    sJsonData: UTF8String;
  begin
    dwRcvLen_ := nRcvLen;
    SetLength(sJsonData, nRcvLen);
    CopyMemory(@sJsonData[1], aRcvData, nRcvLen);

    SuperObject_ := SO(sJsonData);

    try
      with SuperObject_['Header'], PacketHeader_ do
      begin
        Cmd        := I['Cmd'];
        Handle     := I['Handle'];
        WndMessage := I['WndMessage'];
        PacketKind := TTgPacketKind(I['PacketKind']);
        Result     := I['Result'];
        Toss       := I['Toss'];
        ResultMsg  := S['ResultMsg'];
      end;
    except
      raise ETgPacket.Create('Invalid packet ..');
    end;
  end;

begin
  Create;
  ExtractData;
end;

Constructor TTgPacket.Create(const sJsonData: String);
begin
  Inherited Create;
  SuperObject_ := SO(sJsonData);
  with SuperObject_['Header'], PacketHeader_ do
  begin
    Cmd        := I['Cmd'];
    Handle     := I['Handle'];
    WndMessage := I['WndMessage'];
    PacketKind := TTgPacketKind(I['PacketKind']);
    Result     := I['Result'];
    Toss       := I['Toss'];
    ResultMsg  := S['ResultMsg'];
  end;
end;

function TTgPacket._GetPacketHeader: TTgPacketHeader;
begin
  Result := PacketHeader_;
end;

function TTgPacket._GetJsonObject: ISuperObject;
begin
  Result := SuperObject_;
end;

function TTgPacket.ToJsonString: String;
var
  O: ISuperObject;
begin
  Result := '';
  if SuperObject_ <> nil then
  begin
    O := SO;
    with PacketHeader_, O do
    begin
      I['Cmd'] := Cmd;
      if Handle <> 0 then
        I['Handle'] := Handle;
      if WndMessage <> 0 then
        I['WndMessage'] := WndMessage;
      if PacketKind <> pkNormal then
        I['PacketKind'] := Integer(PacketKind);
      if Result <> 0 then
        I['Result'] := Result;
      if Toss <> 0 then
        I['Toss'] := Toss;
      if ResultMsg <> '' then
        S['ResultMsg'] := ResultMsg;
    end;
    SuperObject_.O['Header'] := O;
    Result := SuperObject_.AsJSon;
  end;
end;

function TTgPacket.ToBytes(var SnBytes: TSnBytes): Integer;
var
  sJsonData: UTF8String;
  nDataLen: Integer;
begin
  Result := 0;
  sJsonData := UTF8Encode(ToJsonString);
  if sJsonData <> '' then
  begin
    nDataLen := Length(sJsonData);
    Result := SIZE_INTEGER + Length(sJsonData);
    SetLength(SnBytes, Result);
    CopyMemory(@SnBytes[0], @nDataLen, SIZE_INTEGER);
    CopyMemory(@SnBytes[4], @sJsonData[1], nDataLen);
//    SetLength(sJsonData, 0);
  end;
end;

function TTgPacket.ToBytesDataOnly(var SnBytes: TSnBytes): Integer;
var
  sJsonData: UTF8String;
begin
  Result := 0;
  sJsonData := UTF8Encode(ToJsonString);
  if sJsonData <> '' then
  begin
    Result := Length(sJsonData);
    SetLength(SnBytes, Result);
    CopyMemory(@SnBytes[0], @sJsonData[1], Result);
  end;
end;

function TTgPacket.SaveToFile(sPath: String): Boolean;
var
  ss: TStringStream;
begin
  Result := false;
  try
    Guard(ss, TStringStream.Create(ToJsonString, TEncoding.UTF8));
    ss.SaveToFile(sPath);
    Result := true;
  except
  //
  end;
end;

procedure TTgPacket.PutO(const sPath: String; const Value: ISuperObject);
begin
  SuperObject_.O[sPath] := Value;
end;

procedure TTgPacket.PutB(const sPath: String; Value: Boolean);
begin
  SuperObject_.B[sPath] := Value;
end;

procedure TTgPacket.PutI(const sPath: String; Value: SuperInt);
begin
  SuperObject_.I[sPath] := Value;
end;

procedure TTgPacket.PutC(const sPath: String; Value: Currency);
begin
  SuperObject_.C[sPath] := Value;
end;

procedure TTgPacket.PutD(const sPath: String; Value: Double);
begin
  SuperObject_.D[sPath] := Value;
end;

procedure TTgPacket.PutS(const sPath: String; const Value: String);
begin
  SuperObject_.S[sPath] := Value;
end;

function TTgPacket.GetO(const sPath: String): ISuperObject;
begin
  Result := SuperObject_.O[sPath];
end;

function TTgPacket.GetB(const sPath: String): Boolean;
begin
  Result := SuperObject_.B[sPath];
end;

function TTgPacket.GetI(const sPath: String): SuperInt;
begin
  Result := SuperObject_.I[sPath];
end;

function TTgPacket.GetD(const sPath: String): Double;
begin
  Result := SuperObject_.D[sPath];
end;

function TTgPacket.GetC(const sPath: String): Currency;
begin
  Result := SuperObject_.C[sPath];
end;

function TTgPacket.GetS(const sPath: String): String;
begin
  Result := SuperObject_.S[sPath];
end;

function TTgPacket.GetA(const sPath: String): TSuperArray;
begin
  Result := SuperObject_.A[sPath];
end;

function TTgPacket.GetCommand: Integer;
begin
  Result := PacketHeader_.Cmd;
end;

procedure TTgPacket.SetPacketKind(aPacketKind: TTgPacketKind);
begin
  if PacketHeader_.PacketKind <> aPacketKind then
    PacketHeader_.PacketKind := aPacketKind;
end;

function TTgPacket.GetPacketKind: TTgPacketKind;
begin
  Result := PacketHeader_.PacketKind;
end;

procedure TTgPacket.SetHandle(llHandle: LONGLONG);
begin
  if PacketHeader_.Handle <> llHandle then
    PacketHeader_.Handle := llHandle;
end;

function TTgPacket.GetHandle: LONGLONG;
begin
  Result := PacketHeader_.Handle;
end;

procedure TTgPacket.SetWndMessage(llWndMessage: LONGLONG);
begin
  if PacketHeader_.WndMessage <> llWndMessage then
    PacketHeader_.WndMessage := llWndMessage;
end;

function TTgPacket.GetWndMessage: LONGLONG;
begin
  Result := PacketHeader_.WndMessage;
end;

procedure TTgPacket.SetToss(llToss: LONGLONG);
begin
  if PacketHeader_.Toss <> llToss then
    PacketHeader_.Toss := llToss;
end;

function TTgPacket.GetToss: LONGLONG;
begin
  Result := PacketHeader_.Toss;
end;

procedure TTgPacket.SetResult(nResult: Integer);
begin
  if PacketHeader_.Result <> nResult then
    PacketHeader_.Result := nResult;
end;

function TTgPacket.GetResult: Integer;
begin
  Result := PacketHeader_.Result;
end;

procedure TTgPacket.SetResultMsg(const sResultMsg: String);
begin
  if PacketHeader_.ResultMsg <> sResultMsg then
    PacketHeader_.ResultMsg := sResultMsg;
end;

function TTgPacket.GetResultMsg: String;
begin
  Result := PacketHeader_.ResultMsg;
end;

function TTgPacket.GetSocket: TObject;
begin
  Result := Socket_;
{$IFDEF DEBUG}
  if Result = nil then
    raise ETgPacket.Create('소켓이 지정 되지있지 않습니다.');
{$ENDIF}
end;

procedure TTgPacket.SetSocket(aSocket: TObject);
begin
  if Socket_ <> aSocket then
    Socket_ := aSocket;
end;

function TTgPacket.GetRcvPacketSize: DWORD;
begin
  Result := dwRcvLen_;
end;

end.