BSOne.SFC/Tocsg.Module/RemoteSecu/EXE_RemoteSecuServer/RSecuServer.pas

418 lines
10 KiB
Plaintext

{*******************************************************}
{ }
{ RdpSecuServer }
{ }
{ Copyright (C) 2022 kku }
{ }
{*******************************************************}
unit RSecuServer;
interface
uses
Tocsg.ServerBase, System.SysUtils, System.Classes, Winapi.Messages,
Winapi.Windows, Tocsg.Packet, Tocsg.StoredPacket, System.SyncObjs,
System.Generics.Collections, Winapi.Winsock2;
const
WM_CRMSERVER_NOTIFICATION = WM_USER + 4938;
NOTI_RCV_TEST = 0;
NOTI_SERVER_ON = 1;
NOTI_SERVER_OFF = 2;
NOTI_CLIENT_CONN = 3;
NOTI_CLIENT_DISCONN = 4;
NOTI_REFRESH_LIST = 5;
type
TTgClientCtx = class(TTgClientCtxBase)
private
sEmpNo_,
sRdpRqIp_: String;
bRdpOn_: Boolean;
public
Constructor Create(aServer: TTgServerBase; aSocket: TSocket);
property EmpNo: String read sEmpNo_;
property RdpOn: Boolean read bRdpOn_;
end;
TStdPktList = class(TList<TTgStoredPacket>)
protected
procedure Notify(const Item: TTgStoredPacket; Action: TCollectionNotification); override;
end;
TRSecuServer = class(TTgServerBase)
private
CSStored_: TCriticalSection;
wStdPktCnt_,
wStdPktPos_: WORD;
StdPktList_: TStdPktList;
ThdProcStdPkd_: TObject;
// 서버 상태알림 메시지 전송 핸들 22_0411 08:57:10 kku
hRcvHwnd_: THandle;
DcRdpOnCtx_: TDictionary<String,TTgClientCtx>;
protected
procedure SetActive(bVal: Boolean); override;
function CreateClientContext(aSocket: TSocket): TTgClientCtxBase; override;
procedure ClientConnectedEvent(aClientCtx: TTgClientCtxBase); override;
procedure ClientDisconnectedEvent(aClientCtx: TTgClientCtxBase); override;
procedure ProcessClientConnection(aCtx: TTgClientCtxBase); override;
procedure ProcessRcvPacket(aCtx: TTgClientCtxBase;
aRcv: IRcvPacket); override;
// procedure ProcessFileQueuePacket(ClientCtx: TTgClientCtxBase;
// RcvPacket: IRcvPacket); overload; override;
// procedure ProcessFileQueuePacket(ClientContext: TSunkClientContext; pRcvBuf: Pointer; nRcvLen: Integer); overload; override;
public
Constructor Create(hRcvHwnd: HWND; nPort: Integer);
Destructor Destroy; override;
procedure SafeFreeUseSaveStored(const sPath: String);
end;
var
gServer: TRSecuServer = nil;
implementation
uses
Tocsg.Exception, ThdProcStoredPacket, Tocsg.PacketDefine, GlobalSocketDefine, Tocsg.Safe, superobject;
{ TTgClientCtx }
Constructor TTgClientCtx.Create(aServer: TTgServerBase; aSocket: TSocket);
begin
Inherited Create(aServer, aSocket);
sEmpNo_ := '';
sRdpRqIp_ := '';
bRdpOn_ := false;
end;
{ TStdPktList }
procedure TStdPktList.Notify(const Item: TTgStoredPacket; Action: TCollectionNotification);
begin
if Action = cnRemoved then
Item.Free;
end;
{ TRSecuServer }
Constructor TRSecuServer.Create(hRcvHwnd: HWND; nPort: Integer);
begin
Inherited Create(nPort);
ASSERT(gServer = nil);
gServer := Self;
hRcvHwnd_ := hRcvHwnd;
ThdProcStdPkd_ := nil;
CSStored_ := TCriticalSection.Create;
DcRdpOnCtx_ := TDictionary<String,TTgClientCtx>.Create;
wStdPktCnt_ := 0;
wStdPktPos_ := 0;
StdPktList_ := TStdPktList.Create;
end;
Destructor TRSecuServer.Destroy;
begin
gServer := nil;
Inherited;
if ThdProcStdPkd_ <> nil then
FreeAndNil(ThdProcStdPkd_);
FreeAndNil(CSStored_);
FreeAndNil(DcRdpOnCtx_);
FreeAndNil(StdPktList_);
end;
procedure TRSecuServer.SetActive(bVal: Boolean);
var
i: Integer;
StdPkt: TTgStoredPacket;
begin
if bActive_ = bVal then
exit;
if bVal then
begin
// todo : 각종 경로 설정
if ThdProcStdPkd_ <> nil then
FreeAndNil(ThdProcStdPkd_);
wStdPktPos_ := 0;
wStdPktCnt_ := 0; // gCfg.PktDiv
if wStdPktCnt_ > 0 then
begin
if wStdPktCnt_ > 20 then
wStdPktCnt_ := 20;
for i := 0 to wStdPktCnt_ - 1 do
begin
StdPkt := TTgStoredPacket.Create(Format('c:\test\Pkt%.2d\stdpkt', [i + 1]));
StdPkt.SegSize := MAX_DATA_SIZE; // gCfg.StdPktSegSize
StdPktList_.Add(StdPkt);
end;
end else begin
StdPkt := TTgStoredPacket.Create('c:\test_stdPkt');
StdPkt.SegSize := MAX_DATA_SIZE; // gCfg.StdPktSegSize
StdPktList_.Add(StdPkt);
// ThdProcStdPkd_ := TThdProcStoredPacketFile.Create('', '', 500);
end;
end else begin
end;
Inherited;
// after process .. 14_0121 17:56:36 sunk
if bActive_ then
begin
if hRcvHwnd_ <> 0 then
SendMessage(hRcvHwnd_, WM_CRMSERVER_NOTIFICATION, NOTI_SERVER_ON, 0);
end else begin
// todo : 초기화 처리
if hRcvHwnd_ <> 0 then
SendMessage(hRcvHwnd_, WM_CRMSERVER_NOTIFICATION, NOTI_SERVER_OFF, 0);
DcRdpOnCtx_.Clear;
if ThdProcStdPkd_ <> nil then
begin
TThdProcStoredPacketFile(ThdProcStdPkd_).StopThread;
Sleep(500);
FreeAndNil(ThdProcStdPkd_);
end;
StdPktList_.Clear;
end;
end;
function TRSecuServer.CreateClientContext(aSocket: TSocket): TTgClientCtxBase;
begin
Result := TTgClientCtx.Create(Self, aSocket);
end;
procedure TRSecuServer.ClientConnectedEvent(aClientCtx: TTgClientCtxBase);
var
ClientCtx: TTgClientCtx;
begin
// if aClientCtx is TTgClientCtx then
// begin
// ClientCtx := TTgClientCtx(aClientCtx);
// if ClientCtx.ClientInfo.ClientType <> CLIENT_TYPE_MANAGER then
// begin
//
// end;
// end;
Inherited;
end;
procedure TRSecuServer.ClientDisconnectedEvent(aClientCtx: TTgClientCtxBase);
var
enum: TClientEnumerator;
Ctx,
CtxEnt: TTgClientCtx;
Send: ISendPacket;
begin
Ctx := TTgClientCtx(aClientCtx);
Guard(enum, GetClientEnumerator);
while enum.MoveNext do
begin
CtxEnt := TTgClientCtx(enum.Current);
if CtxEnt.sRdpRqIp_ = Ctx.ClientInfo_.sIpAddr then
begin
CtxEnt.SendPacket(TTgPacket.Create(RS_REQ_RDP_CLOSE));
end;
end;
if hRcvHwnd_ <> 0 then
SendMessage(hRcvHwnd_, WM_CRMSERVER_NOTIFICATION, NOTI_CLIENT_DISCONN, NativeUInt(aClientCtx));
Inherited;
end;
procedure TRSecuServer.SafeFreeUseSaveStored(const sPath: String);
begin
CSStored_.Acquire;
try
if (wStdPktCnt_ = 0) and (StdPktList_.Count = 1) then
StdPktList_[0].SafeFreeSaveStored(sPath, TASK_LOAD);
finally
CSStored_.Release;
end;
end;
procedure TRSecuServer.ProcessClientConnection(aCtx: TTgClientCtxBase);
begin
end;
procedure TRSecuServer.ProcessRcvPacket(aCtx: TTgClientCtxBase;
aRcv: IRcvPacket);
var
Ctx: TTgClientCtx;
procedure process_TOC_TEST;
begin
if hRcvHwnd_ <> 0 then
begin
TTgPacket(aRcv).Socket := aCtx;
SendMessage(hRcvHwnd_, WM_CRMSERVER_NOTIFICATION, NOTI_RCV_TEST, NativeInt(aRcv));
end;
end;
procedure process_RC_RSECU_INFO;
begin
Ctx.sEmpNo_ := aRcv.S['EmpNo'];
if hRcvHwnd_ <> 0 then
SendMessage(hRcvHwnd_, WM_CRMSERVER_NOTIFICATION, NOTI_CLIENT_CONN, NativeUInt(Ctx));
end;
procedure process_RS_REQ_RDP_DESTLIST;
var
enum: TClientEnumerator;
Send: ISendPacket;
O, OA: ISuperObject;
sEmpNo: String;
CtxEnt: TTgClientCtx;
begin
sEmpNo := aRcv.S['EmpNo'];
Send := TTgPacket.Create(aRcv);
OA := TSuperObject.Create(stArray);
Guard(enum, GetClientEnumerator);
while enum.MoveNext do
begin
CtxEnt := TTgClientCtx(enum.Current);
if CtxEnt = Ctx then
continue;
if not CtxEnt.bRdpOn_ and
(CompareText(CtxEnt.sEmpNo_, sEmpNo) = 0) then
begin
O := SO;
O.S['IP'] := CtxEnt.ClientInfo_.sIpAddr;
O.S['EmpNo'] := sEmpNo;
O.S['Account'] := CtxEnt.ClientInfo_.sAccount;
O.S['ComName'] := CtxEnt.ClientInfo_.sComName;
OA.AsArray.Add(O);
end;
end;
Send.O['List'] := OA;
Ctx.SendPacket(Send);
end;
procedure process_RS_REQ_RDP_CONNECT;
var
enum: TClientEnumerator;
Send: ISendPacket;
sIp: String;
CtxEnt: TTgClientCtx;
begin
sIp := aRcv.S['IP'];
Guard(enum, GetClientEnumerator);
while enum.MoveNext do
begin
CtxEnt := TTgClientCtx(enum.Current);
if CtxEnt.ClientInfo_.sIpAddr = sIp then
begin
if CtxEnt.bRdpOn_ then
begin
Send := TTgPacket.Create(aRcv);
Send.Result := 1;
Send.ResultMsg := '이미 대기중인 연결이 있습니다.';
Ctx.SendPacket(Send);
end else begin
Send := TTgPacket.Create(RS_REQ_RDP_OPEN);
Send.Handle := aRcv.Handle;
Send.WndMessage := aRcv.WndMessage;
Send.S['RqIP'] := Ctx.ClientInfo_.sIpAddr;
Send.S['ComName'] := Ctx.ClientInfo_.sComName;
Send.S['Account'] := Ctx.ClientInfo_.sAccount;
CtxEnt.SendPacket(Send);
end;
exit;
end;
end;
end;
procedure process_RS_REQ_RDP_OPEN;
var
sRqIp: String;
enum: TClientEnumerator;
CtxEnt: TTgClientCtx;
Send: ISendPacket;
begin
Send := TTgPacket.Create(RS_REQ_RDP_CONNECT);
Send.Handle := aRcv.Handle;
Send.WndMessage := aRcv.WndMessage;
Send.I['Port'] := aRcv.I['Port'];
Send.Result := aRcv.Result;
Send.ResultMsg := aRcv.ResultMsg;
sRqIp := aRcv.S['RqIP'];
Guard(enum, GetClientEnumerator);
while enum.MoveNext do
begin
CtxEnt := TTgClientCtx(enum.Current);
if CtxEnt.ClientInfo_.sIpAddr = sRqIp then
begin
if aRcv.Result = 0 then
begin
Ctx.sRdpRqIp_ := sRqIp;
Ctx.bRdpOn_ := true;
Send.Toss := NativeUInt(Ctx);
if hRcvHwnd_ <> 0 then
SendMessage(hRcvHwnd_, WM_CRMSERVER_NOTIFICATION, NOTI_REFRESH_LIST, 0);
end;
CtxEnt.SendPacket(Send);
exit;
end;
end;
end;
procedure process_RS_REQ_RDP_CLOSE;
begin
Ctx.sRdpRqIp_ := '';
Ctx.bRdpOn_ := false;
if hRcvHwnd_ <> 0 then
SendMessage(hRcvHwnd_, WM_CRMSERVER_NOTIFICATION, NOTI_REFRESH_LIST, 0);
end;
var
dwCmd: DWORD;
begin
dwCmd := 0;
if not IsValidClient(aCtx) then
exit;
Ctx := TTgClientCtx(aCtx);
try
dwCmd := aRcv.Command;
case dwCmd of
TOC_TEST : process_TOC_TEST;
RC_RSECU_INFO : process_RC_RSECU_INFO;
RS_REQ_RDP_DESTLIST : process_RS_REQ_RDP_DESTLIST;
RS_REQ_RDP_CONNECT : process_RS_REQ_RDP_CONNECT;
RS_REQ_RDP_OPEN : process_RS_REQ_RDP_OPEN;
RS_REQ_RDP_CLOSE : process_RS_REQ_RDP_CLOSE;
else Inherited;
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. ProcessRcvPacket(), Cmd=%d', [dwCmd]);
end;
end;
end.