209 lines
5.2 KiB
Plaintext
209 lines
5.2 KiB
Plaintext
unit DRmtGwMain;
|
||
|
||
interface
|
||
|
||
uses
|
||
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
||
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, rtcDataSrv, rtcSrvModule, rtcPortalGate,
|
||
rtcSystem, rtcInfo, rtcConn, rtcHttpSrv, Vcl.StdCtrls, Vcl.ExtCtrls,
|
||
Vcl.ComCtrls, Tocsg.Controls;
|
||
|
||
type
|
||
TDlgRmtGwMain = class(TForm)
|
||
HttpServer: TRtcHttpServer;
|
||
Gateway: TRtcPortalGateway;
|
||
RtcGateTestProvider: TRtcDataProvider;
|
||
pnBottom: TPanel;
|
||
pcMain: TPageControl;
|
||
tabSetting: TTabSheet;
|
||
tabActive: TTabSheet;
|
||
Label2: TLabel;
|
||
Label7: TLabel;
|
||
edPort: TEdit;
|
||
edSecureKey: TEdit;
|
||
xSSL: TCheckBox;
|
||
btnStart: TButton;
|
||
btnStop: TButton;
|
||
lxUser: TListBox;
|
||
lbMsg: TLabel;
|
||
procedure HttpServerListenError(Sender: TRtcConnection; E: Exception);
|
||
procedure HttpServerListenLost(Sender: TRtcConnection);
|
||
procedure GatewayUserLogin(const UserName: string);
|
||
procedure GatewayUserLogout(const UserName: string);
|
||
procedure btnStartClick(Sender: TObject);
|
||
procedure btnStopClick(Sender: TObject);
|
||
procedure RtcGateTestProviderCheckRequest(Sender: TRtcConnection);
|
||
procedure RtcGateTestProviderDataReceived(Sender: TRtcConnection);
|
||
private
|
||
{ Private declarations }
|
||
MgCtrl_: TManagerInputControlsData;
|
||
procedure On_Error(const s: String);
|
||
procedure SetControls(bActive: Boolean);
|
||
public
|
||
{ Public declarations }
|
||
Constructor Create(aOwner: TComponent); override;
|
||
Destructor Destroy; override;
|
||
|
||
procedure process_WM_SYSCOMMAND(var msg: TWMSysCommand); Message WM_SYSCOMMAND;
|
||
end;
|
||
|
||
var
|
||
DlgRmtGwMain: TDlgRmtGwMain;
|
||
|
||
implementation
|
||
|
||
uses
|
||
Tocsg.Path;
|
||
|
||
{$R *.dfm}
|
||
|
||
Constructor TDlgRmtGwMain.Create(aOwner: TComponent);
|
||
begin
|
||
Inherited Create(aOwner);
|
||
|
||
MgCtrl_ := TManagerInputControlsData.Create(CutFileExt(GetRunExePath) + '.ini');
|
||
MgCtrl_.RegInputCtrl(edPort);
|
||
MgCtrl_.RegInputCtrl(edSecureKey);
|
||
MgCtrl_.Load;
|
||
|
||
SetControls(false);
|
||
end;
|
||
|
||
Destructor TDlgRmtGwMain.Destroy;
|
||
begin
|
||
FreeAndNil(MgCtrl_);
|
||
Inherited;
|
||
end;
|
||
|
||
procedure TDlgRmtGwMain.SetControls(bActive: Boolean);
|
||
begin
|
||
btnStart.Enabled := not bActive;
|
||
btnStop.Enabled := bActive;
|
||
tabSetting.TabVisible := not bActive;
|
||
tabActive.TabVisible := bActive;
|
||
|
||
if bActive then
|
||
begin
|
||
pcMain.ActivePage := tabActive;
|
||
lbMsg.Caption := Format('Gateway<61><79> Ȱ<><C8B0>ȭ <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>. (Port=%s)', [HttpServer.ServerPort]);
|
||
end else begin
|
||
pcMain.ActivePage := tabSetting;
|
||
lbMsg.Caption := '<27>غ<EFBFBD><D8BA>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.';
|
||
end;
|
||
Application.ProcessMessages;
|
||
end;
|
||
|
||
procedure TDlgRmtGwMain.btnStartClick(Sender: TObject);
|
||
begin
|
||
edPort.Text := Trim(edPort.Text);
|
||
edSecureKey.Text := Trim(edSecureKey.Text);
|
||
if edPort.Text = '' then
|
||
begin
|
||
MessageBox(Handle, PChar('<27><>Ʈ<EFBFBD><C6AE> <20>Է<EFBFBD><D4B7><EFBFBD><EFBFBD>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
|
||
exit;
|
||
end;
|
||
MgCtrl_.Save;
|
||
|
||
lbMsg.Caption := 'Gateway<61><79> Ȱ<><C8B0>ȭ<EFBFBD><C8AD><EFBFBD>Դϴ<D4B4>...';
|
||
lbMsg.Update;
|
||
|
||
HttpServer.StopListenNow;
|
||
HttpServer.ServerPort := edPort.Text;
|
||
|
||
Gateway.AutoRegisterUsers := true;
|
||
Gateway.ModuleFileName := '/$rdgate';
|
||
Gateway.SecureKey := edSecureKey.Text;
|
||
|
||
HttpServer.Listen;
|
||
|
||
SetControls(true);
|
||
end;
|
||
|
||
procedure TDlgRmtGwMain.btnStopClick(Sender: TObject);
|
||
begin
|
||
HttpServer.StopListenNow;
|
||
SetControls(false);
|
||
end;
|
||
|
||
procedure TDlgRmtGwMain.On_Error(const s: String);
|
||
begin
|
||
// if Pages.ActivePage<>Page_Setup then
|
||
// begin
|
||
// Page_Setup.TabVisible:=True;
|
||
// Pages.ActivePage.TabVisible:=False;
|
||
// Pages.ActivePage:=Page_Setup;
|
||
// end;
|
||
|
||
btnStart.Enabled:=True;
|
||
lbMsg.Caption:= s;
|
||
lbMsg.Update;
|
||
|
||
end;
|
||
|
||
procedure TDlgRmtGwMain.GatewayUserLogin(const UserName: string);
|
||
begin
|
||
if lxUser.Items.IndexOf(UserName) = -1 then
|
||
lxUser.Items.Add(UserName);
|
||
end;
|
||
|
||
procedure TDlgRmtGwMain.GatewayUserLogout(const UserName: string);
|
||
var
|
||
i: Integer;
|
||
begin
|
||
i := lxUser.Items.IndexOf(UserName);
|
||
if i <> -1 then
|
||
lxUser.Items.Delete(i);
|
||
end;
|
||
|
||
procedure TDlgRmtGwMain.HttpServerListenError(Sender: TRtcConnection;
|
||
E: Exception);
|
||
begin
|
||
if not Sender.inMainThread then
|
||
Sender.Sync(HttpServerListenError,E)
|
||
else
|
||
On_Error('Error: '+E.Message);
|
||
end;
|
||
|
||
procedure TDlgRmtGwMain.HttpServerListenLost(Sender: TRtcConnection);
|
||
begin
|
||
if not Sender.inMainThread then
|
||
Sender.Sync(HttpServerListenLost)
|
||
else
|
||
On_Error('Gateway Listener Lost');
|
||
end;
|
||
|
||
procedure TDlgRmtGwMain.process_WM_SYSCOMMAND(var msg: TWMSysCommand);
|
||
begin
|
||
if msg.CmdType = SC_CLOSE then
|
||
begin
|
||
if pcMain.ActivePage = tabActive then
|
||
begin
|
||
if MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
|
||
PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
|
||
end;
|
||
end;
|
||
Inherited;
|
||
end;
|
||
|
||
procedure TDlgRmtGwMain.RtcGateTestProviderCheckRequest(Sender: TRtcConnection);
|
||
begin
|
||
with TRtcDataServer(Sender) do
|
||
if Request.FileName='/' then
|
||
Accept;
|
||
end;
|
||
|
||
procedure TDlgRmtGwMain.RtcGateTestProviderDataReceived(Sender: TRtcConnection);
|
||
begin
|
||
with TRtcDataServer(Sender) do
|
||
if Request.Complete then
|
||
begin
|
||
Write('<HTML><head><meta http-equiv="Content-Type" content="text/html;charset=utf-8" /></head><BODY>');
|
||
Write('RemoteGateway<BR><BR>');
|
||
// Write('RemoteGateway<61><79> Ȱ<><C8B0>ȭ <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.<BR><BR>');
|
||
// Write('RemoteHost<73><74> RemoteSupporter<65><72> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>ٸ<EFBFBD><D9B8><EFBFBD> <20>ֽ<EFBFBD><D6BD>ϴ<EFBFBD>.');
|
||
Write('</BODY></HTML>');
|
||
end;
|
||
end;
|
||
|
||
end.
|