400 lines
10 KiB
Plaintext
400 lines
10 KiB
Plaintext
unit DRmtSuptMain;
|
||
|
||
interface
|
||
|
||
uses
|
||
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
||
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.ComCtrls,
|
||
rtcPortalMod, rtcPortalCli, rtcPortalHttpCli, rtcpDesktopControl,
|
||
rtcpDesktopHost, Tocsg.Controls, rtcInfo, Vcl.Buttons;
|
||
|
||
const
|
||
DEF_PASS = '1111';
|
||
|
||
type
|
||
TDlgRmtSuptMain = class(TForm)
|
||
pnBottom: TPanel;
|
||
lbMsg: TLabel;
|
||
pcMain: TPageControl;
|
||
tabSetting: TTabSheet;
|
||
Label4: TLabel;
|
||
GroupBox1: TGroupBox;
|
||
Label1: TLabel;
|
||
Label2: TLabel;
|
||
Label3: TLabel;
|
||
edGtAddr: TEdit;
|
||
edGtPort: TEdit;
|
||
edGtSecureKey: TEdit;
|
||
edDispName: TEdit;
|
||
btnActive: TButton;
|
||
tabSupport: TTabSheet;
|
||
Label5: TLabel;
|
||
sStatus1: TShape;
|
||
sStatus2: TShape;
|
||
btnStop: TButton;
|
||
lxUser: TListBox;
|
||
PDesktopHost: TRtcPDesktopHost;
|
||
PDesktopControl: TRtcPDesktopControl;
|
||
PClient: TRtcHttpPortalClient;
|
||
Panel1: TPanel;
|
||
Label6: TLabel;
|
||
Label9: TLabel;
|
||
xKeyMapping: TCheckBox;
|
||
xSmoothView: TCheckBox;
|
||
xForceCursor: TCheckBox;
|
||
cbControlMode: TComboBox;
|
||
xHideWallpaper: TCheckBox;
|
||
xReduceColors: TCheckBox;
|
||
SpeedButton1: TSpeedButton;
|
||
procedure PClientFatalError(Sender: TAbsPortalClient; const Msg: string);
|
||
procedure PClientError(Sender: TAbsPortalClient; const Msg: string);
|
||
procedure PClientLogIn(Sender: TAbsPortalClient);
|
||
procedure PClientLogOut(Sender: TAbsPortalClient);
|
||
procedure PClientStart(Sender: TAbsPortalClient; const Data: TRtcValue);
|
||
procedure PClientStatusGet(Sender: TAbsPortalClient;
|
||
Status: TRtcPHttpConnStatus);
|
||
procedure PClientStatusPut(Sender: TAbsPortalClient;
|
||
Status: TRtcPHttpConnStatus);
|
||
procedure PClientUserLoggedIn(Sender: TAbsPortalClient; const User: string);
|
||
procedure PClientUserLoggedOut(Sender: TAbsPortalClient;
|
||
const User: string);
|
||
procedure btnActiveClick(Sender: TObject);
|
||
procedure btnStopClick(Sender: TObject);
|
||
procedure PDesktopControlNewUI(Sender: TRtcPDesktopControl;
|
||
const user: string);
|
||
procedure SpeedButton1Click(Sender: TObject);
|
||
private
|
||
{ Private declarations }
|
||
MgCtrl_: TManagerInputControlsData;
|
||
nReqCnt1_,
|
||
nReqCnt2_: Integer;
|
||
procedure SetControls(bActive: Boolean);
|
||
public
|
||
{ Public declarations }
|
||
Constructor Create(aOwner: TComponent); override;
|
||
Destructor Destroy; override;
|
||
end;
|
||
|
||
var
|
||
DlgRmtSuptMain: TDlgRmtSuptMain;
|
||
|
||
implementation
|
||
|
||
uses
|
||
Tocsg.Path, Tocsg.WinInfo, rdDesktopView, rtcpDesktopControlUI,
|
||
rtcpDesktopConst;
|
||
|
||
{$R *.dfm}
|
||
|
||
Constructor TDlgRmtSuptMain.Create(aOwner: TComponent);
|
||
begin
|
||
Inherited Create(aOwner);
|
||
|
||
MgCtrl_ := TManagerInputControlsData.Create(CutFileExt(GetRunExePath) + '.ini');
|
||
MgCtrl_.RegInputCtrl(edGtAddr);
|
||
MgCtrl_.RegInputCtrl(edGtPort);
|
||
MgCtrl_.RegInputCtrl(edGtSecureKey);
|
||
MgCtrl_.RegInputCtrl(edDispName);
|
||
MgCtrl_.Load;
|
||
|
||
nReqCnt1_ := 0;
|
||
nReqCnt2_ := 0;
|
||
|
||
SetControls(false);
|
||
|
||
if edDispName.Text = '' then
|
||
edDispName.Text := GetComName;
|
||
end;
|
||
|
||
Destructor TDlgRmtSuptMain.Destroy;
|
||
begin
|
||
FreeAndNil(MgCtrl_);
|
||
Inherited;
|
||
end;
|
||
|
||
procedure TDlgRmtSuptMain.btnActiveClick(Sender: TObject);
|
||
begin
|
||
edGtAddr.Text := Trim(edGtAddr.Text);
|
||
edGtPort.Text := Trim(edGtPort.Text);
|
||
edGtSecureKey.Text := Trim(edGtSecureKey.Text);
|
||
edDispName.Text := Trim(edDispName.Text);
|
||
|
||
if edGtAddr.Text = '' then
|
||
begin
|
||
MessageBox(Handle, PChar('Gateway <20>ּҸ<D6BC> <20>Է<EFBFBD><D4B7><EFBFBD><EFBFBD>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
|
||
edGtAddr.SetFocus;
|
||
exit;
|
||
end;
|
||
|
||
if edGtPort.Text = '' then
|
||
begin
|
||
MessageBox(Handle, PChar('Gateway <20><>Ʈ<EFBFBD><C6AE> <20>Է<EFBFBD><D4B7><EFBFBD><EFBFBD>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
|
||
edGtPort.SetFocus;
|
||
exit;
|
||
end;
|
||
|
||
if edDispName.Text = '' then
|
||
begin
|
||
MessageBox(Handle, PChar('ǥ<><C7A5> <20≯<EFBFBD><CCB8><EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD><EFBFBD>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
|
||
edDispName.SetFocus;
|
||
exit;
|
||
end;
|
||
MgCtrl_.Save;
|
||
|
||
nReqCnt1_ := 0;
|
||
nReqCnt2_ := 0;
|
||
|
||
PClient.Active := false;
|
||
PClient.GateAddr := edGtAddr.Text;
|
||
PClient.GatePort := edGtPort.Text;
|
||
PClient.DataSecureKey := edGtSecureKey.Text;
|
||
PClient.LoginUserName := edDispName.Text;
|
||
PClient.LoginPassword := DEF_PASS;
|
||
|
||
PClient.RetryOtherCalls := 3;
|
||
PClient.Active := true;
|
||
end;
|
||
|
||
procedure TDlgRmtSuptMain.btnStopClick(Sender: TObject);
|
||
begin
|
||
PClient.Active := false;
|
||
PClient.Stop;
|
||
SetControls(false);
|
||
end;
|
||
|
||
procedure TDlgRmtSuptMain.PClientError(Sender: TAbsPortalClient;
|
||
const Msg: string);
|
||
begin
|
||
PClientFatalError(Sender, Msg);
|
||
|
||
// The difference between "OnError" and "OnFatalError" is
|
||
// that "OnError" will make a reconnect if "Re-Login" was checked,
|
||
// while "OnFatalError" simply closes all connections and stops.
|
||
// if xAutoConnect.Checked then
|
||
// PClient.Active:=True;
|
||
end;
|
||
|
||
procedure TDlgRmtSuptMain.PClientFatalError(Sender: TAbsPortalClient;
|
||
const Msg: string);
|
||
begin
|
||
PClient.Disconnect;
|
||
|
||
SetControls(false);
|
||
lbMsg.Caption := Msg;
|
||
Application.ProcessMessages;
|
||
|
||
MessageBeep(0);
|
||
end;
|
||
|
||
procedure TDlgRmtSuptMain.PClientLogIn(Sender: TAbsPortalClient);
|
||
begin
|
||
lxUser.Clear;
|
||
// eConnected.Clear;
|
||
// btnLogout.Enabled:=True;
|
||
|
||
// lblStatus.Caption:='Logged in as "'+PClient.LoginUsername+'".';
|
||
// lblStatus.Update;
|
||
end;
|
||
|
||
procedure TDlgRmtSuptMain.PClientLogOut(Sender: TAbsPortalClient);
|
||
begin
|
||
SetControls(false);
|
||
end;
|
||
|
||
procedure TDlgRmtSuptMain.PClientStart(Sender: TAbsPortalClient;
|
||
const Data: TRtcValue);
|
||
begin
|
||
SetControls(true);
|
||
lxUser.Clear;
|
||
end;
|
||
|
||
procedure TDlgRmtSuptMain.PClientStatusGet(Sender: TAbsPortalClient;
|
||
Status: TRtcPHttpConnStatus);
|
||
begin
|
||
case status of
|
||
rtccClosed:
|
||
begin
|
||
sStatus2.Brush.Color:=clRed;
|
||
sStatus2.Pen.Color:=clMaroon;
|
||
end;
|
||
rtccOpen:
|
||
sStatus2.Brush.Color:=clNavy;
|
||
rtccSending:
|
||
begin
|
||
sStatus2.Brush.Color:=clGreen;
|
||
case nReqCnt2_ of
|
||
0:sStatus2.Pen.Color:=clBlack;
|
||
1:sStatus2.Pen.Color:=clGray;
|
||
2:sStatus2.Pen.Color:=clSilver;
|
||
3:sStatus2.Pen.Color:=clWhite;
|
||
4:sStatus2.Pen.Color:=clSilver;
|
||
5:sStatus2.Pen.Color:=clGray;
|
||
end;
|
||
Inc(nReqCnt2_);
|
||
if nReqCnt2_>5 then nReqCnt2_:=0;
|
||
end;
|
||
rtccReceiving:
|
||
sStatus2.Brush.Color:=clLime;
|
||
else
|
||
begin
|
||
sStatus2.Brush.Color:=clFuchsia;
|
||
sStatus2.Pen.Color:=clRed;
|
||
end;
|
||
end;
|
||
sStatus2.Update;
|
||
end;
|
||
|
||
procedure TDlgRmtSuptMain.PClientStatusPut(Sender: TAbsPortalClient;
|
||
Status: TRtcPHttpConnStatus);
|
||
begin
|
||
case status of
|
||
rtccClosed:
|
||
sStatus1.Brush.Color:=clGray;
|
||
rtccOpen:
|
||
sStatus1.Brush.Color:=clNavy;
|
||
rtccSending:
|
||
begin
|
||
sStatus1.Brush.Color:=clGreen;
|
||
case nReqCnt1_ of
|
||
0:sStatus1.Pen.Color:=clBlack;
|
||
1:sStatus1.Pen.Color:=clGray;
|
||
2:sStatus1.Pen.Color:=clSilver;
|
||
3:sStatus1.Pen.Color:=clWhite;
|
||
4:sStatus1.Pen.Color:=clSilver;
|
||
5:sStatus1.Pen.Color:=clGray;
|
||
end;
|
||
Inc(nReqCnt1_);
|
||
if nReqCnt1_>5 then nReqCnt1_:=0;
|
||
end;
|
||
rtccReceiving:
|
||
sStatus1.Brush.Color:=clLime;
|
||
else
|
||
begin
|
||
sStatus1.Brush.Color:=clFuchsia;
|
||
sStatus1.Pen.Color:=clRed;
|
||
end;
|
||
end;
|
||
sStatus1.Update;
|
||
end;
|
||
|
||
procedure TDlgRmtSuptMain.PClientUserLoggedIn(Sender: TAbsPortalClient;
|
||
const User: string);
|
||
begin
|
||
if lxUser.Items.IndexOf(User) = -1 then
|
||
lxUser.items.Add(User);
|
||
end;
|
||
|
||
procedure TDlgRmtSuptMain.PClientUserLoggedOut(Sender: TAbsPortalClient;
|
||
const User: string);
|
||
var
|
||
i: Integer;
|
||
begin
|
||
i := lxUser.Items.IndexOf(User);
|
||
if i <> -1 then
|
||
lxUser.items.Delete(i);
|
||
end;
|
||
|
||
procedure TDlgRmtSuptMain.PDesktopControlNewUI(Sender: TRtcPDesktopControl;
|
||
const user: string);
|
||
var
|
||
CDesk:TrdDesktopViewer;
|
||
begin
|
||
CDesk:=TrdDesktopViewer.Create(nil);
|
||
if assigned(CDesk) then
|
||
begin
|
||
{$IFNDEF RtcViewer}
|
||
// CDesk.PFileTrans:=PFileTrans;
|
||
{$ENDIF}
|
||
|
||
CDesk.UI.MapKeys:=xKeyMapping.Checked;
|
||
CDesk.UI.SmoothScale:=xSmoothView.Checked;
|
||
CDesk.UI.ExactCursor:=xForceCursor.Checked;
|
||
|
||
{$IFNDEF RtcViewer}
|
||
case cbControlMode.ItemIndex of
|
||
0: CDesk.UI.ControlMode:=rtcpNoControl;
|
||
1: CDesk.UI.ControlMode:=rtcpAutoControl;
|
||
2: CDesk.UI.ControlMode:=rtcpManualControl;
|
||
3: CDesk.UI.ControlMode:=rtcpFullControl;
|
||
end;
|
||
{$ENDIF}
|
||
|
||
CDesk.UI.UserName:=user;
|
||
// Always set UI.Module *after* setting UI.UserName !!!
|
||
CDesk.UI.Module:=Sender;
|
||
|
||
CDesk.Show;
|
||
end
|
||
else
|
||
raise Exception.Create('Error creating Window');
|
||
|
||
if CDesk.WindowState=wsNormal then
|
||
begin
|
||
CDesk.BringToFront;
|
||
BringWindowToTop(CDesk.Handle);
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgRmtSuptMain.SetControls(bActive: Boolean);
|
||
begin
|
||
btnActive.Enabled := not bActive;
|
||
tabSetting.TabVisible := not Active;
|
||
btnStop.Enabled := bActive;
|
||
tabSupport.TabVisible := bActive;
|
||
|
||
if bActive then
|
||
begin
|
||
pcMain.ActivePage := tabSupport;
|
||
lbMsg.Caption := 'Gateway<61><79> <20><><EFBFBD><EFBFBD><EFBFBD>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.';
|
||
end else begin
|
||
pcMain.ActivePage := tabSetting;
|
||
lbMsg.Caption := '<27>غ<EFBFBD><D8BA>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.';
|
||
end;
|
||
Application.ProcessMessages;
|
||
end;
|
||
|
||
procedure TDlgRmtSuptMain.SpeedButton1Click(Sender: TObject);
|
||
var
|
||
nSelIdx: Integer;
|
||
sUser: string;
|
||
i: Integer;
|
||
begin
|
||
sUser := '';
|
||
for i := 0 to lxUser.items.Count - 1 do
|
||
if lxUser.Selected[i] then
|
||
begin
|
||
sUser := lxUser.Items[i];
|
||
break;
|
||
end;
|
||
|
||
if sUser = '' then
|
||
begin
|
||
MessageBeep(0);
|
||
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> PC<50><43> <20><><EFBFBD><EFBFBD> <20><> <20>ٽ<EFBFBD> <20>õ<EFBFBD><C3B5><EFBFBD> <20>ֽʽÿ<CABD>.'),
|
||
PChar(Caption), MB_ICONWARNING or MB_OK);
|
||
exit;
|
||
end;
|
||
|
||
// If the Host was using a colorful Wallpaper, without hiding the wallpaper,
|
||
// receiving the initial Desktop Screen could take quite a while.
|
||
// To hide the Dektop wallpaper on the Host, you can use the "Send_HideDesktop" method.
|
||
if xHideWallpaper.Checked then
|
||
PDesktopControl.Send_HideDesktop(sUser);
|
||
|
||
// If you would like to change Hosts Desktop Viewer settings
|
||
// before the initial screen is being prepared for sending by the Host,
|
||
// this is where you could call "PDesktopControl.ChgDesktop_" methods ...
|
||
// The example below would set the Host to use 9bit colors and 25FPS frame rate ...
|
||
if xReduceColors.Checked then
|
||
begin
|
||
PDesktopControl.ChgDesktop_Begin;
|
||
PDesktopControl.ChgDesktop_ColorLimit(rdColor8bit);
|
||
// PDesktopControl.ChgDesktop_FrameRate(rdFrames25);
|
||
PDesktopControl.ChgDesktop_End(sUser);
|
||
end;
|
||
|
||
PDesktopControl.Open(sUser);
|
||
end;
|
||
|
||
end.
|