296 lines
7.8 KiB
Plaintext
296 lines
7.8 KiB
Plaintext
unit DRSecuServerMain;
|
||
|
||
interface
|
||
|
||
uses
|
||
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
||
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, RSecuServer,
|
||
Vcl.Menus, VirtualTrees, Tocsg.ServerBase, System.Generics.Collections,
|
||
System.ImageList, Vcl.ImgList, PngImageList;
|
||
|
||
const
|
||
DEF_PORT = 30091;
|
||
|
||
type
|
||
PClientEnt = ^TClientEnt;
|
||
TClientEnt = record
|
||
Info: TClientInfo;
|
||
sEmpNo: String;
|
||
Ctx: TTgClientCtx;
|
||
end;
|
||
|
||
TDlgCoeServerMain = class(TForm)
|
||
pnBottom: TPanel;
|
||
lbSvrTime: TLabel;
|
||
lbSvrPort: TLabel;
|
||
tStatus: TTimer;
|
||
mmLog: TMemo;
|
||
MainMenu: TMainMenu;
|
||
N1: TMenuItem;
|
||
miActive: TMenuItem;
|
||
miDeactive: TMenuItem;
|
||
N4: TMenuItem;
|
||
miExit: TMenuItem;
|
||
vtList: TVirtualStringTree;
|
||
Splitter1: TSplitter;
|
||
imgList: TPngImageList;
|
||
procedure tStatusTimer(Sender: TObject);
|
||
procedure miExitClick(Sender: TObject);
|
||
procedure miActiveClick(Sender: TObject);
|
||
procedure miDeactiveClick(Sender: TObject);
|
||
procedure vtListGetNodeDataSize(Sender: TBaseVirtualTree;
|
||
var NodeDataSize: Integer);
|
||
procedure vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
||
procedure vtListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
|
||
procedure vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||
Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
|
||
var HintText: string);
|
||
procedure vtListGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||
Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean;
|
||
var ImageIndex: TImageIndex);
|
||
private
|
||
{ Private declarations }
|
||
Server_: TRSecuServer;
|
||
DcClient_: TDictionary<Pointer,PVirtualNode>;
|
||
procedure Log(sLog: String); overload;
|
||
procedure Log(sFormat: String; const Args: array of const); overload;
|
||
public
|
||
{ Public declarations }
|
||
Constructor Create(aOwner: TComponent); override;
|
||
Destructor Destroy; override;
|
||
|
||
procedure process_WM_SYSCOMMAND(var msg: TWMSysCommand); Message WM_SYSCOMMAND;
|
||
procedure process_WM_CRMSERVER_NOTIFICATION(var msg: TMessage); Message WM_CRMSERVER_NOTIFICATION;
|
||
end;
|
||
|
||
var
|
||
DlgCoeServerMain: TDlgCoeServerMain;
|
||
|
||
implementation
|
||
|
||
uses
|
||
Tocsg.DateTime, Tocsg.Packet, Tocsg.Encrypt, Define,
|
||
Tocsg.VirtualTreeViewUtil;
|
||
|
||
{$R *.dfm}
|
||
|
||
Constructor TDlgCoeServerMain.Create(aOwner: TComponent);
|
||
begin
|
||
Inherited Create(aOwner);
|
||
DcClient_ := TDictionary<Pointer,PVirtualNode>.Create;
|
||
Server_ := TRSecuServer.Create(Handle, DEF_PORT);
|
||
Server_.SetPacketEncInfo(ekAes256cbc, '123sd');
|
||
Caption := APP_TITLE;
|
||
Log(APP_TITLE + '<27><> <20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.');
|
||
end;
|
||
|
||
Destructor TDlgCoeServerMain.Destroy;
|
||
begin
|
||
tStatus.Enabled := false;
|
||
Inherited;
|
||
FreeAndNil(Server_);
|
||
FreeAndNil(DcClient_);
|
||
end;
|
||
|
||
procedure TDlgCoeServerMain.Log(sLog: String);
|
||
begin
|
||
mmLog.Lines.Add(Format('[%s] %s', [DateTimeToStr(Now), sLog]));
|
||
end;
|
||
|
||
procedure TDlgCoeServerMain.Log(sFormat: String; const Args: array of const);
|
||
var
|
||
str: String;
|
||
begin
|
||
FmtStr(str, sFormat, Args);
|
||
Log(str);
|
||
end;
|
||
|
||
procedure TDlgCoeServerMain.miActiveClick(Sender: TObject);
|
||
begin
|
||
if not Server_.Active then
|
||
Server_.Active := true;
|
||
end;
|
||
|
||
procedure TDlgCoeServerMain.miDeactiveClick(Sender: TObject);
|
||
begin
|
||
if not Server_.Active then
|
||
exit;
|
||
|
||
if MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> <20>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
|
||
APP_TITLE, MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
|
||
|
||
vtList.BeginUpdate;
|
||
try
|
||
DcClient_.Clear;
|
||
VT_Clear(vtList);
|
||
finally
|
||
vtList.EndUpdate;
|
||
end;
|
||
|
||
Server_.Active := false;
|
||
end;
|
||
|
||
procedure TDlgCoeServerMain.miExitClick(Sender: TObject);
|
||
begin
|
||
if MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
|
||
APP_TITLE, MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
|
||
|
||
Close;
|
||
end;
|
||
|
||
procedure TDlgCoeServerMain.tStatusTimer(Sender: TObject);
|
||
begin
|
||
if Server_.Active then
|
||
begin
|
||
lbSvrTime.Caption := ConvSecBetweenToProgTime(Server_.ActiveDateTime, Now);
|
||
end;
|
||
Application.ProcessMessages;
|
||
end;
|
||
|
||
procedure TDlgCoeServerMain.vtListFreeNode(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode);
|
||
var
|
||
pData: PClientEnt;
|
||
begin
|
||
pData := Sender.GetNodeData(Node);
|
||
Finalize(pData^);
|
||
end;
|
||
|
||
procedure TDlgCoeServerMain.vtListGetHint(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Column: TColumnIndex;
|
||
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
|
||
begin
|
||
HintText := vtList.Text[Node, Column];
|
||
end;
|
||
|
||
procedure TDlgCoeServerMain.vtListGetImageIndex(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
|
||
var Ghosted: Boolean; var ImageIndex: TImageIndex);
|
||
var
|
||
pData: PClientEnt;
|
||
begin
|
||
if Column = 1 then
|
||
case Kind of
|
||
ikNormal,
|
||
ikSelected:
|
||
begin
|
||
pData := Sender.GetNodeData(Node);
|
||
if pData.Ctx.RdpOn then
|
||
ImageIndex := 1
|
||
else
|
||
ImageIndex := 0;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgCoeServerMain.vtListGetNodeDataSize(Sender: TBaseVirtualTree;
|
||
var NodeDataSize: Integer);
|
||
begin
|
||
NodeDataSize := SizeOf(TClientEnt);
|
||
end;
|
||
|
||
procedure TDlgCoeServerMain.vtListGetText(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||
var CellText: string);
|
||
var
|
||
pData: PClientEnt;
|
||
begin
|
||
pData := Sender.GetNodeData(Node);
|
||
|
||
case Column of
|
||
0 : CellText := IntToStr(Node.Index + 1);
|
||
1 : CellText := pData.Info.sIpAddr;
|
||
2 : CellText := pData.sEmpNo;
|
||
3 : CellText := pData.Info.sAccount;
|
||
4 : CellText := pData.Info.sComName;
|
||
5 : CellText := pData.Info.sMacAddr;
|
||
6 : CellText := DateTimeToStr(pData.Info.BootDT);
|
||
7 : CellText := DateTimeToStr(pData.Info.ConnDT);
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgCoeServerMain.process_WM_SYSCOMMAND(var msg: TWMSysCommand);
|
||
begin
|
||
if msg.CmdType = SC_CLOSE then
|
||
begin
|
||
miExit.Click;
|
||
exit;
|
||
end;
|
||
Inherited;
|
||
end;
|
||
|
||
procedure TDlgCoeServerMain.process_WM_CRMSERVER_NOTIFICATION(var msg: TMessage);
|
||
var
|
||
pNode: PVirtualNode;
|
||
pData: PClientEnt;
|
||
Ctx: TTgClientCtx;
|
||
begin
|
||
case msg.WParam of
|
||
NOTI_RCV_TEST :
|
||
begin
|
||
var Rcv: IRcvPacket := IRcvPacket(msg.LParam);
|
||
Ctx := TTgClientCtx(Rcv.Socket);
|
||
mmLog.Lines.Add(Format('%s(%s) : %s', [Ctx.ClientInfo.sIpAddr, Ctx.ClientInfo.sComName, Rcv.S['Msg']]));
|
||
|
||
var Send: ISendPacket := TTgPacket.Create(Rcv);
|
||
Ctx.SendPacket(Send);
|
||
end;
|
||
NOTI_SERVER_ON :
|
||
begin
|
||
tStatus.Enabled := true;
|
||
miActive.Enabled := false;
|
||
miActive.Checked := true;
|
||
miDeactive.Enabled := true;
|
||
lbSvrPort.Caption := IntToStr(Server_.Port);
|
||
Log('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> Ȱ<><C8B0>ȭ <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.');
|
||
end;
|
||
NOTI_SERVER_OFF :
|
||
begin
|
||
tStatus.Enabled := false;
|
||
miActive.Enabled := true;
|
||
miActive.Checked := false;
|
||
miDeactive.Enabled := false;
|
||
lbSvrTime.Caption := '<27>غ<EFBFBD><D8BA><EFBFBD>';
|
||
lbSvrPort.Caption := '<27><>Ʈ';
|
||
Log('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> Ȱ<><C8B0>ȭ <20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.');
|
||
end;
|
||
NOTI_CLIENT_CONN :
|
||
begin
|
||
Ctx := TTgClientCtx(msg.LParam);
|
||
vtList.BeginUpdate;
|
||
try
|
||
pData := VT_AddChildDataN(vtList, pNode);
|
||
pData.Info := Ctx.ClientInfo;
|
||
pData.sEmpNo := Ctx.EmpNo;
|
||
pData.Ctx := Ctx;
|
||
DcClient_.Add(Ctx, pNode);
|
||
Log('%s(%s)<29><> <20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.' , [pData.sEmpNo, pData.Info.sIpAddr]);
|
||
finally
|
||
vtList.EndUpdate;
|
||
end;
|
||
end;
|
||
NOTI_CLIENT_DISCONN :
|
||
begin
|
||
Ctx := TTgClientCtx(msg.LParam);
|
||
vtList.BeginUpdate;
|
||
try
|
||
if DcClient_.ContainsKey(Ctx) then
|
||
begin
|
||
pNode := DcClient_[Ctx];
|
||
pData := vtList.GetNodeData(pNode);
|
||
Log('%s(%s)<29><> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.' , [pData.sEmpNo, pData.Info.sIpAddr]);
|
||
vtList.DeleteNode(pNode);
|
||
DcClient_.Remove(Ctx);
|
||
end;
|
||
finally
|
||
vtList.EndUpdate;
|
||
end;
|
||
end;
|
||
NOTI_REFRESH_LIST : vtList.Repaint;
|
||
end;
|
||
Application.ProcessMessages;
|
||
end;
|
||
|
||
end.
|