| 1 | unit fXWBAppHandle2;
 | 
|---|
| 2 | 
 | 
|---|
| 3 | interface
 | 
|---|
| 4 | 
 | 
|---|
| 5 | uses
 | 
|---|
| 6 |   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 | 
|---|
| 7 |   StdCtrls, Trpcb, RpcSLogin, RpcConf1, frmVistAAbout, Menus;
 | 
|---|
| 8 | 
 | 
|---|
| 9 | type
 | 
|---|
| 10 |   TForm1 = class(TForm)
 | 
|---|
| 11 |     brkrRPCB: TRPCBroker;
 | 
|---|
| 12 |     edtDuz: TEdit;
 | 
|---|
| 13 |     edtName: TEdit;
 | 
|---|
| 14 |     edtDTime: TEdit;
 | 
|---|
| 15 |     edtUserName: TEdit;
 | 
|---|
| 16 |     btnClose: TButton;
 | 
|---|
| 17 |     edtDivision: TEdit;
 | 
|---|
| 18 |     lblDUZ: TLabel;
 | 
|---|
| 19 |     lblName: TLabel;
 | 
|---|
| 20 |     lblDTime: TLabel;
 | 
|---|
| 21 |     lblDivision: TLabel;
 | 
|---|
| 22 |     lblUserName: TLabel;
 | 
|---|
| 23 |     MainMenu1: TMainMenu;
 | 
|---|
| 24 |     File1: TMenuItem;
 | 
|---|
| 25 |     Exit1: TMenuItem;
 | 
|---|
| 26 |     About1: TMenuItem;
 | 
|---|
| 27 |     About2: TMenuItem;
 | 
|---|
| 28 |     Label1: TLabel;
 | 
|---|
| 29 |     edtIsProduction: TEdit;
 | 
|---|
| 30 |     Label2: TLabel;
 | 
|---|
| 31 |     edtDomainName: TEdit;
 | 
|---|
| 32 |     procedure FormCreate(Sender: TObject);
 | 
|---|
| 33 |     procedure btnCloseClick(Sender: TObject);
 | 
|---|
| 34 |     procedure Exit1Click(Sender: TObject);
 | 
|---|
| 35 |     procedure About2Click(Sender: TObject);
 | 
|---|
| 36 |   private
 | 
|---|
| 37 |     { Private declarations }
 | 
|---|
| 38 |   public
 | 
|---|
| 39 |     { Public declarations }
 | 
|---|
| 40 |   end;
 | 
|---|
| 41 | 
 | 
|---|
| 42 | var
 | 
|---|
| 43 |   Form1: TForm1;
 | 
|---|
| 44 |   Login: TVistaLogin;
 | 
|---|
| 45 | 
 | 
|---|
| 46 | implementation
 | 
|---|
| 47 | 
 | 
|---|
| 48 | {$R *.DFM}
 | 
|---|
| 49 | 
 | 
|---|
| 50 | 
 | 
|---|
| 51 | 
 | 
|---|
| 52 | procedure TForm1.FormCreate(Sender: TObject);
 | 
|---|
| 53 | var
 | 
|---|
| 54 |   NChars: Cardinal;
 | 
|---|
| 55 |   NameBuffer: PChar;
 | 
|---|
| 56 |   Server, Port: String;
 | 
|---|
| 57 | begin
 | 
|---|
| 58 |   { check for silent login data on command line }
 | 
|---|
| 59 |   if not CheckCmdLine(brkrRPCB) then
 | 
|---|
| 60 |   begin        // Couldn't log on via command line give choice
 | 
|---|
| 61 |     if Application.MessageBox('Can''t connect by command line arguments, do you want to connect anyway?','Silent Connection Error', MB_OKCANCEL + MB_DEFBUTTON1) = IDOK then
 | 
|---|
| 62 |     begin
 | 
|---|
| 63 |       GetServerInfo(Server, Port);
 | 
|---|
| 64 |       brkrRPCB.Server := Server;
 | 
|---|
| 65 |       brkrRPCB.ListenerPort := StrToInt(Port);
 | 
|---|
| 66 |       Caption := 'XWBAppHandle2 - Started by normal sign-on'
 | 
|---|
| 67 |     end
 | 
|---|
| 68 |     else
 | 
|---|
| 69 |       halt;
 | 
|---|
| 70 |   end;
 | 
|---|
| 71 | 
 | 
|---|
| 72 |   { Get and display information on logged in user }
 | 
|---|
| 73 |   GetUserInfo(brkrRPCB);
 | 
|---|
| 74 |   edtDUZ.Text := brkrRPCB.User.DUZ;
 | 
|---|
| 75 |   edtName.Text := brkrRPCB.User.Name;
 | 
|---|
| 76 |   edtDTime.Text := brkrRPCB.User.DTime;
 | 
|---|
| 77 |   edtDivision.Text := brkrRPCB.User.Division;
 | 
|---|
| 78 |   if brkrRPCB.Login.IsProductionAccount then
 | 
|---|
| 79 |     edtIsProduction.Text := 'True'
 | 
|---|
| 80 |   else
 | 
|---|
| 81 |     edtIsProduction.Text := 'False';
 | 
|---|
| 82 |   edtDomainName.Text := brkrRPCB.LogIn.DomainName;
 | 
|---|
| 83 | 
 | 
|---|
| 84 |   {also show local username }
 | 
|---|
| 85 |   NChars := 0;
 | 
|---|
| 86 |   GetUserName(nil,NChars);
 | 
|---|
| 87 |   NameBuffer := StrAlloc(NChars);
 | 
|---|
| 88 |   if GetUserName(NameBuffer, NChars) then
 | 
|---|
| 89 |     edtUserName.Text := NameBuffer
 | 
|---|
| 90 |   else
 | 
|---|
| 91 |     edtUserName.Text := 'Can''t get name';
 | 
|---|
| 92 | end;
 | 
|---|
| 93 | 
 | 
|---|
| 94 | 
 | 
|---|
| 95 | procedure TForm1.btnCloseClick(Sender: TObject);
 | 
|---|
| 96 | begin
 | 
|---|
| 97 |   halt;
 | 
|---|
| 98 | end;
 | 
|---|
| 99 | 
 | 
|---|
| 100 | procedure TForm1.Exit1Click(Sender: TObject);
 | 
|---|
| 101 | begin
 | 
|---|
| 102 |   Halt;
 | 
|---|
| 103 | end;
 | 
|---|
| 104 | 
 | 
|---|
| 105 | procedure TForm1.About2Click(Sender: TObject);
 | 
|---|
| 106 | begin
 | 
|---|
| 107 |   ShowAboutBox;
 | 
|---|
| 108 | end;
 | 
|---|
| 109 | 
 | 
|---|
| 110 | end.
 | 
|---|