524 lines
14 KiB
Plaintext
524 lines
14 KiB
Plaintext
unit DRmtHostMain;
|
||
|
||
interface
|
||
|
||
uses
|
||
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
||
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
|
||
Tocsg.Controls, rdSetHost, Vcl.ComCtrls, Vcl.ExtCtrls,
|
||
|
||
// rtcpFileTrans, rtcpChat,
|
||
rtcPortalMod, rtcpDesktopControl, rtcpDesktopHost, rtcInfo,
|
||
rtcPortalCli, rtcPortalHttpCli, rtcScrUtils;
|
||
|
||
const
|
||
DEF_PASS = '0000';
|
||
|
||
// WM_TASKBAREVENT = WM_USER + 1;
|
||
// WM_AUTORUN = WM_USER + 2;
|
||
// WM_AUTOMINIMIZE = WM_USER + 3;
|
||
// WM_AUTOCLOSE = WM_USER + 4;
|
||
|
||
type
|
||
TDlgRmtHostMain = class(TForm)
|
||
PClient: TRtcHttpPortalClient;
|
||
PDesktopHost: TRtcPDesktopHost;
|
||
PDesktopControl: TRtcPDesktopControl;
|
||
pnBottom: TPanel;
|
||
pcMain: TPageControl;
|
||
tabSetting: TTabSheet;
|
||
tabHosting: TTabSheet;
|
||
GroupBox1: TGroupBox;
|
||
Label1: TLabel;
|
||
Label2: TLabel;
|
||
Label3: TLabel;
|
||
edGtAddr: TEdit;
|
||
edGtPort: TEdit;
|
||
edGtSecureKey: TEdit;
|
||
Label4: TLabel;
|
||
edDispName: TEdit;
|
||
btnActive: TButton;
|
||
btnStop: TButton;
|
||
lxSuppoter: TListBox;
|
||
Label5: TLabel;
|
||
lbMsg: TLabel;
|
||
sStatus1: TShape;
|
||
sStatus2: TShape;
|
||
procedure btnActiveClick(Sender: TObject);
|
||
procedure PClientError(Sender: TAbsPortalClient; const Msg: string);
|
||
procedure PClientLogIn(Sender: TAbsPortalClient);
|
||
procedure PClientLogOut(Sender: TAbsPortalClient);
|
||
procedure PClientParams(Sender: TAbsPortalClient; const Data: TRtcValue);
|
||
procedure PClientStart(Sender: TAbsPortalClient; const Data: TRtcValue);
|
||
procedure PClientStatusGet(Sender: TAbsPortalClient;
|
||
Status: TRtcPHttpConnStatus);
|
||
procedure PClientStatusPut(Sender: TAbsPortalClient;
|
||
Status: TRtcPHttpConnStatus);
|
||
procedure PDesktopHostUserJoined(Sender: TRtcPModule; const User: string);
|
||
procedure PDesktopHostUserLeft(Sender: TRtcPModule; const User: string);
|
||
procedure PDesktopControlNewUI(Sender: TRtcPDesktopControl;
|
||
const user: string);
|
||
procedure PClientFatalError(Sender: TAbsPortalClient; const Msg: string);
|
||
procedure btnStopClick(Sender: TObject);
|
||
private
|
||
{ Private declarations }
|
||
MgCtrl_: TManagerInputControlsData;
|
||
Options_: TrdHostSettings;
|
||
bSilentMode_: Boolean;
|
||
nReqCnt1_,
|
||
nReqCnt2_,
|
||
nDesktopCnt_: Integer;
|
||
procedure SetControls(bActive: Boolean);
|
||
public
|
||
{ Public declarations }
|
||
Constructor Create(aOwner: TComponent); override;
|
||
Destructor Destroy; override;
|
||
end;
|
||
|
||
var
|
||
DlgRmtHostMain: TDlgRmtHostMain;
|
||
|
||
implementation
|
||
|
||
uses
|
||
Tocsg.Path, Tocsg.WinInfo, rdDesktopView, rtcpDesktopControlUI;
|
||
|
||
{$R *.dfm}
|
||
|
||
Constructor TDlgRmtHostMain.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;
|
||
|
||
Options_ := nil;
|
||
bSilentMode_ := false;
|
||
nDesktopCnt_ := 0;
|
||
nReqCnt1_ := 0;
|
||
nReqCnt2_ := 0;
|
||
|
||
SetControls(false);
|
||
|
||
if edDispName.Text = '' then
|
||
edDispName.Text := GetComName;
|
||
end;
|
||
|
||
Destructor TDlgRmtHostMain.Destroy;
|
||
begin
|
||
FreeAndNil(MgCtrl_);
|
||
Inherited;
|
||
end;
|
||
|
||
procedure TDlgRmtHostMain.btnStopClick(Sender: TObject);
|
||
begin
|
||
if assigned(Options_) and Options_.Visible then
|
||
Options_.Close;
|
||
|
||
// xAutoConnect.Checked:=False;
|
||
// btnLogout.Enabled:=False;
|
||
|
||
// if PClient.Active then
|
||
// PClient.Active:=False
|
||
// else
|
||
// begin
|
||
// btnLogin.Enabled:=True;
|
||
// if Pages.ActivePage<>Page_Setup then
|
||
// begin
|
||
// Page_Setup.TabVisible:=True;
|
||
// Pages.ActivePage.TabVisible:=False;
|
||
// Pages.ActivePage:=Page_Setup;
|
||
// end;
|
||
// end;
|
||
|
||
PClient.Active := false;
|
||
PClient.Stop;
|
||
SetControls(false);
|
||
end;
|
||
|
||
procedure TDlgRmtHostMain.SetControls(bActive: Boolean);
|
||
begin
|
||
btnActive.Enabled := not bActive;
|
||
tabSetting.TabVisible := not Active;
|
||
btnStop.Enabled := bActive;
|
||
tabHosting.TabVisible := bActive;
|
||
|
||
if bActive then
|
||
begin
|
||
pcMain.ActivePage := tabHosting;
|
||
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 TDlgRmtHostMain.PClientLogIn(Sender: TAbsPortalClient);
|
||
begin
|
||
if assigned(Options_) and Options_.Visible then
|
||
Options_.Close;
|
||
|
||
nDesktopCnt_ := 0;
|
||
lxSuppoter.Clear;
|
||
|
||
// DragAcceptFiles(Handle, False);
|
||
// pSendFiles.Visible:=False;
|
||
|
||
// if FAutoRun then
|
||
// PostMessage(Handle,WM_AUTOMINIMIZE,0,0);
|
||
end;
|
||
|
||
procedure TDlgRmtHostMain.PClientLogOut(Sender: TAbsPortalClient);
|
||
begin
|
||
if assigned(Options_) and Options_.Visible then
|
||
Options_.Close;
|
||
|
||
SetControls(false);
|
||
|
||
// if bSilentMode_ then
|
||
// PostMessage(Handle, WM_AUTOCLOSE, 0, 0);
|
||
end;
|
||
|
||
procedure TDlgRmtHostMain.PClientParams(Sender: TAbsPortalClient;
|
||
const Data: TRtcValue);
|
||
begin
|
||
// if xAdvanced.Checked then
|
||
// begin
|
||
// xAdvanced.Checked:=False;
|
||
// if not assigned(Options) then
|
||
// Options:=TrdHostSettings.Create(self);
|
||
// if assigned(Options) then
|
||
// begin
|
||
// Options.PClient:=PClient;
|
||
// Options.PDesktop:=PDesktopHost;
|
||
// Options.PChat:=PChat;
|
||
// Options.PFileTrans:=PFileTrans;
|
||
// Options.Execute;
|
||
// btnLogin.Enabled:=True;
|
||
// end;
|
||
// end
|
||
// else
|
||
begin
|
||
if not PDesktopHost.GFullScreen and
|
||
(PDesktopHost.ScreenRect.Right = PDesktopHost.ScreenRect.Left) then
|
||
PDesktopHost.GFullScreen := true;
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgRmtHostMain.PClientStart(Sender: TAbsPortalClient;
|
||
const Data: TRtcValue);
|
||
begin
|
||
SetControls(true);
|
||
end;
|
||
|
||
procedure TDlgRmtHostMain.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 TDlgRmtHostMain.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 TDlgRmtHostMain.PDesktopControlNewUI(Sender: TRtcPDesktopControl;
|
||
const user: string);
|
||
var
|
||
CDesk: TrdDesktopViewer;
|
||
begin
|
||
CDesk:=TrdDesktopViewer.Create(nil);
|
||
if assigned(CDesk) then
|
||
begin
|
||
// CDesk.PFileTrans:=PFileTrans;
|
||
|
||
// MapKeys and ControlMode should stay as they are now,
|
||
// because this is the Host side and Hosts do not have Control.
|
||
CDesk.UI.ControlMode:=rtcpNoControl;
|
||
CDesk.UI.MapKeys:=False;
|
||
|
||
// You can set SmoothScale and ExactCursor to your prefered values,
|
||
// or add options to the Form so the user can choose these values,
|
||
// but the default values (False, False) will give you the best performance.
|
||
CDesk.UI.SmoothScale:=False;
|
||
CDesk.UI.ExactCursor:=False;
|
||
|
||
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 TDlgRmtHostMain.PDesktopHostUserJoined(Sender: TRtcPModule;
|
||
const User: string);
|
||
var
|
||
s:string;
|
||
el:TListItem;
|
||
uinfo:TRtcRecord;
|
||
begin
|
||
// if Sender is TRtcPFileTransfer then
|
||
// s:='Files'
|
||
// else if Sender is TRtcPChat then
|
||
// s:='Chat'
|
||
// else
|
||
if Sender is TRtcPDesktopHost then
|
||
begin
|
||
s:='Desktop';
|
||
Inc(nDesktopCnt_);
|
||
if nDesktopCnt_ = 1 then
|
||
begin
|
||
// pSendFiles.Visible:=True;
|
||
// DragAcceptFiles(Handle, True);
|
||
end;
|
||
end
|
||
else s:='???';
|
||
|
||
{ You can retrieve custom user information about
|
||
all users currently connected to this Client
|
||
by using the RemoteUserInfo property like this: }
|
||
|
||
uinfo:=Sender.RemoteUserInfo[user];
|
||
|
||
{ What you get is a TRtcRecord containing all the
|
||
information stored by the Client using the
|
||
"LoginUserInfo" property before he logged in to the Gateway.
|
||
Private user information (like the password or configuration data)
|
||
will NOT be sent to other users. You will get here ONLY
|
||
data that what was assigned to the "LoginUserInfo" property. }
|
||
|
||
try
|
||
if uinfo.CheckType('RealName',rtc_Text) then
|
||
s:=user+' ('+uinfo.asText['RealName']+') - '+s
|
||
else
|
||
s:=user+' - '+s;
|
||
finally
|
||
{ When you are finished using the data, make sure
|
||
to FREE the object received from "RemoteUserInfo" }
|
||
uinfo.Free; // Do NOT forget this, or you will create a memory leak!
|
||
end;
|
||
|
||
// el:=eConnected.Items.Add;
|
||
// el.Caption:=s;
|
||
// eConnected.Update;
|
||
lxSuppoter.Items.Add(s);
|
||
end;
|
||
|
||
procedure TDlgRmtHostMain.PDesktopHostUserLeft(Sender: TRtcPModule;
|
||
const User: string);
|
||
var
|
||
s:string;
|
||
a,i:integer;
|
||
uinfo:TRtcRecord;
|
||
begin
|
||
// if Sender is TRtcPFileTransfer then
|
||
// s:='Files'
|
||
// else if Sender is TRtcPChat then
|
||
// s:='Chat'
|
||
// else
|
||
if Sender is TRtcPDesktopHost then
|
||
begin
|
||
s:='Desktop';
|
||
Dec(nDesktopCnt_);
|
||
if nDesktopCnt_=0 then
|
||
begin
|
||
// DragAcceptFiles(Handle,False);
|
||
// pSendFiles.Visible:=False;
|
||
Show_Wallpaper;
|
||
end;
|
||
end
|
||
else s:='???';
|
||
|
||
{ You can retrieve custom user information about
|
||
all users currently connected to this Client
|
||
by using the RemoteUserInfo property like this: }
|
||
|
||
uinfo:=Sender.RemoteUserInfo[user];
|
||
|
||
{ What you get is a TRtcRecord containing all the
|
||
information stored by the Client using the
|
||
"LoginUserInfo" property before he logged in to the Gateway.
|
||
Private user information (like the password or configuration data)
|
||
will NOT be sent to other users. You will get here ONLY
|
||
data that what was assigned to the "LoginUserInfo" property. }
|
||
|
||
try
|
||
if uinfo.CheckType('RealName',rtc_Text) then
|
||
s:=user+' ('+uinfo.asText['RealName']+') - '+s
|
||
else
|
||
s:=user+' - '+s;
|
||
finally
|
||
{ When you are finished using the data, make sure
|
||
to FREE the object received from "RemoteUserInfo" }
|
||
uinfo.Free; // Do NOT forget this, or you will create a memory leak!
|
||
end;
|
||
|
||
// i:=-1;
|
||
// for a := 0 to eConnected.Items.Count - 1 do
|
||
// if eConnected.Items[a].Caption=s then
|
||
// begin
|
||
// i:=a;
|
||
// Break;
|
||
// end;
|
||
// if i>=0 then
|
||
// begin
|
||
// eConnected.Items.Delete(i);
|
||
// eConnected.Update;
|
||
// end;
|
||
i := lxSuppoter.Items.IndexOf(s);
|
||
if i <> -1 then
|
||
lxSuppoter.Items.Delete(i);
|
||
end;
|
||
|
||
procedure TDlgRmtHostMain.PClientError(Sender: TAbsPortalClient;
|
||
const Msg: string);
|
||
begin
|
||
if assigned(Options_) and Options_.Visible then
|
||
Options_.Close;
|
||
|
||
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 bSilentMode_ then
|
||
// PostMessage(Handle, WM_AUTOCLOSE, 0, 0);
|
||
// else if xAutoConnect.Checked then
|
||
// PClient.Active:=True;
|
||
end;
|
||
|
||
procedure TDlgRmtHostMain.PClientFatalError(Sender: TAbsPortalClient;
|
||
const Msg: string);
|
||
begin
|
||
if assigned(Options_) and Options_.Visible then
|
||
Options_.Close;
|
||
|
||
PClient.Disconnect;
|
||
|
||
SetControls(false);
|
||
lbMsg.Caption := Msg;
|
||
Application.ProcessMessages;
|
||
|
||
// if bSilentMode_ then
|
||
// PostMessage(Handle, WM_AUTOCLOSE, 0, 0)
|
||
// else
|
||
MessageBeep(0);
|
||
end;
|
||
|
||
procedure TDlgRmtHostMain.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;
|
||
|
||
end.
|