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

1494 lines
40 KiB
Plaintext

{*******************************************************}
{ }
{ Tocsg.ClientBase }
{ }
{ Copyright (C) 2022 sunk }
{ }
{*******************************************************}
unit Tocsg.ClientBase;
interface
uses
Tocsg.Obj, System.SysUtils, System.Classes, Winapi.Windows, Winapi.Winsock2,
System.Win.ScktComp, Tocsg.Packet, Tocsg.Thread, IdTCPClient,
System.SyncObjs, Tocsg.Encrypt, System.Generics.Collections,
Tocsg.Process.IPC, Tocsg.Exception;
const
PACKET_VERSION = 1;
type
PClientRcvPacket = ^TClientRcvPacket;
TClientRcvPacket = record
wRank: WORD;
llId: LONGLONG;
pBuf: Pointer;
nProcPktLen,
nRemainPktLen: Integer;
end;
ETgClient = ETgException;
TTgClientBase = class(TTgThread)
private
CS_: TCriticalSection;
sHost_: String;
nPort_: Integer;
dwPingTick_,
dwDisconnTick_: DWORD;
nPingTerm_,
nReConnTerm_: Integer;
// 겹친 패킷 발견 시 나머지 받아놓고 나중에 재활용하는 버퍼
_RcylBuf: TBytes;
_nRcylBufLen,
_nRcylBufPos: Integer;
_pRcvPkt: PClientRcvPacket;
_pInitBuf: TBytes;
_DcRcvBufs: TDictionary<LONGLONG,PClientRcvPacket>;
// 패킷 암호화 정보
PktEncKind_: TTgEncKind;
PktEncPass_: String;
Enc_: TTgEncrypt;
// 패킷 전송 정지
bSendPause_: Boolean;
procedure OnRcvBufNotify(Sender: TObject; const Item: PClientRcvPacket; Action: TCollectionNotification);
procedure _ConnectedEvent(Sender: TObject);
procedure _DisconnectedEvent(Sender: TObject);
function GetPktEncKind: TTgEncKind;
procedure SetConnected(const bVal: Boolean);
function DequeueSendPacket: ISendPacket;
protected
Client_: TIdTCPClient;
dtConn_: TDateTime;
bConnected_,
bTryReconnect_: Boolean;
nSvrPktVer_: Integer;
QSendPacket_: TQueue<ISendPacket>;
// 프로세스 통신
W2W_: TTgWnd2Wnd;
hIpcWnd_: HWND;
NpIpc_: TTgNpBase; // NamedPipe 통신
function GetConnected: Boolean; virtual;
function _ProcessRcv: Boolean;
function _ProcessSend(Send: ISendPacket): Boolean; virtual;
function _ProcessOther: Boolean; virtual;
procedure _ProcessSendFail(Send: ISendPacket); virtual;
procedure Execute; override;
procedure SetHost(const sHost: String);
procedure SetPort(const nPort: Integer);
function GetTryReconnect: Boolean;
procedure SetTryReconnect(const bVal: Boolean);
procedure SetPacketEncryptInfo(aPktEncKind: TTgEncKind; const sPktEncPass: String);
procedure ConnectedEvent; virtual;
procedure DisconnectedEvent; virtual;
procedure ProcessRcvPacket(aRcv: IRcvPacket); virtual;
function GetSendPauseState: Boolean;
procedure SetSendPauseState(bVal: Boolean);
procedure OnW2WConnection(Sender: TTgObject; aState: TW2wConnState; hRcvWnd: HWND);
procedure OnNpConnected(Sender: TTgNpBase; hPipe: THandle);
procedure OnNpDisconnected(Sender: TTgNpBase; hPipe: THandle);
public
Constructor Create(const sHost: String; nPort: Integer;
nReConnTerm: Integer = 5000; nPingTerm: Integer = 60000);
Destructor Destroy; override;
procedure Lock;
procedure Unlock;
procedure SendPacket(Send: ISendPacket); virtual;
procedure DirectSendPacket(Send: ISendPacket);
function Connect(const sHost: String; nPort: Integer): Boolean; overload;
function Connect: Boolean; overload;
function GetSelfWnd: HWND;
function ActiveW2W(sClassName: String = ''; hInst: HMODULE = 0): Boolean;
procedure DeactiveW2W;
function ConnectWnd(hConnWnd: HWND): Boolean;
function ActiveNp(sPipeName: String; bNpServer: Boolean): Boolean; virtual;
function ConnectNp: Boolean;
procedure DeactiveNp;
procedure Disconnect;
property Host: String read sHost_ write SetHost;
property Port: Integer read nPort_ write SetPort;
property Connected: Boolean read GetConnected write SetConnected;
property TryReconnect: Boolean read bTryReconnect_ write SetTryReconnect;
property ConnDT: TDateTime read dtConn_;
end;
implementation
uses
IdStack, IdGlobal, IdException, IdExceptionCore, Tocsg.PacketDefine,
Tocsg.WinInfo, Tocsg.DateTime, Tocsg.Network, Tocsg.WTS, Tocsg.Process, Define;
function PosBin(const pFind, pDestBuf: TBytes; nBeginOffset: Integer = 0): Integer;
var
i, j, lp, ld: integer;
begin
lp := Length(pFind);
ld := Length(pDestBuf);
Result := -1;
if (lp > ld) or (nBeginOffset >= ld) then
Exit;
for i := nBeginOffset to ld-lp-1 do
begin
for j := 0 to lp -1 do
begin
if pFind[j] <> pDestBuf[i + j] then
Break;
if j = lp-1 then
Result := i;
end;
if Result <> -1 then
Break;
end;
end;
{ TTgClientBase }
Constructor TTgClientBase.Create(const sHost: String; nPort: Integer;
nReConnTerm: Integer = 5000; nPingTerm: Integer = 60000);
begin
CS_ := TCriticalSection.Create;
Inherited Create;
PktEncKind_ := ekNone;
nSvrPktVer_ := 0;
bSendPause_ := true;
nReConnTerm_ := nReConnTerm;
if nReConnTerm_ < 1000 then
nReConnTerm_ := 1000;
nPingTerm_ := nPingTerm;
// if nPingTerm_ < 60000 then
// nPingTerm_ := 60000;
Enc_ := nil;
W2W_ := nil;
hIpcWnd_ := 0;
NpIpc_ := nil;
_DcRcvBufs := TDictionary<LONGLONG,PClientRcvPacket>.Create;
_DcRcvBufs.OnValueNotify := OnRcvBufNotify;
_pRcvPkt := nil;
SetLength(_pInitBuf, 0);
sHost_ := sHost;
nPort_ := nPort;
dwPingTick_ := 0;
dwDisconnTick_ := 0;
dtConn_ := 0;
bConnected_ := false;
bTryReconnect_ := false;
QSendPacket_ := TQueue<ISendPacket>.Create;
if nPort <> -1 then
begin
Client_ := TIdTCPClient.Create(nil);
Client_.OnConnected := _ConnectedEvent;
Client_.OnDisconnected := _DisconnectedEvent;
Client_.ConnectTimeout := 10000;
Client_.ReadTimeout := 20000;
end else
Client_ := nil;
StartThread;
end;
Destructor TTgClientBase.Destroy;
begin
Inherited;
DeactiveW2W;
DeactiveNp;
if Client_ <> nil then
FreeAndNil(Client_);
FreeAndNil(QSendPacket_);
FreeAndNil(_DcRcvBufs);
if Assigned(Enc_) then
FreeAndNil(Enc_);
FreeAndNil(CS_);
end;
procedure TTgClientBase.OnRcvBufNotify(Sender: TObject; const Item: PClientRcvPacket; Action: TCollectionNotification);
begin
case Action of
cnAdded: ;
cnRemoved:
begin
if Item.pBuf <> nil then
FreeMem(Item.pBuf);
Dispose(Item);
end;
cnExtracted: ;
end;
end;
procedure TTgClientBase.Lock;
begin
CS_.Acquire;
end;
procedure TTgClientBase.Unlock;
begin
CS_.Release;
end;
function TTgClientBase.GetSendPauseState: Boolean;
begin
Lock;
try
Result := bSendPause_;
finally
Unlock;
end;
end;
procedure TTgClientBase.SetSendPauseState(bVal: Boolean);
begin
Lock;
try
bSendPause_ := bVal;
finally
Unlock;
end;
end;
procedure TTgClientBase.OnW2WConnection(Sender: TTgObject; aState: TW2wConnState; hRcvWnd: HWND);
begin
if W2W_ <> nil then
begin
try
case aState of
wcsConnect :
begin
if (hIpcWnd_ <> 0) and (hIpcWnd_ <> hRcvWnd) then
Disconnect;
hIpcWnd_ := hRcvWnd;
// _Trace('W2W - OnW2WConnection(), hIpcWnd_=%d, PID=%d', [hIpcWnd_, GetProcessPIDFromWndHandle(hIpcWnd_)]);
if hIpcWnd_ <> 0 then
_ConnectedEvent(nil);
end;
wcsDisconnect :
begin
_DisconnectedEvent(nil);
hIpcWnd_ := 0;
W2W_.ClearQueue;
end;
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. OnW2WConnection()');
end;
end;
end;
procedure TTgClientBase.OnNpConnected(Sender: TTgNpBase; hPipe: THandle);
begin
_ConnectedEvent(nil);
end;
procedure TTgClientBase.OnNpDisconnected(Sender: TTgNpBase; hPipe: THandle);
begin
_DisconnectedEvent(nil);
end;
procedure TTgClientBase._ConnectedEvent(Sender: TObject);
begin
SetPacketEncryptInfo(ekNone, '');
dwPingTick_ := GetTickCount;
_Trace('ConnectedEvent()', 3);
if Client_ <> nil then
SetHost(Client_.Host);
if Client_ <> nil then
SetPort(Client_.Port);
SetConnected(true);
ConnectedEvent;
end;
procedure TTgClientBase._DisconnectedEvent(Sender: TObject);
begin
dwDisconnTick_ := GetTickCount;
_Trace('DisconnectedEvent()', 3);
SetConnected(false);
DisconnectedEvent;
SetPacketEncryptInfo(ekNone, '');
end;
function TTgClientBase.GetPktEncKind: TTgEncKind;
begin
Lock;
try
Result := PktEncKind_;
finally
Unlock;
end;
end;
function TTgClientBase.GetConnected: Boolean;
begin
Lock;
try
Result := bConnected_;
finally
Unlock;
end;
end;
procedure TTgClientBase.SetConnected(const bVal: Boolean);
begin
Lock;
try
if bConnected_ <> bVal then
begin
bConnected_ := bVal;
if bVal then
dtConn_ := Now
else
dtConn_ := 0;
end;
finally
Unlock;
end;
end;
procedure TTgClientBase.SetHost(const sHost: String);
begin
if not GetConnected then
begin
if sHost_ <> sHost then
begin
sHost_ := sHost;
end;
end else
raise ETgClient.Create('접속중일 때에는 IP를 변경 할 수 없습니다.');
end;
procedure TTgClientBase.SetPort(const nPort: Integer);
begin
if not GetConnected then
begin
if nPort_ <> nPort then
begin
nPort_ := nPort;
end;
end else
raise ETgClient.Create('접속중일 때에는 Port를 변경 할 수 없습니다.');
end;
function TTgClientBase.GetTryReconnect: Boolean;
begin
Lock;
try
Result := bTryReconnect_;
finally
Unlock;
end;
end;
procedure TTgClientBase.SetTryReconnect(const bVal: Boolean);
begin
Lock;
try
if bTryReconnect_ <> bVal then
bTryReconnect_ := bVal;
finally
Unlock;
end;
end;
procedure TTgClientBase.SetPacketEncryptInfo(aPktEncKind: TTgEncKind; const sPktEncPass: String);
begin
Lock;
try
PktEncKind_ := aPktEncKind;
PktEncPass_ := sPktEncPass;
if Assigned(Enc_) then
FreeAndNil(Enc_);
if PktEncKind_ <> ekNone then
Enc_ := TTgEncrypt.Create(sPktEncPass, PktEncKind_);
finally
Unlock;
end;
end;
procedure TTgClientBase.ConnectedEvent;
var
Send: ISendPacket;
begin
Send := TTgPacket.Create(TOC_CLIENT_INFO);
with Send do
begin
I['Type'] := CLIENT_TYPE;
S['Ver'] := CLIENT_VER;
S['ComName'] := GetComName;
S['Account'] := WTS_GetCurrentUserName;
S['WinVer'] := GetWinVer;
D['BootDT'] := GetBootTime;
S['rIP'] := GetHostIP;
S['IpAddrs'] := GetIPAddrsToCommaStrEx;
S['MacAddr'] := GetMACAddrUsing;
S['MacAddrs'] := GetMACAddrToCommaStr;
D['CltDT'] := Now;
end;
Sleep(500);
DirectSendPacket(Send);
_Trace('Send Client Info.', 3);
end;
procedure TTgClientBase.DisconnectedEvent;
begin
SetSendPauseState(true);
end;
procedure TTgClientBase.ProcessRcvPacket(aRcv: IRcvPacket);
procedure process_QTC_CONFIRM_PACKET_ENCRYPT;
var
PktEncKind: TTgEncKind;
Send: ISendPacket;
begin
PktEncKind := TTgEncKind(aRcv.I['K']);
nSvrPktVer_ := aRcv.I['SPV'];
case PktEncKind of
ekAes256cbc,
ekAes192cbc,
ekAes128cbc : ; // 지원
else
begin
PktEncKind := ekNone;
end;
end;
Send := TTgPacket.Create(aRcv, pkCritical);
Send.I['K'] := LONGLONG(PktEncKind);
Send.I['CPV'] := PACKET_VERSION;
DirectSendPacket(Send);
end;
procedure process_QTC_UPDATE_PACKET_ENCRYPT;
var
PktEncKind: TTgEncKind;
sPass: String;
bResult: Boolean;
nLen: Integer;
Send: ISendPacket;
begin
// _Trace('process_QTC_UPDATE_PACKET_ENCRYPT');
bResult := false;
PktEncKind := TTgEncKind(aRcv.I['K']);
sPass := aRcv.S['J'];
try
case PktEncKind of
ekAes256cbc,
ekAes192cbc,
ekAes128cbc :
begin
sPass := DecBinStrToStr(PktEncKind, ENC_PASSPASS, sPass);
nLen := Length(sPass);
if nLen > 7 then
sPass := Copy(sPass, 4, nLen - 7)
else exit;
end
else sPass := '';
end;
bResult := true;
finally
if (sPass <> '') and bResult then
begin
// 성공했다면 서버에 통보 14_0703 16:23:49 sunk
Send := TTgPacket.Create(TOC_UPDATE_PACKET_ENCRYPT, pkCritical); // 중요 패킷 구분 14_0704 16:52:06 sunk
DirectSendPacket(Send);
SetPacketEncryptInfo(PktEncKind, sPass);
end;
// 암호화 정보 송수신 완료전까지 다른 패킷 전송 금지 18_0117 14:45:40 sunk
SetSendPauseState(false);
end;
end;
begin
try
case aRcv.Command of
TOC_CONFIRM_PACKET_ENCRYPT : process_QTC_CONFIRM_PACKET_ENCRYPT;
TOC_UPDATE_PACKET_ENCRYPT : process_QTC_UPDATE_PACKET_ENCRYPT;
TOC_PING :
begin
if not GetSendPauseState then
begin
// 핑 받을때까지 전송 대기라면... 패킷 암호화 설정 정보를 못 받았다고 판단.. 다시 요청한다. 22_0412 11:00:43 kku
_Trace('CRM_PING .. PauseState true?? .. Request Sv-SendPacketEncConfirm()');
SendPacket(TTgPacket.Create(TOC_REQUEST_CONFIRM_PACKET_ENCRYPT));
end;
end;
end;
except
on E: Exception do
ETgClient.TraceException(Self, E, 'Fail .. ProcessRcvPacket()');
end;
end;
procedure TTgClientBase.SendPacket(Send: ISendPacket);
begin
if GetConnected then
begin
Lock;
try
QSendPacket_.Enqueue(Send);
finally
Unlock;
end;
end else
_ProcessSendFail(Send);
end;
function TTgClientBase.DequeueSendPacket: ISendPacket;
begin
Lock;
try
if not bSendPause_ and
(QSendPacket_.Count > 0) then
Result := QSendPacket_.Dequeue
else
Result := nil;
finally
Unlock;
end;
end;
procedure TTgClientBase.DirectSendPacket(Send: ISendPacket);
begin
try
_ProcessSend(Send);
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. DirectSendPacket()');
end;
end;
function TTgClientBase.Connect(const sHost: String; nPort: Integer): Boolean;
var
nOldCTO,
nOldRTO: Integer;
begin
if Client_ = nil then
begin
Result := false;
exit;
end;
Result := true;
if not GetConnected then
begin
_DcRcvBufs.Clear;
_pRcvPkt := nil;
SetLength(_pInitBuf, 0);
SetLength(_RcylBuf, 0);
_nRcylBufLen := 0;
_nRcylBufPos := 0;
with Client_ do
begin
PktEncKind_ := ekNone;
nSvrPktVer_ := 0;
Host := sHost;
Port := nPort;
nOldCTO := ConnectTimeout;
nOldRTO := ReadTimeout;
ConnectTimeout := 20000;
ReadTimeout := 30000;
try
try
Client_.Connect;
Socket.RecvBufferSize := 32 * 1024;
Socket.SendBufferSize := 32 * 1024;
Result := true;
SetConnected(true);
except
on E: EIdSocketError do
begin
if E.LastError <> 10061 then // 서버 활성화 안됐을때 접속 시도 시 이게 계속 로그에 찍혀서 제외처리
ETgException.TraceException(Self, E, 'Fail .. Connect()');
Result := false;
SetConnected(false);
exit;
end;
on E: Exception do
begin
ETgClient.TraceException(Self, E, 'Fail .. Connect()');
Result := false;
SetConnected(false);
exit;
end;
end;
finally
ReadTimeout := nOldRTO;
ConnectTimeout := nOldCTO;
end;
end;
end;
end;
function TTgClientBase.Connect: Boolean;
begin
if (sHost_ <> '') and (nPort_ <> 0) then
Result := Connect(sHost_, nPort_)
else
Result := false;
end;
function TTgClientBase.GetSelfWnd: HWND;
begin
if W2W_ <> nil then
Result := W2W_.RcWnd
else
Result := 0;
end;
function TTgClientBase.ActiveW2W(sClassName: String = ''; hInst: HMODULE = 0): Boolean;
begin
if W2W_ = nil then
begin
W2W_ := TTgWnd2Wnd.Create(sClassName, hInst);
W2W_.OnW2WConnection := OnW2WConnection;
Result := true;
end else
Result := false;
end;
procedure TTgClientBase.DeactiveW2W;
begin
if W2W_ <> nil then
begin
Disconnect;
FreeAndNil(W2W_);
end;
end;
function TTgClientBase.ConnectWnd(hConnWnd: HWND): Boolean;
begin
Result := false;
if not GetConnected and (W2W_ <> nil) then
begin
try
if (hConnWnd <> 0) and (hConnWnd <> hIpcWnd_) then
begin
Result := SendMessage(hConnWnd, WM_WND_HANDSHAKE, NativeUInt(wcsConnect), W2W_.RcWnd) = WM_WND_HANDSHAKE;
if Result then
begin
hIpcWnd_ := hConnWnd;
_ConnectedEvent(nil);
end
{$IFDEF DEBUG}
else
_Trace('Fail .. W2W - ConnectWnd() .. SendData()');
{$ENDIF};
end;
except
on E: EXception do
ETgException.TraceException(Self, E, 'Fail .. W2W - ConnectWnd()');
end;
end;
end;
function TTgClientBase.ActiveNp(sPipeName: String; bNpServer: Boolean): Boolean;
begin
if NpIpc_ = nil then
begin
if bNpServer then
begin
NpIpc_ := TTgNpServer.Create(sPipeName);
SetSendPauseState(false);
end else begin
NpIpc_ := TTgNpClient.Create(sPipeName);
NpIpc_.OnConnected := OnNpConnected;
NpIpc_.OnDisconnected := OnNpDisconnected;
end;
Result := true;
end else
Result := false;
end;
function TTgClientBase.ConnectNp: Boolean;
begin
Result := false;
if not GetConnected and (NpIpc_ <> nil) then
begin
try
if NpIpc_.IsServer then
begin
Result := TTgNpServer(NpIpc_).Listen;
SetConnected(Result);
end else begin
Result := TTgNpClient(NpIpc_).Connect;
if Result then
_ConnectedEvent(nil);
end;
except
on E: EXception do
ETgException.TraceException(Self, E, 'Fail .. NpIpc - ConnectWnd()');
end;
end;
end;
procedure TTgClientBase.DeactiveNp;
begin
if NpIpc_ <> nil then
FreeAndNil(NpIpc_);
end;
procedure TTgClientBase.Disconnect;
begin
try
_Trace('Disconnect()', 3);
SetConnected(false);
if W2W_ <> nil then
begin
W2W_.ClearQueue;
if hIpcWnd_ <> 0 then
begin
_DisconnectedEvent(nil);
SendMessage(hIpcWnd_, WM_WND_HANDSHAKE, NativeUInt(wcsDisconnect), W2W_.RcWnd);
hIpcWnd_ := 0;
end;
end else
if NpIpc_ <> nil then
begin
if NpIpc_.IsServer then
begin
TTgNpServer(NpIpc_).Close;
end else begin
TTgNpClient(NpIpc_).Disconnect;
_DisconnectedEvent(nil);
end;
end else begin
if Client_.Socket <> nil then
begin
Client_.Socket.InputBuffer.Clear;
Client_.Socket.CloseGracefully;
end;
Client_.Disconnect;
_DcRcvBufs.Clear;
_pRcvPkt := nil;
_DisconnectedEvent(Client_);
end;
except
//
end;
end;
function TTgClientBase._ProcessRcv: Boolean;
procedure PK_ReadBytes(var aBuffer: TBytes; nCount: Integer);
var
nLen, nRead,
nNewPktSigPos: Integer;
{$IFDEF Win64}
arrSig: TBytes;
{$ENDIF}
begin
if _nRcylBufLen > _nRcylBufPos then
begin
// 20200131TEST!!
// _Trace('PK_ReadBytes .. _RcylBuf Read~');
nLen := Length(aBuffer);
if (_nRcylBufLen - _nRcylBufPos) > nCount then
nRead := nCount
else
nRead := _nRcylBufLen - _nRcylBufPos;
SetLength(aBuffer, nLen + nRead);
CopyMemory(@aBuffer[nLen], @_RcylBuf[_nRcylBufPos], nRead);
Inc(_nRcylBufPos, nRead);
end else
Client_.Socket.ReadBytes(TIdBytes(aBuffer), nCount, true);
if (_nRcylBufLen > 0) and (_nRcylBufLen <= _nRcylBufPos) then
begin
// 20200131TEST!!
// _Trace('PK_ReadBytes .. _RcylBuf Clear~~~~~');
_nRcylBufLen := 0;
_nRcylBufPos := 0;
SetLength(_RcylBuf, 0);
end;
// 읽은 버퍼 뒤에 새로운 패킷 시작이 있는지 확인 20_0131 15:17:22 sunk
{$IFDEF Win64}
// 64에서 이렇게 안하면 Range 오류나서 위 코드 추가 (11.1) 22_1208 09:22:00 kku
SetLength(arrSig, LEN_CTX_PACKET_SIGNATURE);
CopyMemory(arrSig, @CTX_PACKET_SIGNATURE[1], LEN_CTX_PACKET_SIGNATURE);
nNewPktSigPos := PosBin(arrSig, aBuffer, 1 {SearchBeginOffset});
{$ELSE}
nNewPktSigPos := PosBin(TBytes(@CTX_PACKET_SIGNATURE[1]), aBuffer, 1 {SearchBeginOffset});
{$ENDIF}
if nNewPktSigPos > 0 then
begin
// 20200131TEST!!
// _Trace('PK_ReadBytes .. Found NewPktSigPos~');
nLen := Length(aBuffer);
if _nRcylBufLen = 0 then
begin
_nRcylBufLen := nLen - nNewPktSigPos;
SetLength(_RcylBuf, _nRcylBufLen);
CopyMemory(@_RcylBuf[0], @aBuffer[nNewPktSigPos], _nRcylBufLen);
SetLength(aBuffer, nLen - _nRcylBufLen);
end else begin
Dec(_nRcylBufPos, nLen - nNewPktSigPos);
SetLength(aBuffer, nLen - (nLen - nNewPktSigPos));
end;
end;
end;
var
pDecBuf,
pTempBuf: TBytes;
nInitBufLen,
nBufLen, nDecLen: Integer;
PktEncKind: TTgEncKind;
Rcv: IRcvPacket;
{$IFDEF _ENC_TEST_}
sPath,
sAlgo: String;
sData: AnsiString;
fs: TFileStream;
{$ENDIF}
pData: PWndDataEnt;
Label
LB_READ_BYTES;
begin
Result := false;
if W2W_ <> nil then
begin
try
pData := W2W_.DeququeData;
if pData = nil then
exit;
if pData.llSender <> hIpcWnd_ then
begin
_Trace('Change Sender HWND ..');
hIpcWnd_ := pData.llSender;
exit;
end;
// Rcv := TTgPacket.Create(Copy(PChar(pData.pBuf), 1, pData.dwLen));
Rcv := TTgPacket.Create(Copy(PChar(pData.pBuf), 1, (pData.dwLen div 2) - 1));
FreeMem(pData.pBuf, pData.dwLen);
Dispose(pData);
ProcessRcvPacket(Rcv);
Result := true;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. W2W - _ProcessRcv()');
end;
end else
if NpIpc_ <> nil then
begin
try
if NpIpc_.RcvData(pTempBuf) > 0 then
begin
Rcv := TTgPacket.Create(pTempBuf, true);
if NpIpc_.IsServer then
TTgPacket(Rcv).Toss := TTgNpServer(NpIpc_).LastRcvPipe;
ProcessRcvPacket(Rcv);
Result := true;
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. NpIPC - _ProcessRcv()');
end;
end else begin
if Client_ = nil then
exit;
try
if not Client_.Socket.Readable(1) and
(Client_.Socket.InputBuffer.Size = 0) then exit;
if (_pRcvPkt = nil) or (_pRcvPkt.llId <> -1) then
begin
// 이전 버전이랑 구분하기 위해서 만들었는 위치가 좋지 않지만 일단 이렇게 활용한다. 18_0411 16:08:51 sunk
// 암호화 지원 확인 전까진 최신 버전도 (sServerVer_ = '') 상태이긴 한데...
// 32K 미만이면 괜찮고 암호화 지원 확인 전까진 32K 이상 패킷이 없기 때문에...
// 일단 이렇게 간다...아아아아앙앙ㅇㅇㅇ아ㅏㅏㅏㅏ 18_0411 17:40:50 sunk
// if sServerVer_ <> '' then
// 서버에서도 패킷 버전을 통보하여 해당 정보를 통해 별도 식별 후 처리 18_0423 10:44:29 sunk
// if nSvrPktVer_ >= 4 then
begin
// 서버에서 32k 단위로 헤더 달아서 쪼개서 보내는걸 그냥 모아서 보내는걸로 수정했다.
// 따라서 클라이언트 단에서 쪼개서 받을때 무조건 헤드를 검사하면 안된다.
if (_pRcvPkt <> nil) and (_pRcvPkt.llId <> -1) then
begin
// 헤더 확인 안하고 이어서 받기 처리 추가 18_0411 15:21:28 sunk
if _DcRcvBufs.ContainsKey(_pRcvPkt.llId) then
begin
_pRcvPkt := _DcRcvBufs[_pRcvPkt.llId];
if _pRcvPkt.nRemainPktLen > 0 then
goto LB_READ_BYTES;
end;
end;
end;
if Length(_pInitBuf) = 0 then
PK_ReadBytes(_pInitBuf, 6)
else
PK_ReadBytes(_pInitBuf, 1);
// 6 이 아니면... 여기서 통신 먹통되는 현상 확인 20_0131 16:30:11 sunk
// _pInitBuf 이거 재활용 하면서 6 이상이 되는 경우가 종종 발생한다.
// if Length(_pInitBuf) <> 6 then
nInitBufLen := Length(_pInitBuf);
if nInitBufLen < 6 then // 6 이하면 넘기는걸로 수정 20_0131 16:30:26 sunk
exit;
// ------------- 주의 ----------------------------------------------------
// 현재 서버에서 데이터를 큰 패킷단위로 쪼개서 보낼때....
// 중간중간 작은 패킷이 중간에 껴서 오는 문제가 있다...
// 서버 워크스레드로 동시에 보내서 발생하는 문제인것 같은데...
//
// 패킷 조각이 좀 크면 그 조각 데이터 사이에 작은 별도패킷이 끼고
// 다른 패킷 조각이 새로 새치기 되고... 등등
// 서버에서 패킷 전송 시 하나의 스레드로 보내도록 하는 방법밖에 없을거 같긴하다.
// 일단 그냥 이대로 쓰는걸로... 20_0203 14:06:47 sunk
// -----------------------------------------------------------------------
if CompareMem(@_pInitBuf[0], @CTX_PACKET_SIGNATURE[1], 6) then
begin
if nInitBufLen < LEN_CTX_PACKET_HEADER then
PK_ReadBytes(_pInitBuf, LEN_CTX_PACKET_HEADER - nInitBufLen)
else
_Trace('No~~~ Don''t read CTX_PACKET_HEADER');
if not _DcRcvBufs.ContainsKey(PCtxPacketHeader(_pInitBuf).dwId) then
begin
New(_pRcvPkt);
ZeroMemory(_pRcvPkt, SizeOf(TClientRcvPacket));
_pRcvPkt.wRank := PCtxPacketHeader(_pInitBuf).wRank;
_pRcvPkt.llId := PCtxPacketHeader(_pInitBuf).dwId;
_pRcvPkt.nRemainPktLen := PCtxPacketHeader(_pInitBuf).dwSize;
_pRcvPkt.pBuf := AllocMem(_pRcvPkt.nRemainPktLen);
_DcRcvBufs.Add(_pRcvPkt.llId, _pRcvPkt);
end else
_pRcvPkt := _DcRcvBufs[PCtxPacketHeader(_pInitBuf).dwId];
SetLength(_pInitBuf, 0);
end else begin
if _pRcvPkt = nil then
begin
_pInitBuf[0] := _pInitBuf[1];
_pInitBuf[1] := _pInitBuf[2];
_pInitBuf[2] := _pInitBuf[3];
_pInitBuf[3] := _pInitBuf[4];
_pInitBuf[4] := _pInitBuf[5];
SetLength(_pInitBuf, 5);
Result := true;
exit;
end else
if _pRcvPkt.nRemainPktLen > 0 then
begin
nBufLen := Length(_pInitBuf);
// SetLength(pTempBuf, nBufLen);
// CopyMemory(@pTempBuf[0], @_pInitBuf[0], nBufLen);
CopyMemory(Pointer(NativeInt(_pRcvPkt.pBuf)+_pRcvPkt.nProcPktLen), @_pInitBuf[0], nBufLen);
Inc(_pRcvPkt.nProcPktLen, nBufLen);
Dec(_pRcvPkt.nRemainPktLen, nBufLen);
SetLength(_pInitBuf, 0);
SetLength(pTempBuf, 0);
goto LB_READ_BYTES;
end else begin
_DcRcvBufs.Remove(_pRcvPkt.llId);
_pRcvPkt := nil;
end;
end;
if (_pRcvPkt = nil) or (_pRcvPkt.nRemainPktLen = 0) then
begin
exit;
end;
SetLength(pTempBuf, 0);
LB_READ_BYTES :
// if not Client_.Socket.Readable(1) and
// (Client_.Socket.InputBuffer.Size = 0) then exit;
if _pRcvPkt.nRemainPktLen > BUFFER_SIZE then // TBytes 최대길이가 131071을 넘지 못해서 이렇게 잘라서 처리하도록 한다. 14_0610 17:31:00 sunk
PK_ReadBytes(pTempBuf, BUFFER_SIZE)
else
PK_ReadBytes(pTempBuf, _pRcvPkt.nRemainPktLen);
nBufLen := Length(pTempBuf);
if nBufLen > 0 then
begin
CopyMemory(Pointer(NativeInt(_pRcvPkt.pBuf)+_pRcvPkt.nProcPktLen), @pTempBuf[0], nBufLen);
Inc(_pRcvPkt.nProcPktLen, nBufLen);
Dec(_pRcvPkt.nRemainPktLen, nBufLen);
end;
end else begin
// 기존 패킷 처리 14_0610 14:42:13 sunk
if _pRcvPkt.nRemainPktLen > BUFFER_SIZE then // TBytes 최대길이가 131071을 넘지 못해서 이렇게 잘라서 처리하도록 한다. 14_0610 17:31:00 sunk
PK_ReadBytes(pTempBuf, BUFFER_SIZE)
else
PK_ReadBytes(pTempBuf, _pRcvPkt.nRemainPktLen);
nBufLen := Length(pTempBuf);
if nBufLen > 0 then
begin
CopyMemory(Pointer(NativeInt(_pRcvPkt.pBuf)+_pRcvPkt.nProcPktLen), @pTempBuf[0], nBufLen);
Inc(_pRcvPkt.nProcPktLen, nBufLen);
Dec(_pRcvPkt.nRemainPktLen, nBufLen);
end;
end;
Result := true;
// 20200131TEST!!
// if _pRcvPkt.nRemainPktLen < 0 then
// _pRcvPkt.nRemainPktLen := _pRcvPkt.nRemainPktLen + 0;
if (_pRcvPkt <> nil) and (_pRcvPkt.nRemainPktLen = 0) then
begin
// 20200131TEST!!
// if _nRcylBufLen > 0 then
// _Trace('MakePacket ... _nRcylBufLen = %d, _nRcylBufPos = %d', [_nRcylBufLen, _nRcylBufPos]);
// 암호화 패킷 처리 추가 14_0704 10:15:21 sunk
PktEncKind := GetPktEncKind;
if PktEncKind <> ekNone then
begin
Lock;
try
ASSERT(Enc_ <> nil, 'none.. encrypt obj ..');
pDecBuf := Enc_.DecryptBufferEx(_pRcvPkt.pBuf, _pRcvPkt.nProcPktLen);
finally
Unlock;
end;
case PktEncKind of
ekAes256cbc,
ekAes192cbc,
ekAes128cbc:
begin
// 언패딩이 필요한 알고리즘의 경우,
// 언패딩 후 길이를 다시 계산. 18_0411 10:08:16 sunk
nDecLen := Length(pDecBuf);
end;
else
nDecLen := _pRcvPkt.nProcPktLen;
end;
// if (nSvrPktVer_ < 4) and (nDecLen > 5) and
// (pDecBuf[0] <> 123) and (pDecBuf[1] <> 34) and
// (pDecBuf[4] = 123) and (pDecBuf[5] = 34) then // 올드 서버 패킷 체크 ....
// Rcv := TTgPacket.Create(@pDecBuf[4], nDecLen-4)
// else
Rcv := TTgPacket.Create(@pDecBuf[0], nDecLen);
end else begin
// if (nSvrPktVer_ < 4) and (_pRcvPkt.nProcPktLen > 5) and
// (TBytes(_pRcvPkt.pBuf)[0] <> 123) and (TBytes(_pRcvPkt.pBuf)[1] <> 34) and
// (TBytes(_pRcvPkt.pBuf)[4] = 123) and (TBytes(_pRcvPkt.pBuf)[5] = 34) then // 올드 서버 패킷 체크 ....
// begin
// // 서버 버전이 표시 되지 않는 옛날 서버의 경우 (AES 알고리즘 추가전)
// // 패킷 버전이 1,2가 이닌 3인걸 보고 데이터 퍼버 앞 4바이트에 크기 정보도 함께 보내준다.
// // 그래서 앞에 4바이트 잘라서 처리해줘야한다. 18_0411 17:14:33 sunk
// Rcv := TTgPacket.Create(Pointer(NativeInt(_pRcvPkt.pBuf)+4), _pRcvPkt.nProcPktLen-4);
// end else
Rcv := TTgPacket.Create(_pRcvPkt.pBuf, _pRcvPkt.nProcPktLen);
end;
{$IFDEF _ENC_TEST_}
case Rcv.Command of
1001 {QTC_CLIENT_INFO},
1111 {QTC_COLLECTOR_ENTER},
3101 {QTC_REQUEST_AGENT_LIST},
3406 {QTC_REQUEST_PI_DRIVELIST} :
begin
case PktEncKind of
ekNone : sAlgo := 'None';
ekAes256cbc : sAlgo := 'AES256CBC';
ekAes192cbc : sAlgo := 'AES192CBC';
ekAes128cbc : sAlgo := 'AES128CBC';
else
sAlgo := 'Unknown';
end;
sPath := ExtractFileDrive(GetCurrentPath) + '\QT_ENCTEST\';
if ForceDirectories(sPath) then
begin
sPath := sPath + Format('R-%s-TYP=%d-%s-Cmd=%d.pkt', [FormatDateTime('yyyymmddhhnnss', Now), CLIENT_TYPE, sAlgo, Rcv.Command]);
fs := TFileStream.Create(sPath, fmCreate);
try
if PktEncKind <> ekNone then
begin
sData := EncodeBase64(_pRcvPkt.pBuf, _pRcvPkt.nProcPktLen);
fs.Write(@sData[1], Length(sData));
end else
fs.Write(_pRcvPkt.pBuf^, _pRcvPkt.nProcPktLen);
finally
fs.Free;
end;
end;
end;
end;
{$ENDIF}
ProcessRcvPacket(Rcv);
if _pRcvPkt <> nil then // ProcessRcvPacket() 처리중에 Disconnect()가 올수도 있다.
begin
_DcRcvBufs.Remove(_pRcvPkt.llId);
_pRcvPkt := nil;
end;
end;
except
on e: EIdReadTimeout do
begin
ETgException.TraceException(Self, E, 'Fail.. _ProcessRcv()..');
exit;
end;
on e: ETgPacket do
begin
ETgException.TraceException(Self, E, '_ProcessRcv() .. Packet error ...');
if _pRcvPkt <> nil then
begin
_DcRcvBufs.Remove(_pRcvPkt.llId);
_pRcvPkt := nil;
end;
ETgException.TraceException(Self, E, 'Fail.. _ProcessRcv()..');
end;
on e: Exception do
begin
if _pRcvPkt <> nil then
begin
_DcRcvBufs.Remove(_pRcvPkt.llId);
_pRcvPkt := nil;
end;
ETgException.TraceException(Self, E, 'Fail.. _ProcessRcv()..');
raise;
end;
end;
end;
end;
function TTgClientBase._ProcessSend(Send: ISendPacket): Boolean;
var
pBuf,
pSendBuf: TBytes;
nLen, nTotalLen: Integer;
CtxPacketHeader: TCtxPacketHeader;
PktEncKind: TTgEncKind;
{$IFDEF _ENC_TEST_}
sPath,
sAlgo: String;
sData: AnsiString;
fs: TFileStream;
{$ENDIF}
procedure ProcessEncrypt;
var
pData,
pEncData: TBytes;
begin
nLen := Send.ToBytesDataOnly(pData);
if nLen > 0 then
begin
Lock;
try
{$IFDEF DEBUG}
ASSERT(Enc_ <> nil, 'none.. encrypt obj ..');
{$ENDIF}
pEncData := Enc_.EncryptBufferEx(@pData[0], nLen);
case PktEncKind of
ekAes256cbc,
ekAes192cbc,
ekAes128cbc:
begin
// 패딩이 필요한 알고리즘의 경우,
// 패딩 길이도 들어가야해서 다시 계산. 18_0411 10:08:16 sunk
nLen := Length(pEncData);
end;
end;
finally
Unlock;
end;
SetLength(pBuf, nLen);
CopyMemory(@pBuf[0], @pEncData[0], nLen);
end;
end;
begin
Result := false;
if Send = nil then
exit;
if W2W_ <> nil then
begin
try
if hIpcWnd_ <> 0 then
begin
// _Trace('W2W - SendData(), hIpcWnd_=%d, PID=%d', [hIpcWnd_, GetProcessPIDFromWndHandle(hIpcWnd_)]);
Result := W2W_.SendData(hIpcWnd_, Send);
if not Result then
begin
_Trace('Fail .. W2W - SendData()');
Disconnect;
end;
end;
except
on E: EXception do
ETgException.TraceException(Self, E, 'Fail .. W2W - _ProcessSend()');
end;
end else
if NpIpc_ <> nil then
begin
try
Result := NpIpc_.SendData(Send);
except
on E: EXception do
ETgException.TraceException(Self, E, 'Fail .. NpIPC - _ProcessSend()');
end;
end else begin
if Client_ = nil then
exit;
try
Lock;
try
PktEncKind := GetPktEncKind;
// _Trace('_ProcessSend() .. PktEncKind = %d', [Integer(PktEncKind)]);
if PktEncKind = ekNone then
nLen := Send.ToBytesDataOnly(pBuf)
// nLen := Send.ToBytes(pBuf)
else
ProcessEncrypt;
{$IFDEF _ENC_TEST_}
case Send.Command of
// 1001 {QTC_CLIENT_INFO},
// 1111 {QTC_COLLECTOR_ENTER},
3101 {QTC_REQUEST_AGENT_LIST},
3406 {QTC_REQUEST_PI_DRIVELIST} :
begin
case PktEncKind of
ekNone : sAlgo := 'None';
ekRc4 : sAlgo := 'RC4';
ekAes256cbc : sAlgo := 'AES256CBC';
ekAes192cbc : sAlgo := 'AES192CBC';
ekAes128cbc : sAlgo := 'AES128CBC';
else
sAlgo := 'Unknown';
end;
sPath := ExtractFileDrive(GetCurrentPath) + '\QT_ENCTEST\';
if ForceDirectories(sPath) then
begin
sPath := sPath + Format('S-%s-TYP=%d-%s-Cmd=%d.pkt', [FormatDateTime('yyyymmddhhnnss', Now), CLIENT_TYPE, sAlgo, Send.Command]);
fs := TFileStream.Create(sPath, fmCreate);
try
if PktEncKind <> ekNone then
begin
sData := EncodeBase64(pBuf, nLen);
fs.Write(@sData[1], Length(sData));
end else
fs.Write(pBuf[0], nLen);
finally
fs.Free;
end;
end;
end;
end;
{$ENDIF}
if nLen > 0 then
begin
// 헤더 추가
nTotalLen := LEN_CTX_PACKET_HEADER + nLen;
SetLength(pSendBuf, SIZE_INTEGER + nTotalLen);
CopyMemory(@pSendBuf[0], @nTotalLen, SIZE_INTEGER);
Inc(nTotalLen, SIZE_INTEGER);
ZeroMemory(@CtxPacketHeader, SizeOf(CtxPacketHeader));
CopyMemory(@CtxPacketHeader.sSig[0], @CTX_PACKET_SIGNATURE[1], Length(CtxPacketHeader.sSig));
CtxPacketHeader.dwSize := nLen;
CtxPacketHeader.wRank := WORD(Send.PacketKind);
CopyMemory(@pSendBuf[SIZE_INTEGER], @CtxPacketHeader, LEN_CTX_PACKET_HEADER);
CopyMemory(@pSendBuf[SIZE_INTEGER+LEN_CTX_PACKET_HEADER], @pBuf[0], nLen);
Client_.Socket.Write(TIdBytes(pSendBuf), nTotalLen);
Result := true;
end;
finally
Unlock;
SetLength(pBuf, 0);
end;
except
_ProcessSendFail(Send);
raise;
end;
end;
end;
// 전송중 연결끊김등으로 오유 났을때의 처리대비
// 예) QatorAgent에서 수집데이터 유실방지
procedure TTgClientBase._ProcessSendFail(Send: ISendPacket); begin end;
function TTgClientBase._ProcessOther: Boolean;
begin
Result := false;
if (NpIpc_ <> nil) and NpIpc_.IsServer and (NpIpc_.PipeName <> '') then
begin
if not TTgNpServer(NpIpc_).Active then
TTgNpServer(NpIpc_).Listen;
if TTgNpServer(NpIpc_).Active then
TTgNpServer(NpIpc_).DoAcceptPipe;
end;
end;
procedure TTgClientBase.Execute;
var
Send: ISendPacket;
bRcv, bSend, bOther: Boolean;
dwTick: DWORD;
begin
while not Terminated and not GetWorkStop do
begin
try
Send := DequeueSendPacket;
if GetConnected then
begin
bSend := _ProcessSend(Send);
bRcv := _ProcessRcv;
bOther := _ProcessOther;
if not bRcv and not bSend and not bOther then
begin
if NpIpc_ = nil then
begin
Sleep(50);
dwTick := GetTickCount;
if (dwTick - dwPingTick_) > nPingTerm_ then
begin
if W2W_ <> nil then
begin
if not IsWindow(hIpcWnd_) then
begin
Disconnect;
continue;
end;
end else
if Client_ <> nil then // 기본으로 생성되기 때문에 마지막에 넣음
begin
if not Client_.Connected then
begin
Disconnect;
continue;
end;
end;
// _Trace('Try send ping .... nPingTerm_ = %d', [nPingTerm_]);
_ProcessSend(TTgPacket.Create(0, pkIgnore));
dwPingTick_ := dwTick;
end;
end else Sleep(5);
end else dwPingTick_ := GetTickCount;
end else begin
// todo : 로컬 수집 추가 if Send <> nil then
Sleep(1000);
if (NpIpc_ <> nil) and not NpIpc_.IsServer and (NpIpc_.PipeName <> '') then
begin
dwTick := GetTickCount;
if GetTryReconnect and
((dwDisconnTick_ = 0) or ((dwTick - dwDisconnTick_) > nReConnTerm_)) then
begin
if TTgNpClient(NpIpc_).Connect then
_ConnectedEvent(nil)
else
dwDisconnTick_ := dwTick;
end;
end else
if W2W_ <> nil then
begin
// todo : 할게 있을까 23_0112 11:01:54 kku
end else begin
dwTick := GetTickCount;
if GetTryReconnect and
(sHost_ <> '') and (nPort_ <> 0) and
((dwDisconnTick_ = 0) or ((dwTick - dwDisconnTick_) > nReConnTerm_)) then
begin
if not Connect(sHost_, nPort_) then
begin
// _Trace('재접속 주기 %d초', [(dwTick - dwDisconnTick_) div 1000]);
dwDisconnTick_ := dwTick;
end;
end;
end;
end;
except
On e: EIdSocketError do
Case e.LastError of
10053, // 접속 비정상 종료
10054 : Disconnect;
else continue;
End;
On e: EIdConnClosedGracefully do
begin
Disconnect;
end else continue;
end;
end;
end;
end.