Upgrade to version 27

This commit is contained in:
kdtop3 2010-07-07 20:31:10 +00:00
parent 244f628889
commit ad6be8316c
684 changed files with 100745 additions and 11670 deletions

BIN
BDK32/BrokerProgPref.exe Normal file

Binary file not shown.

BIN
BDK32/Brokerprogpref.GID Normal file

Binary file not shown.

BIN
BDK32/Brokerprogpref.hlp Normal file

Binary file not shown.

BIN
BDK32/Help/Broker.hlp Normal file

Binary file not shown.

BIN
BDK32/Help/broker.GID Normal file

Binary file not shown.

126
BDK32/Help/broker.als Normal file
View File

@ -0,0 +1,126 @@
about_this_version
application_level_issues
blocking_an_rpc
broker_overview
brokerexample
buffer_clearing
checking_rpc_availability_on_a_remote_server
debug
debug_overview
developer_considerations
dll_c_connect
dll_c_create
dll_c_destroy
dll_c_execute
dll_c_init
dll_c_intro
dll_cpp_connect
dll_cpp_create
dll_cpp_destroy
dll_cpp_execute
dll_cpp_init
dll_cpp_intro
dll_cpp_methods
dll_function_rpcbcall
dll_function_rpcbcreate
dll_function_rpcbcreatecontext
dll_function_rpcbfree
dll_function_rpcbmultitemget
dll_function_rpcbmultpropget
dll_function_rpcbmultset
dll_function_rpcbmultsortedset
dll_function_rpcbparamget
dll_function_rpcbparamset
dll_function_rpcbpropget
dll_function_rpcbpropset
dll_getserverinfo
dll_intro
dll_results
dll_vb_connect
dll_vb_create
dll_vb_destroy
dll_vb_execute
dll_vb_init
dll_vb_intro
ebrokererror
error_handling
hash_unit
id_handler
id_listener
idh_brokprogpref
ig_helpfile
introduction
loginfrm_unit
memory_leaks
mfunstr_unit
options_for_running_rpcs_on_a_remote_server
orientation
otherapi_broker
otherapi_encrypt
otherapi_getserverinfo
otherapi_getvarvalue
otherapi_m_emulation
otherapi_overview
otherapi_rtrnfmt
otherapi_splash
overview_of_deferred_rpcs
rpc_cleanup
rpc_create
rpc_document
rpc_entry_point_examples
rpc_execute_from_client
rpc_file_entry
rpc_first_input_param
rpc_good
rpc_input_parameter_types
rpc_limits
rpc_overview
rpc_register
rpc_return_value_types
rpc_routine_relationship
rpc_version_in_remote_procedure_file
rpcconf1_unit
rpcslogin_unit
silent_login
splvista_unit
tccowrpcbroker_component
testing_connection
tmult_class
tparamrecord_class
tparams_class
trpcb_unit
trpcbroker_component
tsharedrpcbroker_component
tut_fmdc
tut_intro
tut_pascal
tut_prep
tut_register
tut_step1
tut_step10
tut_step2
tut_step3
tut_step4
tut_step5
tut_step6
tut_step7
tut_step8
tut_step9
tvcedit_unit
tvistalogin_class
tvistauser_class
txwbrichedit_component
using_an_existing_m_api
whats_new_in_the_bdk
xwb_are_rpcs_available
xwb_deferred_clear
xwb_deferred_clearall
xwb_deferred_getdata
xwb_deferred_rpc
xwb_deferred_status
xwb_direct_rpc
xwb_is_rpc_available
xwb_remote_clear
xwb_remote_getdata
xwb_remote_rpc
xwb_remote_status_check

157
BDK32/Help/broker.cnt Normal file
View File

@ -0,0 +1,157 @@
:Base broker.hlp>main
:Title RPC Broker Developer's Guide
:Link delphi4.hlp
:Link delphi5.hlp
:Link delphi6.hlp
:Link del6vcl.hlp
:Link Fmdc.hlp
1 RPC Broker V. 1.1 Developer's Guide
2 Overview
3 Contents=Contents
3 Introduction=introduction
3 Broker Overview=Broker_Overview
3 Orientation=Orientation
3 About this Version of the RPC Broker=About_this_version
3 What's New in the BDK=Whats_New_in_the_BDK
3 Developer Considerations=Developer_Considerations
3 Application Issues=Application_Level_Issues
3 Silent Login=Silent_Login
3 Context-sensitive Help for the RPC Broker Components=ig_helpfile
2 RPC Broker Components, Classes, and Units
3 EBrokerError Exception=EBrokerError
3 Classes
4 TMult=TMult_Class
4 TParamRecord=TParamRecord_Class
4 TParams=TParams_Class
4 TVistaLogin=TVistaLogin_Class
4 TVistaUser=TVistaUser_Class
3 Components
4 TCCOWRPCBroker=TCCOWRPCBroker_Component
4 TRPCBroker=TRPCBroker_Component
4 TSharedBroker=TSharedBroker_Component
4 TSharedRPCBroker=TSharedRPCBroker_Component
4 TXWBRichEdit=TXWBRichEdit_Component
3 Units
4 Hash=Hash_unit
4 LoginFrm=LoginFrm_Unit
4 MFunStr=MFunStr_unit
4 RPCConf1=RPCConf1_unit
4 RpcSLogin=RpcSLogin_Unit
4 SplVista=SplVista_unit
4 TRPCB=TRPCB_unit
4 TVCEdit=TVCEdit_Unit
2 Remote Procedure Calls (RPCs)
3 Overview=rpc_overview
3 What Makes a Good RPC?=rpc_good
3 Creating RPCs=rpc_create
3 Using an Existing M API=Using_an_Existing_M_API
3 M Entry Point for an RPC
4 Relationship Between an M Entry Point and an RPC=rpc_routine_relationship
4 First Input Parameter=rpc_first_input_param
4 Return Value Types=rpc_return_value_types
4 Input Parameters=rpc_input_parameter_types
4 Examples=rpc_entry_point_examples
3 RPC Entry in the Remote Procedure File
4 RPC Entry in the Remote Procedure File=rpc_file_entry
4 RPC Version in the Remote Procedure File=RPC_Version_in_Remote_Procedure_File
4 Blocking an RPC in the Remote Procedure File=Blocking_an_RPC
4 Cleanup after RPC Execution=rpc_cleanup
4 Documenting RPCs=rpc_document
3 Executing RPCs from Clients
4 How to Execute an RPC from a Client=rpc_execute_from_client
4 RPC Security: How to Register an RPC=rpc_register
4 RPC Limits=RPC_limits
4 BrokerExample Online Code Example=BrokerExample
2 Other RPC Broker APIs
3 Overview=otherapi_Overview
3 Encryption Functions=otherapi_encrypt
3 GetServerInfo Function=otherapi_getserverinfo
3 M Emulation Functions=otherapi_m_emulation
3 VistA Splash Screen Procedures=otherapi_splash
3 $$BROKER^XWBLIB=otherapi_broker
3 $$RTRNFMT^XWBLIB=otherapi_rtrnfmt
3 XWB ARE RPCS AVAILABLE=XWB_ARE_RPCS_AVAILABLE
3 XWB IS RPC AVAILABLE=XWB_IS_RPC_AVAILABLE
3 XWB GET VARIABLE VALUE RPC=otherapi_getvarvalue
3 Running RPCs on a Remote Server
4 Options For Running RPCs on a Remote Server=Options_For_Running_RPCs_on_a_Remote_Server
4 Checking RPC Availability on a Remote Server=Checking_RPC_Availability_on_a_Remote_Server
4 XWB DIRECT RPC=XWB_DIRECT_RPC
4 XWB REMOTE RPC=XWB_REMOTE_RPC
4 XWB REMOTE STATUS CHECK=XWB_REMOTE_STATUS_CHECK
4 XWB REMOTE GETDATA=XWB_REMOTE_GETDATA
4 XWB REMOTE CLEAR=XWB_REMOTE_CLEAR
3 Deferred RPCs
4 Overview of Deferred RPCs=Overview_of_Deferred_RPCs
4 XWB DEFERRED RPC=XWB_DEFERRED_RPC
4 XWB DEFERRED STATUS=XWB_DEFERRED_STATUS
4 XWB DEFERRED GETDATA=XWB_DEFERRED_GETDATA
4 XWB DEFERRED CLEAR=XWB_DEFERRED_CLEAR
4 XWB DEFERRED CLEARALL=XWB_DEFERRED_CLEARALL
2 Debugging and Troubleshooting
3 Overview=debug_overview
3 How to Debug Your Application=debug
3 RPC Error Trapping=Error_Handling
3 Identifying the Listener Process on the Server=ID_Listener
3 Identifying the Handler Process on the Server=ID_Handler
3 Testing Your RPC Broker Connection=Testing_Connection
3 Client Timeout and Buffer Clearing=Buffer_Clearing
3 Memory Leaks=memory_leaks
2 Developer Utilities
3 RPC Broker Programmer Preferences=IDH_brokprogpref
2 Tutorial
3 Introduction=tut_intro
3 Advanced Preparation=tut_prep
3 Step 1: Create Application with an RPC Broker Component=tut_step1
3 Step 2: Get Server/Port=tut_step2
3 Step 3: Establish Broker Connection=tut_step3
3 Step 4: RPC Routine to List Terminal Types=tut_step4
3 Step 5: RPC to List Terminal Types=tut_step5
3 Step 6: Call the ZxxxTT LIST RPC=tut_step6
3 Step 7: Associate IENs=tut_step7
3 Step 8: Routine to Retrieve Terminal Types=tut_step8
3 Step 9: RPC to Retrieve Terminal Types=tut_step9
3 Step 10: Call Zxxx RETRIEVE RPC=tut_step10
3 Step 11: Register RPCs=tut_register
3 See Also: FileMan Delphi Components (FMDC)=tut_fmdc
3 Tutorial Source Code=tut_pascal
2 DLL Interface
3 Introduction=dll_intro
3 DLL Special Issues
4 RPC Results from DLL Calls=dll_results
4 GetServerInfo Function and the DLL=dll_getserverinfo
3 DLL Exported Functions
4 RPCBCall=dll_function_rpcbcall
4 RPCBCreate=dll_function_rpcbcreate
4 RPCBCreateContext=dll_function_rpcbcreatecontext
4 RPCBFree=dll_function_rpcbfree
4 RPCBMultItemGet=dll_function_rpcbmultitemget
4 RPCBMultPropGet=dll_function_rpcbmultpropget
4 RPCBMultSet=dll_function_rpcbmultset
4 RPCBMultSortedSet=dll_function_rpcbmultsortedset
4 RPCBParamGet=dll_function_rpcbParamGet
4 RPCBParamSet=dll_function_rpcbParamSet
4 RPCBPropGet=dll_function_rpcbpropget
4 RPCBPropSet=dll_function_rpcbpropset
3 Guidelines for C++
4 Overview=dll_cpp_intro
4 TRPCBroker C++ Class Methods=dll_cpp_methods
4 Initialize the Class=dll_cpp_init
4 Create Broker Instances=dll_cpp_create
4 Connect to the Server=dll_cpp_connect
4 Execute RPCs=dll_cpp_execute
4 Destroy Broker Instances=dll_cpp_destroy
3 Guidelines for C
4 Overview=dll_c_intro
4 Initialize—LoadLibrary and GetProcAddress=dll_c_init
4 Create Broker Components=dll_c_create
4 Connect to the Server=dll_c_connect
4 Execute RPCs=dll_c_execute
4 Destroy Broker Components=dll_c_destroy
3 Guidelines for Visual Basic
4 Overview=dll_vb_intro
4 Initialize=dll_vb_init
4 Create Broker Components=dll_vb_create
4 Connect to the Server=dll_vb_connect
4 Execute RPCs=dll_vb_execute
4 Destroy Broker Components=dll_vb_destroy

150
BDK32/Help/broker.toc Normal file
View File

@ -0,0 +1,150 @@
:Base broker.hlp>main
:Title RPC Broker Developer's Guide
1 RPC Broker V. 1.1 Developer's Guide
2 Overview
3 Introduction=introduction
3 Broker Overview=Broker_Overview
3 Orientation=Orientation
3 About this Version of the RPC Broker=About_this_version
3 What's New in the BDK=Whats_New_in_the_BDK
3 Developer Considerations=Developer_Considerations
3 Application Issues=Application_Level_Issues
3 Silent Login=Silent_Login
3 Context-sensitive Help for the TRPCBroker Component=ig_helpfile
2 RPC Broker Components and Classes
3 TCCOWRPCBroker=TCCOWRPCBroker_Component
3 TRPCBroker Component=TRPCBroker
3 TSharedRPCBroker Component=TSharedRPCBroker_Component
3 TXWBRichEdit Component=TXWBRichEdit_Component
3 TMult Class=TMult_Class
3 TParamRecord Class=TParamRecord_Class
3 TParams Class=TParams_Class
3 TVistaLogin Class=TVistaLogin_Class
3 TVistaUser Class=TVistaUser_Class
3 EBrokerError Exception=EBrokerError
3 Units
4 Hash Unit=Hash_unit
4 LoginFrm Unit=LoginFrm_Unit
4 MFunStr Unit=MFunStr_unit
4 RPCConf1 Unit=RPCConf1_unit
4 RpcSLogin Unit=RpcSLogin_Unit
4 SplVista Unit=SplVista_unit
4 TCCOWRPCBroker Unit=TCCOWRPRCBroker_unit
4 TRPCB Unit=TRPCB_unit
4 TVCEdit Unit=TVCEdit_Unit
2 Remote Procedure Calls (RPCs)
3 Overview=rpc_overview
3 What Makes a Good RPC?=rpc_good
3 Creating RPCs=rpc_create
3 Using an Existing M API=Using_an_Existing_M_API
3 M Entry Point for an RPC
4 Relationship Between an M Entry Point and an RPC=rpc_routine_relationship
4 First Input Parameter=rpc_first_input_param
4 Return Value Types=rpc_return_value_types
4 Input Parameters=rpc_input_parameter_types
4 Examples=rpc_entry_point_examples
3 RPC Entry in the Remote Procedure File
4 RPC Entry in the Remote Procedure File=rpc_file_entry
4 RPC Version in the Remote Procedure File=RPC_Version_in_Remote_Procedure_File
4 Blocking an RPC in the Remote Procedure File=Blocking_an_RPC
4 Cleanup after RPC Execution=rpc_cleanup
4 Documenting RPCs=rpc_document
3 Executing RPCs from Clients
4 How to Execute an RPC from a Client=rpc_execute_from_client
4 RPC Security: How to Register an RPC=rpc_register
4 RPC Limits=RPC_limits
4 BrokerExample Online Code Example=BrokerExample
2 Other RPC Broker APIs
3 Overview=otherapi_Overview
3 Encryption Functions=otherapi_encrypt
3 GetServerInfo Function=otherapi_getserverinfo
3 M Emulation Functions=otherapi_m_emulation
3 VistA Splash Screen Procedures=otherapi_splash
3 $$BROKER^XWBLIB=otherapi_broker
3 $$RTRNFMT^XWBLIB=otherapi_rtrnfmt
3 XWB ARE RPCS AVAILABLE=XWB_ARE_RPCS_AVAILABLE
3 XWB IS RPC AVAILABLE=XWB_IS_RPC_AVAILABLE
3 XWB GET VARIABLE VALUE RPC=otherapi_getvarvalue
3 Running RPCs on a Remote Server
4 Options For Running RPCs on a Remote Server=Options_For_Running_RPCs_on_a_Remote_Server
4 Checking RPC Availability on a Remote Server=Checking_RPC_Availability_on_a_Remote_Server
4 XWB DIRECT RPC=XWB_DIRECT_RPC
4 XWB REMOTE RPC=XWB_REMOTE_RPC
4 XWB REMOTE STATUS CHECK=XWB_REMOTE_STATUS_CHECK
4 XWB REMOTE GETDATA=XWB_REMOTE_GETDATA
4 XWB REMOTE CLEAR=XWB_REMOTE_CLEAR
3 Deferred RPCs
4 Overview of Deferred RPCs=Overview_of_Deferred_RPCs
4 XWB DEFERRED RPC=XWB_DEFERRED_RPC
4 XWB DEFERRED STATUS=XWB_DEFERRED_STATUS
4 XWB DEFERRED GETDATA=XWB_DEFERRED_GETDATA
4 XWB DEFERRED CLEAR=XWB_DEFERRED_CLEAR
4 XWB DEFERRED CLEARALL=XWB_DEFERRED_CLEARALL
2 Debugging and Troubleshooting
3 Overview=debug_overview
3 How to Debug Your Application=debug
3 RPC Error Trapping=Error_Handling
3 Identifying the Listener Process on the Server=ID_Listener
3 Identifying the Handler Process on the Server=ID_Handler
3 Testing Your RPC Broker Connection=Testing_Connection
3 Client Timeout and Buffer Clearing=Buffer_Clearing
3 Memory Leaks=memory_leaks
2 Developer Utilities
3 RPC Broker Programmer Preferences=IDH_brokprogpref
2 Tutorial
3 Introduction=tut_intro
3 Advanced Preparation=tut_prep
3 Step 1: Create Application with an RPC Broker Component=tut_step1
3 Step 2: Get Server/Port=tut_step2
3 Step 3: Establish Broker Connection=tut_step3
3 Step 4: RPC Routine to List Terminal Types=tut_step4
3 Step 5: RPC to List Terminal Types=tut_step5
3 Step 6: Call the ZxxxTT LIST RPC=tut_step6
3 Step 7: Associate IENs=tut_step7
3 Step 8: Routine to Retrieve Terminal Types=tut_step8
3 Step 9: RPC to Retrieve Terminal Types=tut_step9
3 Step 10: Call Zxxx RETRIEVE RPC=tut_step10
3 Step 11: Register RPCs=tut_register
3 See Also: FileMan Delphi Components (FMDC)=tut_fmdc
3 Tutorial Source Code=tut_pascal
2 DLL Interface
3 Introduction=dll_intro
3 DLL Special Issues
4 RPC Results from DLL Calls=dll_results
4 GetServerInfo Function and the DLL=dll_getserverinfo
3 DLL Exported Functions
4 RPCBCall=dll_function_rpcbcall
4 RPCBCreate=dll_function_rpcbcreate
4 RPCBCreateContext=dll_function_rpcbcreatecontext
4 RPCBFree=dll_function_rpcbfree
4 RPCBMultItemGet=dll_function_rpcbmultitemget
4 RPCBMultPropGet=dll_function_rpcbmultpropget
4 RPCBMultSet=dll_function_rpcbmultset
4 RPCBMultSortedSet=dll_function_rpcbmultsortedset
4 RPCBParamGet=dll_function_rpcbParamGet
4 RPCBParamSet=dll_function_rpcbParamSet
4 RPCBPropGet=dll_function_rpcbpropget
4 RPCBPropSet=dll_function_rpcbpropset
3 Guidelines for C++
4 Overview=dll_cpp_intro
4 TRPCBroker C++ Class Methods=dll_cpp_methods
4 Initialize the Class=dll_cpp_init
4 Create Broker Instances=dll_cpp_create
4 Connect to the Server=dll_cpp_connect
4 Execute RPCs=dll_cpp_execute
4 Destroy Broker Instances=dll_cpp_destroy
3 Guidelines for C
4 Overview=dll_c_intro
4 Initialize—LoadLibrary and GetProcAddress=dll_c_init
4 Create Broker Components=dll_c_create
4 Connect to the Server=dll_c_connect
4 Execute RPCs=dll_c_execute
4 Destroy Broker Components=dll_c_destroy
3 Guidelines for Visual Basic
4 Overview=dll_vb_intro
4 Initialize=dll_vb_init
4 Create Broker Components=dll_vb_create
4 Connect to the Server=dll_vb_connect
4 Execute RPCs=dll_vb_execute
4 Destroy Broker Components=dll_vb_destroy

330
BDK32/INSTALL.LOG Normal file
View File

@ -0,0 +1,330 @@
*** Installation Started 05/08/2007 17:50 ***
Title: tA RPCBroker 1.1 for Delphi XWB*1.1*40 Installation
Source: C:\Shared\Delphi\XWB1_1P40PG.EXE
Made Dir: C:\Program Files\Borland\Delphi7\Lib\BDK32
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\UNWISE.EXE
RegDB Key: Software\Microsoft\Windows\CurrentVersion\Uninstall\VistA RPCBroker 1.1 for Delphi XWB*1.1*40
RegDB Val: VistA RPCBroker 1.1 for Delphi XWB*1.1*40
RegDB Name: DisplayName
RegDB Root: 2
RegDB Key: Software\Microsoft\Windows\CurrentVersion\Uninstall\VistA RPCBroker 1.1 for Delphi XWB*1.1*40
RegDB Val: C:\PROGRA~1\BORLAND\DELPHI7\LIB\BDK32\UNWISE.EXE C:\PROGRA~1\BORLAND\DELPHI7\LIB\BDK32\INSTALL.LOG
RegDB Name: UninstallString
RegDB Root: 2
Made Dir: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples
Made Dir: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker
Made Dir: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\BrokerEx
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\BrokerEx\BrokerExampleAboutFrm.PAS
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\BrokerEx\BrokerExampleAboutFrm.dfm
Made Dir: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker
Made Dir: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\XWBOnFail.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\XWBOnFail.exe
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\XWBOnFail.dpr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\XWBOnFail.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\XWBAVCodes.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\XWBAVCodes.exe
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\XWBAVCodes.dpr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\XWBAVCodes.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\XWBAppHandle2.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\XWBAppHandle2.exe
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\XWBAppHandle2.dpr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\XWBAppHandle2.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\XWBAppHandle1.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\XWBAppHandle1.exe
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\XWBAppHandle1.dpr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\XWBAppHandle1.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\ReadMeForSamples.txt
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\fXWBOnFail.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\fXWBOnFail.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\fXWBAVCodes.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\fXWBAVCodes.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\fXWBAppHandle2.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\fXWBAppHandle2.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\fXWBAppHandle1.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\fXWBAppHandle1.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\frmVistAAbout.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\SilentSignOn\frmVistAAbout.dfm
Made Dir: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\BrokerEx
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\BrokerEx\fVistAAbout.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\BrokerEx\fVistAAbout.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\BrokerEx\frmVistAAbout.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\BrokerEx\frmVistAAbout.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\BrokerEx\fBrokerExampleCCOW.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\BrokerEx\fBrokerExampleCCOW.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\BrokerEx\fBrokerExample.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\BrokerEx\fBrokerExample.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\BrokerEx\BrokerExampleCCOW.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\BrokerEx\BrokerExampleCCOW.exe
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\BrokerEx\BrokerExampleCCOW.dpr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\BrokerEx\BrokerExampleCCOW.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\BrokerEx\BrokerExample.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\BrokerEx\BrokerExample.exe
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\BrokerEx\BrokerExample.dpr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\RPCBroker\BrokerEx\BrokerExample.dof
Made Dir: C:\Program Files\Borland\Delphi7\Lib\BDK32\Help
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Help\broker.toc
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Help\Broker.hlp
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Help\broker.cnt
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Help\broker.als
Made Dir: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\VergenceContextor.dll
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\CCOWRPCBroker.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\fVistaBar.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\frmVistAAbout.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\frmVistAAbout.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\fDebugInfo.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\fDebugInfo.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\CCOW_const.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\uSharedBroker1.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\uSharedBroker1.dpk
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\uSharedBroker1.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\UnitTestMFunStr.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\UnitTestMFunStr.exe
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\UnitTestMFunStr.dpr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\UnitTestMFunStr.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\UnitTestBroker.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\UnitTestBroker.exe
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWBReg.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWBRich20.PAS
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\Xwbut1.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker.dcr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SgnonCnf.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SgnonCnf.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SelDiv.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SelDiv.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\RpcSLogin.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\RPCSharedBrokerSessionMgr1_TLB_SRB.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\RPCSharedBrokerSessionMgr1_TLB.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\RPCSharedBrokerSessionMgr1_TLB.dcr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\RPCSharedBrokerSessionMgr1.tlb
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\RPCSharedBrokerSessionMgr1.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\RPCSharedBrokerSessionMgr1.exe
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\RPCSharedBrokerSessionMgr1.dpr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\RPCSharedBrokerSessionMgr1.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\Rpcnet.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\Rpcnet.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\Rpcconf1.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\Rpcconf1.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\RpcbErr.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\RpcbErr.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\Rpcbedtr.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\Mfunstr.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\Loginfrm.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\Loginfrm.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\IISBase.inc
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\Hash.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\fVistaBar.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\fVistaBar.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\fSignonConfigColor.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\fSignonConfigColor.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\fSgnonDlg.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\fSgnonDlg.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\fRPCSharedBrokerSessionMgr1.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\fRPCSharedBrokerSessionMgr1.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\fRPCBErrMsg.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\fRPCBErrMsg.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\frmSignonMessage.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\frmSignonMessage.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\dunit.ini
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\AddServer.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\AddServer.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\uSharedBroker1.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\uUnitTestBroker.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\uUnitTestMFunStr.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\VCEdit.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\VCEdit.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\Wsockc.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBrokerReg.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBrokerSink.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\Splvista.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\Splvista.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\Trpcb.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\UnitTestBroker.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\UnitTestBroker.dpr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\VERGENCECONTEXTORLib_TLB.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\VERGENCECONTEXTORLib_TLB.dcr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_R50.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_R50.dpk
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_R50.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_D50.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_D50.dpk
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_D50.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_D50.dcr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_R50.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_R50.dpk
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_R50.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_D50.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_D50.dpk
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_D50.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_R70.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_R70.dpk
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_R70.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_D70.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_D70.dpk
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_D70.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_D70.dcr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_R70.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_R70.dpk
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_R70.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_D70.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_D70.dpk
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_D70.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_R60.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_R60.dpk
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_R60.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_D60.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_D60.dpk
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_D60.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_D60.dpk
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_D60.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_R60.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_R60.dpk
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\SharedRPCBroker_R60.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_D60.dcr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\XWB_D60.dof
Made Dir: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\XWB_D70.dpk
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\XWB_D70.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\XWB_D70.dcr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\SharedRPCBroker_R70.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\SharedRPCBroker_R70.dpk
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\SharedRPCBroker_R70.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\SharedRPCBroker_D70.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\SharedRPCBroker_D70.dpk
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\SharedRPCBroker_D70.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\XWB_D70.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\XWB_R70.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\XWB_R70.dpk
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\XWB_R70.res
File Copy: C:\WINDOWS\system32\INETWH32.dll
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Serverlist.hlp
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\ServerList.exe
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Brokerprogpref.hlp
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\BrokerProgPref.exe
Made Dir: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\XWBOnFail.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\XWBOnFail.exe
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\XWBOnFail.dpr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\XWBOnFail.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\XWBAVCodes.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\XWBAVCodes.exe
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\XWBAVCodes.dpr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\XWBAVCodes.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\XWBAppHandle2.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\XWBAppHandle2.exe
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\XWBAppHandle2.dpr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\XWBAppHandle2.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\XWBAppHandle1.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\XWBAppHandle1.exe
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\XWBAppHandle1.dpr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\XWBAppHandle1.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\ReadMeForSamples.txt
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\fXWBOnFail.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\fXWBOnFail.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\fXWBAVCodes.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\fXWBAVCodes.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\fXWBAppHandle2.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\fXWBAppHandle2.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\fXWBAppHandle1.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\fXWBAppHandle1.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\frmVistAAbout.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\SilentSignOn\frmVistAAbout.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\BrokerEx\fBrokerExample.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\BrokerEx\fBrokerExample.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\BrokerEx\frmVistAAbout.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\BrokerEx\frmVistAAbout.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\BrokerEx\BrokerExample.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\BrokerEx\BrokerExample.exe
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\BrokerEx\BrokerExample.dpr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\Samples\SharedRPCBroker\BrokerEx\BrokerExample.dof
Made Dir: C:\Program Files\Borland\Delphi7\Lib\BDK32\SharedBrokerDebugger
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\SharedBrokerDebugger\SharedBrokerDebugger.res
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\SharedBrokerDebugger\uBrokerConnectionInfo.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\SharedBrokerDebugger\fClientInfo.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\SharedBrokerDebugger\fClientRPCLogger.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\SharedBrokerDebugger\fClientRPCLogger.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\SharedBrokerDebugger\fSharedBrokerDebugger.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\SharedBrokerDebugger\fSharedBrokerDebugger.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\SharedBrokerDebugger\RPCSharedBrokerSessionMgr1_TLB.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\SharedBrokerDebugger\SharedBrokerDebugger.dof
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\SharedBrokerDebugger\SharedBrokerDebugger.dpr
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\SharedBrokerDebugger\SharedBrokerDebugger.exe
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\SharedBrokerDebugger\uClientInfo.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\SharedBrokerDebugger\uParam.pas
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\SharedBrokerDebugger\uRpcLogEntry.pas
File Copy: C:\WINDOWS\system32\roboex32.dll
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\VERGENCECONTEXTORLib_TLB.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\fDebugInfo.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\CCOW_const.dcu
File Copy: C:\Program Files\Borland\Delphi7\Projects\Bpl\XWB_R70.dcp
File Copy: C:\Program Files\Borland\Delphi7\Projects\Bpl\XWB_R70.bpl
File Copy: C:\Program Files\Borland\Delphi7\Projects\Bpl\XWB_D70.dcp
File Copy: C:\Program Files\Borland\Delphi7\Projects\Bpl\XWB_D70.bpl
File Copy: C:\Program Files\Borland\Delphi7\Projects\Bpl\SharedRPCBroker_R70.dcp
File Copy: C:\Program Files\Borland\Delphi7\Projects\Bpl\SharedRPCBroker_R70.bpl
File Copy: C:\Program Files\Borland\Delphi7\Projects\Bpl\SharedRPCBroker_D70.dcp
File Copy: C:\Program Files\Borland\Delphi7\Projects\Bpl\SharedRPCBroker_D70.bpl
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\fDebugInfo.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\CCOWRPCBroker.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\frmVistAAbout.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\AddServer.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\AddServer.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\frmSignonMessage.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\frmSignonMessage.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\fRPCBErrMsg.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\fRPCBErrMsg.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\fRPCSharedBrokerSessionMgr1.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\fSgnonDlg.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\fSgnonDlg.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\fSignonConfigColor.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\fVistaBar.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\Hash.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\Loginfrm.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\Loginfrm.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\MFunStr.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\RpcbEdtr.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\Rpcberr.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\Rpcberr.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\Rpcconf1.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\Rpcconf1.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\RpcNet.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\Rpcnet.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\RPCSharedBrokerSessionMgr1_TLB.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\RPCSharedBrokerSessionMgr1_TLB_SRB.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\RpcSLogin.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\seldiv.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\SelDiv.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\Sgnoncnf.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\SgnonCnf.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\SharedRPCBroker.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\SharedRPCBroker_D70.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\SharedRPCBroker_R70.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\SharedRPCBrokerReg.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\SharedRPCBrokerSink.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\Splvista.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\Splvista.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\Trpcb.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\VCEdit.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\VCEdit.dfm
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\WSockc.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\XWB_D70.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\XWB_R70.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\XWBReg.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\XWBRich20.dcu
File Copy: C:\Program Files\Borland\Delphi7\Lib\BDK32\D7\Xwbut1.dcu
RegDB Key: Software\Vista\Broker
RegDB Val: 1
RegDB Name: IDEConnect
RegDB Root: 2
RegDB Key: Software\Vista\Broker
RegDB Val: C:\PROGRA~1\BORLAND\DELPHI7\LIB\BDK32
RegDB Name: BDKDr
RegDB Root: 2
RegDB Old: C:\Program Files\Borland\Delphi7\Lib\BDK32
RegDB Key: Software\Vista\Broker
RegDB Val: 1.1.36.0
RegDB Name: BDK Version
RegDB Root: 2
Self-Register: C:\Program Files\Borland\Delphi7\Lib\BDK32\Source\VergenceContextor.dll

View File

@ -0,0 +1,80 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=Vcl50;Vclx50;Vcldb50;Vclbde50;VclSmp50;vclado50;ibevnt50;vcldbx50;Qrpt50;TeeUI50;TeeDB50;Tee50;Dss50;TeeQR50;VCLIB50;Vclmid50;vclie50;Inetdb50;Inet50;NMFast50;webmid50;dclocx50;dclaxserver50;JLITestFDE;Rz252N50;Rz252D50;CS20Comps50;CSP20I50;gmunitsd5;gmctrlsd5;gmchrtedd5;gmdaouid5;GMDaod5;gmdbgend5;gmdbctrld5;gmadouid5;GMAdod5;democomponentsd5;Indy50;XWB_R50;SharedBroker_D50;CPRSctrls;ZipMasterD5;ICSDEL50;TCynthesisAppUpdateD5
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=1
MinorVer=1
Release=31
Build=2
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=Example Program using RPCBroker and different types of calls
FileVersion=1.1.31.2
InternalName=Broker Example
LegalCopyright=(c) 1997-2002
LegalTrademarks=
OriginalFilename=
ProductName=RPCBroker BrokerExample
ProductVersion=1.1.31.0
Comments=
[Excluded Packages]
$(DELPHI)\Bin\dclite50.bpl=Borland Integrated Translation Environment

View File

@ -0,0 +1,17 @@
program BrokerExample;
uses
Forms,
fBrokerExample in 'fBrokerExample.pas' {frmBrokerExample},
SplVista;
// include to display Vista splash
{$R *.RES}
begin
Application.CreateForm(TfrmBrokerExample, frmBrokerExample);
SplashOpen; // display splash screen
SplashClose(3000); // min splash time 3 seconds, then close
Application.Run;
end.

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,84 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=Vcl50;Vclx50;Vcldb50;Vclbde50;VclSmp50;vclado50;ibevnt50;vcldbx50;Qrpt50;TeeUI50;TeeDB50;Tee50;Dss50;TeeQR50;VCLIB50;Vclmid50;vclie50;Inetdb50;Inet50;NMFast50;webmid50;dclocx50;dclaxserver50;JLITestFDE;Rz252N50;Rz252D50;CS20Comps50;CSP20I50;gmunitsd5;gmctrlsd5;gmchrtedd5;gmdaouid5;GMDaod5;gmdbgend5;gmdbctrld5;gmadouid5;GMAdod5;democomponentsd5;Indy50;XWB_R50;SharedBroker_D50;CPRSctrls;ZipMasterD5;ICSDEL50;TCynthesisAppUpdateD5
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Language]
ActiveLang=
ProjectLang=$00000409
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
D:\PROGRA~1\Borland\Delphi5\Projects\Bpl\Fmdc_R50.bpl=VistA Fileman Delphi Components

View File

@ -0,0 +1,19 @@
program BrokerExampleCCOW;
uses
Forms,
fBrokerExampleCCOW in 'fBrokerExampleCCOW.pas' {frmBrokerExampleCCOW},
SplVista,
fOkToTerminate in 'fOkToTerminate.pas' {frmOKToTerminate};
// include to display Vista splash
{$R *.RES}
begin
Application.CreateForm(TfrmBrokerExampleCCOW, frmBrokerExampleCCOW);
Application.CreateForm(TfrmOKToTerminate, frmOKToTerminate);
SplashOpen; // display splash screen
SplashClose(3000); // min splash time 3 seconds, then close
Application.Run;
end.

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,615 @@
object frmBrokerExample: TfrmBrokerExample
Left = 248
Top = 112
BorderStyle = bsSingle
Caption = 'RPCBroker Example UCX RPCBroker (p40)'
ClientHeight = 389
ClientWidth = 472
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clBtnText
Font.Height = -13
Font.Name = 'System'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = True
Position = poScreenCenter
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 16
object GroupBox2: TGroupBox
Left = 8
Top = 0
Width = 457
Height = 73
Caption = 'VistA Server'
TabOrder = 0
object Label2: TLabel
Left = 6
Top = 51
Width = 67
Height = 16
AutoSize = False
Caption = 'Status:'
end
object Label3: TLabel
Left = 73
Top = 51
Width = 88
Height = 16
Caption = 'Disconnected'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clRed
Font.Height = -13
Font.Name = 'System'
Font.Style = []
ParentColor = False
ParentFont = False
end
object btnConnect: TButton
Left = 354
Top = 12
Width = 91
Height = 25
Caption = '&Connect'
Default = True
TabOrder = 2
OnClick = btnConnectClick
end
object edtPort: TEdit
Left = 192
Top = 24
Width = 49
Height = 24
Hint = 'Listener port number'
ParentShowHint = False
ShowHint = True
TabOrder = 1
Text = '9200'
OnChange = edtServerChange
end
object edtServer: TEdit
Left = 8
Top = 24
Width = 177
Height = 24
Hint = 'Name of server or IP address'
ParentShowHint = False
ShowHint = True
TabOrder = 0
Text = 'BROKERSERVER'
OnChange = edtServerChange
end
object BitBtn1: TBitBtn
Left = 354
Top = 44
Width = 91
Height = 25
TabOrder = 3
Kind = bkClose
end
object btnGetServerInfo: TBitBtn
Left = 248
Top = 24
Width = 73
Height = 25
Hint = 'GetServerInfo'
Caption = 'Server'
ParentShowHint = False
ShowHint = True
TabOrder = 4
OnClick = btnGetServerInfoClick
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000120B0000120B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333000000000
00333FF777777777773F0000FFFFFFFFFF0377773F3F3F3F3F7308880F0F0F0F
0FF07F33737373737337088880FFFFFFFFF07F3337FFFFFFFFF7088880000000
00037F3337777777777308888033330F03337F3337F3FF7F7FFF088880300000
00007F3337F7777777770FFFF030FFFFFFF07F3FF7F7F3FFFFF708008030F000
00F07F7737F7F77777F70FFFF030F0AAE0F07F3FF7F7F7F337F708008030F0DA
D0F07F7737F7F7FFF7F70FFFF030F00000F07F33F7F7F77777370FF9F030FFFF
FFF07F3737F7FFFFFFF70FFFF030000000007FFFF7F777777777000000333333
3333777777333333333333333333333333333333333333333333}
NumGlyphs = 2
end
object cbxBackwardCompatible: TCheckBox
Left = 186
Top = 54
Width = 161
Height = 17
Action = actBackwardCompatible
State = cbChecked
TabOrder = 5
end
end
object PageControl1: TPageControl
Left = 8
Top = 76
Width = 457
Height = 305
ActivePage = TabSheet1
TabOrder = 1
object TabSheet1: TTabSheet
Caption = 'Echo string'
object lblSend: TLabel
Left = 8
Top = 24
Width = 96
Height = 16
Caption = 'Original string:'
end
object lblReturn: TLabel
Left = 8
Top = 144
Width = 93
Height = 16
Caption = 'Echoed string:'
end
object edtStrOrig: TEdit
Left = 8
Top = 40
Width = 225
Height = 24
TabOrder = 0
Text = 'Hello World!'
end
object edtStrRtrn: TEdit
Left = 8
Top = 160
Width = 225
Height = 24
ReadOnly = True
TabOrder = 1
end
object btnEchoString: TButton
Left = 8
Top = 88
Width = 225
Height = 25
Hint = 'XWB EXAMPLE ECHO STRING'
Caption = 'Execute RPC'
Default = True
ParentShowHint = False
ShowHint = True
TabOrder = 2
OnClick = btnEchoStringClick
end
object Memo1: TMemo
Left = 240
Top = 8
Width = 201
Height = 257
TabStop = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
Lines.Strings = (
'Uses TRPCBroker.Call method '
'to return a single string.'
''
'Original string passed in as '
'PType literal.'
''
'RPC: XWB EXAMPLE ECHO '
'STRING.'
''
'Return Value Type: SINGLE '
'VALUE.')
ParentColor = True
ParentFont = False
ReadOnly = True
TabOrder = 3
end
end
object TabSheet2: TTabSheet
Caption = 'Pass by reference'
object Label1: TLabel
Left = 8
Top = 24
Width = 70
Height = 16
Caption = 'Reference:'
end
object Label4: TLabel
Left = 8
Top = 144
Width = 40
Height = 16
Caption = 'Value:'
end
object edtReference: TEdit
Left = 8
Top = 40
Width = 225
Height = 24
TabOrder = 0
Text = '$HOROLOG'
end
object edtValue: TEdit
Left = 8
Top = 160
Width = 225
Height = 24
ReadOnly = True
TabOrder = 1
end
object btnPassByRef: TButton
Left = 8
Top = 88
Width = 225
Height = 25
Hint = 'XWB GET VARIABLE VALUE'
Caption = 'Execute RPC'
Default = True
ParentShowHint = False
ShowHint = True
TabOrder = 2
OnClick = btnPassByRefClick
end
object Memo2: TMemo
Left = 240
Top = 8
Width = 201
Height = 257
TabStop = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
Lines.Strings = (
'Uses TRPCBroker.strCall '
'method to return a single string.'
''
'Parameter passed in as PType '
'reference.'
''
'RPC: XWB GET VARIABLE '
'VALUE.'
''
'Return Value Type: SINGLE '
'VALUE.')
ParentColor = True
ParentFont = False
ReadOnly = True
TabOrder = 3
end
end
object TabSheet3: TTabSheet
Caption = 'Get list'
object Label5: TLabel
Left = 8
Top = 120
Width = 87
Height = 16
Caption = 'Returned list:'
end
object lstData: TListBox
Left = 8
Top = 136
Width = 225
Height = 129
ItemHeight = 16
TabOrder = 0
end
object btnGetList: TButton
Left = 8
Top = 88
Width = 225
Height = 25
Hint = 'XWB EXAMPLE GET LIST'
Caption = 'Execute RPC'
Default = True
ParentShowHint = False
ShowHint = True
TabOrder = 1
OnClick = btnGetListClick
end
object RadioButton1: TRadioButton
Left = 16
Top = 16
Width = 137
Height = 17
Caption = 'Number of lines'
Checked = True
TabOrder = 2
TabStop = True
end
object RadioButton2: TRadioButton
Left = 16
Top = 48
Width = 137
Height = 17
Caption = 'Kilobytes of data'
TabOrder = 3
end
object spnLines: TSpinEdit
Left = 160
Top = 16
Width = 65
Height = 26
MaxValue = 0
MinValue = 0
TabOrder = 4
Value = 50
end
object spnKbytes: TSpinEdit
Left = 160
Top = 48
Width = 65
Height = 26
MaxValue = 0
MinValue = 0
TabOrder = 5
Value = 32
end
object Memo3: TMemo
Left = 240
Top = 8
Width = 201
Height = 257
TabStop = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
Lines.Strings = (
'Uses TRPCBroker.Call method '
'to return several strings.'
''
'Two parameters passed in as '
'PType literal.'
''
'RPC: XWB EXAMPLE GET LIST.'
''
'Return Value Type: GLOBAL '
'ARRAY.'
''
'WORD WRAP ON field is True '
'to break appart call result into '
'separate Results strings instead '
'of one long Results[0] string.')
ParentColor = True
ParentFont = False
ReadOnly = True
TabOrder = 6
end
end
object TabSheet4: TTabSheet
Caption = 'WP Text'
object lblList: TLabel
Left = 8
Top = 56
Width = 177
Height = 17
AutoSize = False
Caption = 'REMOTE PROCEDURE file description:'
end
object btnWPText: TButton
Left = 8
Top = 16
Width = 225
Height = 25
Hint = 'XWB EXAMPLE WPTEXT'
Caption = 'Execute RPC'
Default = True
ParentShowHint = False
ShowHint = True
TabOrder = 0
OnClick = btnWPTextClick
end
object mmoText: TMemo
Left = 8
Top = 80
Width = 225
Height = 185
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 1
end
object Memo4: TMemo
Left = 240
Top = 8
Width = 201
Height = 257
TabStop = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
Lines.Strings = (
'Uses TRPCBroker.lstCall '
'method to return several strings.'
''
'No parameters are used in this '
'call.'
''
'RPC: XWB EXAMPLE WPTEXT.'
''
'Return Value Type: WORD '
'PROCESSING.'
''
'WORD WRAP ON field is False '
'to allow memo box to control '
'word wrapping as necessary.')
ParentColor = True
ParentFont = False
ReadOnly = True
TabOrder = 2
end
end
object TabSheet5: TTabSheet
Caption = 'Sort numbers'
object Label6: TLabel
Left = 8
Top = 120
Width = 87
Height = 16
Caption = 'Returned list:'
end
object Label7: TLabel
Left = 8
Top = 8
Width = 72
Height = 16
Caption = 'How many:'
end
object lblStatus: TLabel
Left = 8
Top = 56
Width = 57
Height = 16
Caption = 'lblStatus'
Visible = False
end
object lstSorted: TListBox
Left = 8
Top = 136
Width = 225
Height = 129
ItemHeight = 16
TabOrder = 0
end
object btnSortNum: TButton
Left = 8
Top = 88
Width = 225
Height = 25
Hint = 'XWB EXAMPLE SORT NUMBERS'
Caption = 'Execute RPC'
Default = True
ParentShowHint = False
ShowHint = True
TabOrder = 1
OnClick = btnSortNumClick
end
object spnNumbers: TSpinEdit
Left = 8
Top = 24
Width = 81
Height = 26
MaxValue = 10000
MinValue = 0
TabOrder = 2
Value = 500
end
object rgrDirection: TRadioGroup
Left = 104
Top = 8
Width = 121
Height = 65
Caption = 'Sort direction'
ItemIndex = 0
Items.Strings = (
'low -> high'
'high -> low')
TabOrder = 3
end
object Memo5: TMemo
Left = 240
Top = 88
Width = 201
Height = 177
TabStop = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentColor = True
ParentFont = False
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 4
end
object rgArrayType: TRadioGroup
Left = 240
Top = 8
Width = 185
Height = 65
Caption = 'Array Type'
ItemIndex = 0
Items.Strings = (
'Local'
'Global')
TabOrder = 5
OnClick = rgArrayTypeClick
end
end
end
object MainMenu1: TMainMenu
Left = 160
Top = 320
object mnuOptions: TMenuItem
Caption = '&Options'
object mnuOptOldConnectionOnly: TMenuItem
Action = actOldConnectionOnly
Caption = 'Old Connection Type Only'
end
object mnuOptBackwardCompatible: TMenuItem
Action = actBackwardCompatible
end
object mnuOptDebugMode: TMenuItem
Action = actDebugMode
end
object mnuOptUserContext: TMenuItem
Action = actUserContext
end
end
object Help1: TMenuItem
Caption = '&Help'
object AboutExample: TMenuItem
Caption = '&About RPC Broker Example...'
OnClick = AboutExampleClick
end
end
end
object Timer1: TTimer
OnTimer = Timer1Timer
Left = 16
Top = 320
end
object ActionList1: TActionList
Left = 52
Top = 295
object actBackwardCompatible: TAction
Caption = '&Backward Compatible'
Checked = True
OnExecute = actBackwardCompatibleExecute
end
object actOldConnectionOnly: TAction
Caption = '&Old Connection Only'
OnExecute = actOldConnectionOnlyExecute
end
object actDebugMode: TAction
Caption = '&Debug Mode'
OnExecute = actDebugModeExecute
end
object actUserContext: TAction
Caption = '&CCOW User Context'
Enabled = False
OnExecute = actUserContextExecute
end
end
object RPCBroker1: TRPCBroker
ClearParameters = True
ClearResults = True
Connected = False
ListenerPort = 9200
RpcVersion = '0'
Server = 'BROKERSERVER'
KernelLogIn = True
LogIn.Mode = lmAVCodes
LogIn.PromptDivision = False
OldConnectionOnly = False
Left = 100
Top = 335
end
end

View File

@ -0,0 +1,425 @@
{**************************************************
RPC Broker Example form ver. 1.1 9/3/97
Broker Development Team
San Francisco IRM Field Office, Dept. of Veterans Affairs
Disclaimer:
This example does not attempt to teach general Delphi and M programming.
We intentionally removed any safeguards from the code that prevents
passing values that are too small or too large. Therefore, the important
code remains uncluttered and the programmer is free to experiment and
push the program beyond its limits.
Purpose:
This sample application is an example of how to program client/server
applications in Delphi and M using the RPC Broker. The demonstrated features
include:
- Connecting to an M server
- Creating an application context
- Using the GetServerInfo function
- Displaying the VistA splash screen
- Setting the TRPCBroker Param property for each Param PType (literal,
reference, list)
- Calling RPCs with the Call method
- Calling RPCs with the lstCall and strCall methods
We encourage you to study the Delphi and M source code to see how the
Broker is used to accomplish these tasks. Try changing some of the
RPCBroker1 component properties to see what happens. Also, try other
values in the fields of the remote procedure records in the
REMOTE PROCEDURE file.
Warning: "Get list" and "Sort numbers" tabs can potentially take excessively
large data samples which can either crash server process or cause the
connection timeout. Final note, memory allocation errors are not recorded
in the Kernel error trap. They are recorded in the operating system error
trap.
Context option for this application:
XWB BROKER EXAMPLE
Remote procedures used:
XWB EXAMPLE ECHO STRING
XWB EXAMPLE GET LIST
XWB EXAMPLE SORT NUMBERS
XWB EXAMPLE WPTEXT
XWB GET VARIABLE VALUE
Server M routine:
XWBEXMPL
**************************************************}
unit fBrokerExample;
interface
uses
SysUtils,Forms, StdCtrls,Graphics, Dialogs, WinTypes,
Controls, Classes, ExtCtrls, TRPCB, XWBut1, MFunStr, Menus, WinProcs,
RpcConf1, Spin, ComCtrls, fVistAAbout, Buttons,
ActiveX, ActnList, CCOWRPCBroker, OleCtrls, VERGENCECONTEXTORLib_TLB;
type
TfrmBrokerExample = class(TForm)
GroupBox2: TGroupBox;
Label2: TLabel;
Label3: TLabel;
MainMenu1: TMainMenu;
Help1: TMenuItem;
AboutExample: TMenuItem;
btnConnect: TButton;
edtPort: TEdit;
edtServer: TEdit;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
lblSend: TLabel;
edtStrOrig: TEdit;
lblReturn: TLabel;
edtStrRtrn: TEdit;
btnEchoString: TButton;
lblList: TLabel;
Label1: TLabel;
edtReference: TEdit;
Label4: TLabel;
edtValue: TEdit;
btnPassByRef: TButton;
lstData: TListBox;
Label5: TLabel;
btnGetList: TButton;
btnWPText: TButton;
Label6: TLabel;
lstSorted: TListBox;
btnSortNum: TButton;
spnNumbers: TSpinEdit;
Label7: TLabel;
rgrDirection: TRadioGroup;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
spnLines: TSpinEdit;
spnKbytes: TSpinEdit;
Timer1: TTimer;
mmoText: TMemo;
lblStatus: TLabel;
BitBtn1: TBitBtn;
btnGetServerInfo: TBitBtn;
Memo1: TMemo;
Memo2: TMemo;
Memo3: TMemo;
Memo4: TMemo;
Memo5: TMemo;
rgArrayType: TRadioGroup;
cbxBackwardCompatible: TCheckBox;
mnuOptions: TMenuItem;
mnuOptBackwardCompatible: TMenuItem;
mnuOptDebugMode: TMenuItem;
mnuOptUserContext: TMenuItem;
mnuOptOldConnectionOnly: TMenuItem;
ActionList1: TActionList;
actBackwardCompatible: TAction;
actOldConnectionOnly: TAction;
actDebugMode: TAction;
actUserContext: TAction;
RPCBroker1: TRPCBroker;
procedure AboutExampleClick(Sender: TObject);
procedure btnEchoStringClick(Sender: TObject);
procedure btnConnectClick(Sender: TObject);
procedure btnPassByRefClick(Sender: TObject);
procedure btnGetListClick(Sender: TObject);
procedure btnSortNumClick(Sender: TObject);
procedure btnWPTextClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure btnGetServerInfoClick(Sender: TObject);
procedure edtServerChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure rgArrayTypeClick(Sender: TObject);
procedure actBackwardCompatibleExecute(Sender: TObject);
procedure actDebugModeExecute(Sender: TObject);
procedure actUserContextExecute(Sender: TObject);
procedure actOldConnectionOnlyExecute(Sender: TObject);
public
procedure OnCCOWCommit(Sender: TObject); // CCOW related
end;
var
frmBrokerExample: TfrmBrokerExample;
ContextorControl1: TContextorControl; // CCOW related
implementation
{$R *.DFM}
procedure TfrmBrokerExample.btnEchoStringClick(Sender: TObject);
begin
RPCBroker1.RemoteProcedure := 'XWB EXAMPLE ECHO STRING';
RPCBroker1.Param[0].Value := edtStrOrig.Text;
RPCBroker1.Param[0].PType := literal;
RPCBroker1.Call; //execute RPC
edtStrRtrn.Text := RPCBroker1.Results[0]; //for single value use Results[0]
end;
procedure TfrmBrokerExample.btnPassByRefClick(Sender: TObject);
begin
RPCBroker1.RemoteProcedure := 'XWB GET VARIABLE VALUE';
RPCBroker1.Param[0].Value := edtReference.Text;
RPCBroker1.Param[0].PType := reference;
edtValue.Text := RPCBroker1.strCall; //execute RPC and show result in one call
end;
procedure TfrmBrokerExample.btnGetListClick(Sender: TObject);
begin
RPCBroker1.RemoteProcedure := 'XWB EXAMPLE GET LIST';
if RadioButton1.Checked then begin
RPCBroker1.Param[0].Value := 'LINES';
RPCBroker1.Param[0].PType := literal;
RPCBroker1.Param[1].Value := IntToStr(spnLines.Value);
RPCBroker1.Param[1].PType := literal;
end
else begin
RPCBroker1.Param[0].Value := 'KILOBYTES';
RPCBroker1.Param[0].PType := literal;
RPCBroker1.Param[1].Value := IntToStr(spnKbytes.Value);
RPCBroker1.Param[1].PType := literal
end;
RPCBroker1.Call; //execute RPC
lstData.Items := RPCBroker1.Results; //show results of the call
end;
procedure TfrmBrokerExample.btnWPTextClick(Sender: TObject);
begin
RPCBroker1.RemoteProcedure := 'XWB EXAMPLE WPTEXT';
RPCBroker1.lstCall(mmoText.Lines); //execute RPC and show results in one call
end;
procedure TfrmBrokerExample.btnSortNumClick(Sender: TObject);
var
I, SaveRPCTimeLimit, DefaultRange: integer;
begin
lblStatus.Visible := True; //turn on status label
lblStatus.Caption := 'building'; //tell user what's happenning
Application.ProcessMessages; //give Windows chance to paint
with RPCBroker1 do
begin
if rgArrayType.ItemIndex = 0 then
begin
RemoteProcedure := 'XWB EXAMPLE SORT NUMBERS';
DefaultRange := 10000;
end
else
begin
RemoteProcedure := 'XWB EXAMPLE GLOBAL SORT';
DefaultRange := 100000;
end;
if rgrDirection.ItemIndex = 0 then Param[0].Value := 'LO'
else Param[0].Value := 'HI';
Param[0].PType := literal;
with Param[1] do begin
if rgArrayType.ItemIndex = 0 then
PType := list //tells Broker to pass Mult
else
PType := global;
for I := 0 to spnNumbers.Value - 1 do //build Mult one by one
Mult['"A'+IntToStr(I)+'"'] := IntToStr(Random(DefaultRange)+1); //subscript and value are strings!
end;
lblStatus.Caption := 'RPC running';
Application.ProcessMessages; //give Windows chance to paint
SaveRPCTimeLimit := RPCTimeLimit;
RPCTimeLimit := spnNumbers.Value div 10; //adjust in case a lot of numbers
Call; //execute RPC
lstSorted.Items := Results; //show results of the call
RPCTimeLimit := SaveRPCTimeLimit; //restore original value
end;
lblStatus.Visible := False; //turn off status label
end;
procedure TfrmBrokerExample.btnConnectClick(Sender: TObject);
begin
if btnConnect.Caption = '&Connect' then
begin //connect
RpcBroker1.IsBackwardCompatibleConnection := actBackwardCompatible.Checked;
RpcBroker1.OldConnectionOnly := actOldConnectionOnly.Checked;
RpcBroker1.DebugMode := actDebugMode.Checked;
if RpcBroker1.IsBackwardCompatibleConnection or RpcBroker1.OldConnectionOnly then
begin
rgArrayType.ItemIndex := 0;
rgArrayType.Enabled := False;
end
else
begin
rgArrayType.Enabled := True;
end;
{
// *********************** CCOW User Context ****************************
if actUserContext.Checked then
begin
if (RPCBroker1.Contextor = nil) then
begin
if ContextorControl1 = nil then
begin
ContextorControl1 := TContextorControl.Create(Self);
ContextorControl1.OnCommitted := OnCCOWCommit;
try
ContextorControl1.Run('CCOWTerm#', '', TRUE, '*');
except
ShowMessage('Problem with Contextor.Run');
ContextorControl1.Free;
ContextorControl1 := nil;
end;
end;
end;
RPCBroker1.Contextor := ContextorControl1;
end
else
RPCBroker1.Contextor := nil;
// *********************** End CCOW User Context *************************
}
RPCBroker1.ClearParameters := True; //try False, see what happens
try
RPCBroker1.Connected := True;
//establish connection
if not RPCBroker1.CreateContext('XWB BROKER EXAMPLE') then
ShowMessage('Context could not be created!');
except
on e: Exception do
ShowMessage('Error: ' + e.Message);
end;
end
else //disconnect
RPCBroker1.Connected := False;
end;
procedure TfrmBrokerExample.btnGetServerInfoClick(Sender: TObject);
var
strServer, strPort: string;
begin
if GetServerInfo(strServer, strPort)<> mrCancel then
begin {getsvrinfo}
edtServer.Text := strServer; //use chosen server
edtPort.Text := strPort; //use chosen port
end;
end;
procedure TfrmBrokerExample.edtServerChange(Sender: TObject);
begin
RPCBroker1.Server := edtServer.Text; //use specified server name/addr
RPCBroker1.ListenerPort := StrToInt(edtPort.Text); //use specified port
end;
procedure TfrmBrokerExample.Timer1Timer(Sender: TObject);
begin
if RPCBroker1.Connected then begin
btnConnect.Caption := '&Disconnect';
btnConnect.Default := False;
mnuOptions.Enabled := False;
cbxBackwardCompatible.Enabled := False;
Label3.Caption := 'Connected';
Label3.Font.Color := clLime; // clGreen; // went to lime for higher contrast at some of the High contrast desktops
end
else begin
btnConnect.Caption := '&Connect';
btnConnect.Default := True;
mnuOptions.Enabled := True;
if not actOldConnectionOnly.Checked then
cbxBackwardCompatible.Enabled := True;
Label3.Caption := 'Disconnected';
Label3.Font.Color := clRed; // Stayed with Red, generated a high contrast across all of the various combinations
// Attempted to use clHighlight, but it did not show up like a highlight.
end;
end;
procedure TfrmBrokerExample.AboutExampleClick(Sender: TObject);
begin
ShowAboutBox;
end;
procedure TfrmBrokerExample.FormCreate(Sender: TObject);
begin
{
CoInitialize(nil); // needed for CCOW
}
end;
procedure TfrmBrokerExample.rgArrayTypeClick(Sender: TObject);
begin
if rgArrayType.ItemIndex = 0 then
spnNumbers.Value := 500
else
spnNumbers.Value := 5000;
end;
procedure TfrmBrokerExample.actBackwardCompatibleExecute(Sender: TObject);
begin
if actBackwardCompatible.Checked then
actBackwardCompatible.Checked := False
else
actBackwardCompatible.Checked := True;
end;
procedure TfrmBrokerExample.actDebugModeExecute(Sender: TObject);
begin
if actDebugMode.Checked then
actDebugMode.Checked := False
else
actDebugMode.Checked := True;
end;
procedure TfrmBrokerExample.actUserContextExecute(Sender: TObject);
begin
if actuserContext.Checked then
actUserContext.Checked := False
else
actUserContext.Checked := True;
end;
procedure TfrmBrokerExample.actOldConnectionOnlyExecute(Sender: TObject);
begin
if actOldConnectionOnly.Checked then
begin
actOldConnectionOnly.Checked := False;
actBackwardCompatible.Enabled := True;
end
else
begin
actOldConnectionOnly.Checked := True;
actBackwardCompatible.Enabled := False;
end;
end;
procedure TfrmBrokerExample.OnCCOWCommit(Sender: TObject);
begin
{ // uses CCOWRPCBroker
if RpcBroker1.WasUserDefined and RpcBroker1.IsUserCleared then
Halt;
}
end;
end.

View File

@ -0,0 +1,615 @@
object frmBrokerExampleCCOW: TfrmBrokerExampleCCOW
Left = 247
Top = 112
BorderStyle = bsSingle
Caption = 'RPCBroker Example CCOW-enabled (p40)'
ClientHeight = 389
ClientWidth = 473
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clBtnText
Font.Height = -13
Font.Name = 'System'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = True
Position = poScreenCenter
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 16
object GroupBox2: TGroupBox
Left = 8
Top = 0
Width = 457
Height = 73
Caption = 'VistA Server'
TabOrder = 0
object Label2: TLabel
Left = 6
Top = 51
Width = 67
Height = 16
AutoSize = False
Caption = 'Status:'
end
object Label3: TLabel
Left = 73
Top = 51
Width = 88
Height = 16
Caption = 'Disconnected'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clRed
Font.Height = -13
Font.Name = 'System'
Font.Style = []
ParentColor = False
ParentFont = False
end
object btnConnect: TButton
Left = 354
Top = 12
Width = 91
Height = 25
Caption = '&Connect'
Default = True
TabOrder = 2
OnClick = btnConnectClick
end
object edtPort: TEdit
Left = 192
Top = 24
Width = 49
Height = 24
Hint = 'Listener port number'
ParentShowHint = False
ShowHint = True
TabOrder = 1
Text = '9200'
OnChange = edtServerChange
end
object edtServer: TEdit
Left = 8
Top = 24
Width = 177
Height = 24
Hint = 'Name of server or IP address'
ParentShowHint = False
ShowHint = True
TabOrder = 0
Text = 'BROKERSERVER'
OnChange = edtServerChange
end
object BitBtn1: TBitBtn
Left = 354
Top = 44
Width = 91
Height = 25
TabOrder = 3
Kind = bkClose
end
object btnGetServerInfo: TBitBtn
Left = 248
Top = 24
Width = 73
Height = 25
Hint = 'GetServerInfo'
Caption = 'Server'
ParentShowHint = False
ShowHint = True
TabOrder = 4
OnClick = btnGetServerInfoClick
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000120B0000120B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333000000000
00333FF777777777773F0000FFFFFFFFFF0377773F3F3F3F3F7308880F0F0F0F
0FF07F33737373737337088880FFFFFFFFF07F3337FFFFFFFFF7088880000000
00037F3337777777777308888033330F03337F3337F3FF7F7FFF088880300000
00007F3337F7777777770FFFF030FFFFFFF07F3FF7F7F3FFFFF708008030F000
00F07F7737F7F77777F70FFFF030F0AAE0F07F3FF7F7F7F337F708008030F0DA
D0F07F7737F7F7FFF7F70FFFF030F00000F07F33F7F7F77777370FF9F030FFFF
FFF07F3737F7FFFFFFF70FFFF030000000007FFFF7F777777777000000333333
3333777777333333333333333333333333333333333333333333}
NumGlyphs = 2
end
object cbxBackwardCompatible: TCheckBox
Left = 186
Top = 54
Width = 161
Height = 17
Action = actBackwardCompatible
State = cbChecked
TabOrder = 5
end
end
object PageControl1: TPageControl
Left = 8
Top = 76
Width = 457
Height = 305
ActivePage = TabSheet1
TabOrder = 1
object TabSheet1: TTabSheet
Caption = 'Echo string'
object lblSend: TLabel
Left = 8
Top = 24
Width = 96
Height = 16
Caption = 'Original string:'
end
object lblReturn: TLabel
Left = 8
Top = 144
Width = 93
Height = 16
Caption = 'Echoed string:'
end
object edtStrOrig: TEdit
Left = 8
Top = 40
Width = 225
Height = 24
TabOrder = 0
Text = 'Hello World!'
end
object edtStrRtrn: TEdit
Left = 8
Top = 160
Width = 225
Height = 24
ReadOnly = True
TabOrder = 1
end
object btnEchoString: TButton
Left = 8
Top = 88
Width = 225
Height = 25
Hint = 'XWB EXAMPLE ECHO STRING'
Caption = 'Execute RPC'
Default = True
ParentShowHint = False
ShowHint = True
TabOrder = 2
OnClick = btnEchoStringClick
end
object Memo1: TMemo
Left = 240
Top = 8
Width = 201
Height = 257
TabStop = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
Lines.Strings = (
'Uses TRPCBroker.Call method '
'to return a single string.'
''
'Original string passed in as '
'PType literal.'
''
'RPC: XWB EXAMPLE ECHO '
'STRING.'
''
'Return Value Type: SINGLE '
'VALUE.')
ParentColor = True
ParentFont = False
ReadOnly = True
TabOrder = 3
end
end
object TabSheet2: TTabSheet
Caption = 'Pass by reference'
object Label1: TLabel
Left = 8
Top = 24
Width = 70
Height = 16
Caption = 'Reference:'
end
object Label4: TLabel
Left = 8
Top = 144
Width = 40
Height = 16
Caption = 'Value:'
end
object edtReference: TEdit
Left = 8
Top = 40
Width = 225
Height = 24
TabOrder = 0
Text = '$HOROLOG'
end
object edtValue: TEdit
Left = 8
Top = 160
Width = 225
Height = 24
ReadOnly = True
TabOrder = 1
end
object btnPassByRef: TButton
Left = 8
Top = 88
Width = 225
Height = 25
Hint = 'XWB GET VARIABLE VALUE'
Caption = 'Execute RPC'
Default = True
ParentShowHint = False
ShowHint = True
TabOrder = 2
OnClick = btnPassByRefClick
end
object Memo2: TMemo
Left = 240
Top = 8
Width = 201
Height = 257
TabStop = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
Lines.Strings = (
'Uses TRPCBroker.strCall '
'method to return a single string.'
''
'Parameter passed in as PType '
'reference.'
''
'RPC: XWB GET VARIABLE '
'VALUE.'
''
'Return Value Type: SINGLE '
'VALUE.')
ParentColor = True
ParentFont = False
ReadOnly = True
TabOrder = 3
end
end
object TabSheet3: TTabSheet
Caption = 'Get list'
object Label5: TLabel
Left = 8
Top = 120
Width = 87
Height = 16
Caption = 'Returned list:'
end
object lstData: TListBox
Left = 8
Top = 136
Width = 225
Height = 129
ItemHeight = 16
TabOrder = 0
end
object btnGetList: TButton
Left = 8
Top = 88
Width = 225
Height = 25
Hint = 'XWB EXAMPLE GET LIST'
Caption = 'Execute RPC'
Default = True
ParentShowHint = False
ShowHint = True
TabOrder = 1
OnClick = btnGetListClick
end
object RadioButton1: TRadioButton
Left = 16
Top = 16
Width = 137
Height = 17
Caption = 'Number of lines'
Checked = True
TabOrder = 2
TabStop = True
end
object RadioButton2: TRadioButton
Left = 16
Top = 48
Width = 137
Height = 17
Caption = 'Kilobytes of data'
TabOrder = 3
end
object spnLines: TSpinEdit
Left = 160
Top = 16
Width = 65
Height = 26
MaxValue = 0
MinValue = 0
TabOrder = 4
Value = 50
end
object spnKbytes: TSpinEdit
Left = 160
Top = 48
Width = 65
Height = 26
MaxValue = 0
MinValue = 0
TabOrder = 5
Value = 32
end
object Memo3: TMemo
Left = 240
Top = 8
Width = 201
Height = 257
TabStop = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
Lines.Strings = (
'Uses TRPCBroker.Call method '
'to return several strings.'
''
'Two parameters passed in as '
'PType literal.'
''
'RPC: XWB EXAMPLE GET LIST.'
''
'Return Value Type: GLOBAL '
'ARRAY.'
''
'WORD WRAP ON field is True '
'to break appart call result into '
'separate Results strings instead '
'of one long Results[0] string.')
ParentColor = True
ParentFont = False
ReadOnly = True
TabOrder = 6
end
end
object TabSheet4: TTabSheet
Caption = 'WP Text'
object lblList: TLabel
Left = 8
Top = 56
Width = 177
Height = 17
AutoSize = False
Caption = 'REMOTE PROCEDURE file description:'
end
object btnWPText: TButton
Left = 8
Top = 16
Width = 225
Height = 25
Hint = 'XWB EXAMPLE WPTEXT'
Caption = 'Execute RPC'
Default = True
ParentShowHint = False
ShowHint = True
TabOrder = 0
OnClick = btnWPTextClick
end
object mmoText: TMemo
Left = 8
Top = 80
Width = 225
Height = 185
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 1
end
object Memo4: TMemo
Left = 240
Top = 8
Width = 201
Height = 257
TabStop = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
Lines.Strings = (
'Uses TRPCBroker.lstCall '
'method to return several strings.'
''
'No parameters are used in this '
'call.'
''
'RPC: XWB EXAMPLE WPTEXT.'
''
'Return Value Type: WORD '
'PROCESSING.'
''
'WORD WRAP ON field is False '
'to allow memo box to control '
'word wrapping as necessary.')
ParentColor = True
ParentFont = False
ReadOnly = True
TabOrder = 2
end
end
object TabSheet5: TTabSheet
Caption = 'Sort numbers'
object Label6: TLabel
Left = 8
Top = 120
Width = 87
Height = 16
Caption = 'Returned list:'
end
object Label7: TLabel
Left = 8
Top = 8
Width = 72
Height = 16
Caption = 'How many:'
end
object lblStatus: TLabel
Left = 8
Top = 56
Width = 57
Height = 16
Caption = 'lblStatus'
Visible = False
end
object lstSorted: TListBox
Left = 8
Top = 136
Width = 225
Height = 129
ItemHeight = 16
TabOrder = 0
end
object btnSortNum: TButton
Left = 8
Top = 88
Width = 225
Height = 25
Hint = 'XWB EXAMPLE SORT NUMBERS'
Caption = 'Execute RPC'
Default = True
ParentShowHint = False
ShowHint = True
TabOrder = 1
OnClick = btnSortNumClick
end
object spnNumbers: TSpinEdit
Left = 8
Top = 24
Width = 81
Height = 26
MaxValue = 10000
MinValue = 0
TabOrder = 2
Value = 500
end
object rgrDirection: TRadioGroup
Left = 104
Top = 8
Width = 121
Height = 65
Caption = 'Sort direction'
ItemIndex = 0
Items.Strings = (
'low -> high'
'high -> low')
TabOrder = 3
end
object Memo5: TMemo
Left = 240
Top = 88
Width = 201
Height = 177
TabStop = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentColor = True
ParentFont = False
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 4
end
object rgArrayType: TRadioGroup
Left = 240
Top = 8
Width = 185
Height = 65
Caption = 'Array Type'
ItemIndex = 0
Items.Strings = (
'Local'
'Global')
TabOrder = 5
OnClick = rgArrayTypeClick
end
end
end
object MainMenu1: TMainMenu
Left = 160
Top = 320
object mnuOptions: TMenuItem
Caption = '&Options'
object mnuOptOldConnectionOnly: TMenuItem
Action = actOldConnectionOnly
Caption = 'Old Connection Type Only'
end
object mnuOptBackwardCompatible: TMenuItem
Action = actBackwardCompatible
end
object mnuOptDebugMode: TMenuItem
Action = actDebugMode
end
object mnuOptUserContext: TMenuItem
Action = actUserContext
end
end
object mnuHelp: TMenuItem
Caption = '&Help'
object AboutExample: TMenuItem
Caption = '&About RPC Broker Example...'
OnClick = AboutExampleClick
end
end
end
object Timer1: TTimer
OnTimer = Timer1Timer
Left = 16
Top = 320
end
object ActionList1: TActionList
Left = 52
Top = 295
object actBackwardCompatible: TAction
Caption = '&Backward Compatible'
Checked = True
OnExecute = actBackwardCompatibleExecute
end
object actOldConnectionOnly: TAction
Caption = '&Old Connection Only'
OnExecute = actOldConnectionOnlyExecute
end
object actDebugMode: TAction
Caption = '&Debug Mode'
OnExecute = actDebugModeExecute
end
object actUserContext: TAction
Caption = '&CCOW User Context'
Checked = True
OnExecute = actUserContextExecute
end
end
object RPCBroker1: TCCOWRPCBroker
ClearParameters = True
ClearResults = True
Connected = False
ListenerPort = 9200
RpcVersion = '0'
Server = 'BROKERSERVER'
KernelLogIn = True
LogIn.Mode = lmAVCodes
LogIn.PromptDivision = False
OldConnectionOnly = False
Left = 108
Top = 327
end
end

View File

@ -0,0 +1,444 @@
{**************************************************
RPC Broker Example form ver. 1.1 9/3/97
Broker Development Team
San Francisco IRM Field Office, Dept. of Veterans Affairs
Disclaimer:
This example does not attempt to teach general Delphi and M programming.
We intentionally removed any safeguards from the code that prevents
passing values that are too small or too large. Therefore, the important
code remains uncluttered and the programmer is free to experiment and
push the program beyond its limits.
Purpose:
This sample application is an example of how to program client/server
applications in Delphi and M using the RPC Broker. The demonstrated features
include:
- Connecting to an M server
- Creating an application context
- Using the GetServerInfo function
- Displaying the VistA splash screen
- Setting the TRPCBroker Param property for each Param PType (literal,
reference, list)
- Calling RPCs with the Call method
- Calling RPCs with the lstCall and strCall methods
We encourage you to study the Delphi and M source code to see how the
Broker is used to accomplish these tasks. Try changing some of the
RPCBroker1 component properties to see what happens. Also, try other
values in the fields of the remote procedure records in the
REMOTE PROCEDURE file.
Warning: "Get list" and "Sort numbers" tabs can potentially take excessively
large data samples which can either crash server process or cause the
connection timeout. Final note, memory allocation errors are not recorded
in the Kernel error trap. They are recorded in the operating system error
trap.
Context option for this application:
XWB BROKER EXAMPLE
Remote procedures used:
XWB EXAMPLE ECHO STRING
XWB EXAMPLE GET LIST
XWB EXAMPLE SORT NUMBERS
XWB EXAMPLE WPTEXT
XWB GET VARIABLE VALUE
Server M routine:
XWBEXMPL
**************************************************}
unit fBrokerExampleCCOW;
interface
uses
SysUtils,Forms, StdCtrls,Graphics, Dialogs, WinTypes,
Controls, Classes, ExtCtrls, TRPCB, XWBut1, MFunStr, Menus, WinProcs,
RpcConf1, Spin, ComCtrls, fVistAAbout, Buttons,
ActiveX, ActnList, CCOWRPCBroker, OleCtrls, VERGENCECONTEXTORLib_TLB;
type
TfrmBrokerExampleCCOW = class(TForm)
GroupBox2: TGroupBox;
Label2: TLabel;
Label3: TLabel;
MainMenu1: TMainMenu;
mnuHelp: TMenuItem;
AboutExample: TMenuItem;
btnConnect: TButton;
edtPort: TEdit;
edtServer: TEdit;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
lblSend: TLabel;
edtStrOrig: TEdit;
lblReturn: TLabel;
edtStrRtrn: TEdit;
btnEchoString: TButton;
lblList: TLabel;
Label1: TLabel;
edtReference: TEdit;
Label4: TLabel;
edtValue: TEdit;
btnPassByRef: TButton;
lstData: TListBox;
Label5: TLabel;
btnGetList: TButton;
btnWPText: TButton;
Label6: TLabel;
lstSorted: TListBox;
btnSortNum: TButton;
spnNumbers: TSpinEdit;
Label7: TLabel;
rgrDirection: TRadioGroup;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
spnLines: TSpinEdit;
spnKbytes: TSpinEdit;
Timer1: TTimer;
mmoText: TMemo;
lblStatus: TLabel;
BitBtn1: TBitBtn;
btnGetServerInfo: TBitBtn;
Memo1: TMemo;
Memo2: TMemo;
Memo3: TMemo;
Memo4: TMemo;
Memo5: TMemo;
rgArrayType: TRadioGroup;
cbxBackwardCompatible: TCheckBox;
mnuOptions: TMenuItem;
mnuOptBackwardCompatible: TMenuItem;
mnuOptDebugMode: TMenuItem;
mnuOptUserContext: TMenuItem;
mnuOptOldConnectionOnly: TMenuItem;
ActionList1: TActionList;
actBackwardCompatible: TAction;
actOldConnectionOnly: TAction;
actDebugMode: TAction;
actUserContext: TAction;
RPCBroker1: TCCOWRPCBroker;
procedure AboutExampleClick(Sender: TObject);
procedure btnEchoStringClick(Sender: TObject);
procedure btnConnectClick(Sender: TObject);
procedure btnPassByRefClick(Sender: TObject);
procedure btnGetListClick(Sender: TObject);
procedure btnSortNumClick(Sender: TObject);
procedure btnWPTextClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure btnGetServerInfoClick(Sender: TObject);
procedure edtServerChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure rgArrayTypeClick(Sender: TObject);
procedure actBackwardCompatibleExecute(Sender: TObject);
procedure actDebugModeExecute(Sender: TObject);
procedure actUserContextExecute(Sender: TObject);
procedure actOldConnectionOnlyExecute(Sender: TObject);
public
procedure OnCCOWCommit(Sender: TObject); // CCOW related
procedure HandlePendingEvent(Sender: TObject; const aContextItemCollection:
IDispatch);
end;
var
frmBrokerExampleCCOW: TfrmBrokerExampleCCOW;
ContextorControl1: TContextorControl; // CCOW related
implementation
uses fOkToTerminate;
{$R *.DFM}
procedure TfrmBrokerExampleCCOW.btnEchoStringClick(Sender: TObject);
begin
RPCBroker1.RemoteProcedure := 'XWB EXAMPLE ECHO STRING';
RPCBroker1.Param[0].Value := edtStrOrig.Text;
RPCBroker1.Param[0].PType := literal;
RPCBroker1.Call; //execute RPC
edtStrRtrn.Text := RPCBroker1.Results[0]; //for single value use Results[0]
end;
procedure TfrmBrokerExampleCCOW.btnPassByRefClick(Sender: TObject);
begin
RPCBroker1.RemoteProcedure := 'XWB GET VARIABLE VALUE';
RPCBroker1.Param[0].Value := edtReference.Text;
RPCBroker1.Param[0].PType := reference;
edtValue.Text := RPCBroker1.strCall; //execute RPC and show result in one call
end;
procedure TfrmBrokerExampleCCOW.btnGetListClick(Sender: TObject);
begin
RPCBroker1.RemoteProcedure := 'XWB EXAMPLE GET LIST';
if RadioButton1.Checked then begin
RPCBroker1.Param[0].Value := 'LINES';
RPCBroker1.Param[0].PType := literal;
RPCBroker1.Param[1].Value := IntToStr(spnLines.Value);
RPCBroker1.Param[1].PType := literal;
end
else begin
RPCBroker1.Param[0].Value := 'KILOBYTES';
RPCBroker1.Param[0].PType := literal;
RPCBroker1.Param[1].Value := IntToStr(spnKbytes.Value);
RPCBroker1.Param[1].PType := literal
end;
RPCBroker1.Call; //execute RPC
lstData.Items := RPCBroker1.Results; //show results of the call
end;
procedure TfrmBrokerExampleCCOW.btnWPTextClick(Sender: TObject);
begin
RPCBroker1.RemoteProcedure := 'XWB EXAMPLE WPTEXT';
RPCBroker1.lstCall(mmoText.Lines); //execute RPC and show results in one call
end;
procedure TfrmBrokerExampleCCOW.btnSortNumClick(Sender: TObject);
var
I, SaveRPCTimeLimit, DefaultRange: integer;
begin
lblStatus.Visible := True; //turn on status label
lblStatus.Caption := 'building'; //tell user what's happenning
Application.ProcessMessages; //give Windows chance to paint
with RPCBroker1 do
begin
if rgArrayType.ItemIndex = 0 then
begin
RemoteProcedure := 'XWB EXAMPLE SORT NUMBERS';
DefaultRange := 10000;
end
else
begin
RemoteProcedure := 'XWB EXAMPLE GLOBAL SORT';
DefaultRange := 100000;
end;
if rgrDirection.ItemIndex = 0 then Param[0].Value := 'LO'
else Param[0].Value := 'HI';
Param[0].PType := literal;
with Param[1] do begin
if rgArrayType.ItemIndex = 0 then
PType := list //tells Broker to pass Mult
else
PType := global;
for I := 0 to spnNumbers.Value - 1 do //build Mult one by one
Mult['"A'+IntToStr(I)+'"'] := IntToStr(Random(DefaultRange)+1); //subscript and value are strings!
end;
lblStatus.Caption := 'RPC running';
Application.ProcessMessages; //give Windows chance to paint
SaveRPCTimeLimit := RPCTimeLimit;
RPCTimeLimit := spnNumbers.Value div 10; //adjust in case a lot of numbers
Call; //execute RPC
lstSorted.Items := Results; //show results of the call
RPCTimeLimit := SaveRPCTimeLimit; //restore original value
end;
lblStatus.Visible := False; //turn off status label
end;
procedure TfrmBrokerExampleCCOW.btnConnectClick(Sender: TObject);
begin
if btnConnect.Caption = '&Connect' then
begin //connect
RpcBroker1.IsBackwardCompatibleConnection := actBackwardCompatible.Checked;
RpcBroker1.OldConnectionOnly := actOldConnectionOnly.Checked;
RpcBroker1.DebugMode := actDebugMode.Checked;
if RpcBroker1.IsBackwardCompatibleConnection or RpcBroker1.OldConnectionOnly then
begin
rgArrayType.ItemIndex := 0;
rgArrayType.Enabled := False;
end
else
begin
rgArrayType.Enabled := True;
end;
// *********************** CCOW User Context ****************************
if actUserContext.Checked then
begin
if (RPCBroker1.Contextor = nil) then
begin
if ContextorControl1 = nil then
begin
ContextorControl1 := TContextorControl.Create(Self);
ContextorControl1.OnCommitted := OnCCOWCommit;
ContextorControl1.OnPending := HandlePendingEvent;
try
ContextorControl1.Run('CCOWTerm#', '', TRUE, '*');
except
ShowMessage('Problem with Contextor.Run');
ContextorControl1.Free;
ContextorControl1 := nil;
end;
end;
end;
RPCBroker1.Contextor := ContextorControl1;
end
else
RPCBroker1.Contextor := nil;
// *********************** End CCOW User Context *************************
RPCBroker1.ClearParameters := True; //try False, see what happens
try
RPCBroker1.Connected := True;
//establish connection
if not RPCBroker1.CreateContext('XWB BROKER EXAMPLE') then
ShowMessage('Context could not be created!');
except
on e: Exception do
ShowMessage('Error: ' + e.Message);
end;
end
else //disconnect
RPCBroker1.Connected := False;
end;
procedure TfrmBrokerExampleCCOW.btnGetServerInfoClick(Sender: TObject);
var
strServer, strPort: string;
begin
if GetServerInfo(strServer, strPort)<> mrCancel then
begin {getsvrinfo}
edtServer.Text := strServer; //use chosen server
edtPort.Text := strPort; //use chosen port
end;
end;
procedure TfrmBrokerExampleCCOW.edtServerChange(Sender: TObject);
begin
RPCBroker1.Server := edtServer.Text; //use specified server name/addr
RPCBroker1.ListenerPort := StrToInt(edtPort.Text); //use specified port
end;
procedure TfrmBrokerExampleCCOW.Timer1Timer(Sender: TObject);
begin
if RPCBroker1.Connected then begin
btnConnect.Caption := '&Disconnect';
btnConnect.Default := False;
mnuOptions.Enabled := False;
cbxBackwardCompatible.Enabled := False;
Label3.Caption := 'Connected';
Label3.Font.Color := clLime; // clGreen; // went to lime for higher contrast at some of the High contrast desktops
end
else begin
btnConnect.Caption := '&Connect';
btnConnect.Default := True;
mnuOptions.Enabled := True;
if not actOldConnectionOnly.Checked then
cbxBackwardCompatible.Enabled := True;
Label3.Caption := 'Disconnected';
Label3.Font.Color := clRed; // Stayed with Red, generated a high contrast across all of the various combinations
// Attempted to use clHighlight, but it did not show up like a highlight.
end;
end;
procedure TfrmBrokerExampleCCOW.AboutExampleClick(Sender: TObject);
begin
ShowAboutBox;
end;
procedure TfrmBrokerExampleCCOW.FormCreate(Sender: TObject);
begin
CoInitialize(nil); // needed for CCOW
end;
procedure TfrmBrokerExampleCCOW.rgArrayTypeClick(Sender: TObject);
begin
if rgArrayType.ItemIndex = 0 then
spnNumbers.Value := 500
else
spnNumbers.Value := 5000;
end;
procedure TfrmBrokerExampleCCOW.actBackwardCompatibleExecute(Sender: TObject);
begin
if actBackwardCompatible.Checked then
actBackwardCompatible.Checked := False
else
actBackwardCompatible.Checked := True;
end;
procedure TfrmBrokerExampleCCOW.actDebugModeExecute(Sender: TObject);
begin
if actDebugMode.Checked then
actDebugMode.Checked := False
else
actDebugMode.Checked := True;
end;
procedure TfrmBrokerExampleCCOW.actUserContextExecute(Sender: TObject);
begin
if actuserContext.Checked then
actUserContext.Checked := False
else
actUserContext.Checked := True;
end;
procedure TfrmBrokerExampleCCOW.actOldConnectionOnlyExecute(Sender: TObject);
begin
if actOldConnectionOnly.Checked then
begin
actOldConnectionOnly.Checked := False;
actBackwardCompatible.Enabled := True;
end
else
begin
actOldConnectionOnly.Checked := True;
actBackwardCompatible.Enabled := False;
end;
end;
procedure TfrmBrokerExampleCCOW.OnCCOWCommit(Sender: TObject);
begin
if RpcBroker1.WasUserDefined and RpcBroker1.IsUserCleared then
Halt;
end;
procedure TfrmBrokerExampleCCOW.HandlePendingEvent(Sender: TObject; const
aContextItemCollection: IDispatch);
var
data : IContextItemCollection;
begin
data := IContextItemCollection(aContextItemCollection) ;
if RPCBroker1.IsUserContextPending(data) then
begin
frmOkToTerminate := TfrmOkToTerminate.Create(Self);
try
if not (frmOkToTerminate.ShowModal = mrOK) then
ContextorControl1.SetSurveyResponse('No Way');
finally
frmOkToTerminate.Free;
end;
end;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,267 @@
unit fVistAAbout;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, jpeg, jconsts, Dialogs;
TYPE
TInteger8 = Int64;
type
TfrmVistAAbout = class(TForm)
Panel1: TPanel;
VistaLogo: TImage;
lblProductName: TLabel;
lblVersion: TLabel;
lblGovStatement: TLabel;
OKButton: TButton;
lblCRC: TLabel;
Memo1: TMemo;
lblDate: TLabel;
ProgramIcon: TImage;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure getfileinfo(var Version: String; var ProductName: String); virtual;
end;
procedure ShowAboutBox;
implementation
{$R *.DFM}
CONST
table: ARRAY[0..255] OF DWORD =
($00000000, $77073096, $EE0E612C, $990951BA,
$076DC419, $706AF48F, $E963A535, $9E6495A3,
$0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
$09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
$1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
$1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
$136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
$14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
$3B6E20C8, $4C69105E, $D56041E4, $A2677172,
$3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
$35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940,
$32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
$26D930AC, $51DE003A, $C8D75180, $BFD06116,
$21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
$2802B89E, $5F058808, $C60CD9B2, $B10BE924,
$2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
$76DC4190, $01DB7106, $98D220BC, $EFD5102A,
$71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
$7807C9A2, $0F00F934, $9609A88E, $E10E9818,
$7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
$6B6B51F4, $1C6C6162, $856530D8, $F262004E,
$6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
$65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C,
$62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
$4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
$4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
$4369E96A, $346ED9FC, $AD678846, $DA60B8D0,
$44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
$5005713C, $270241AA, $BE0B1010, $C90C2086,
$5768B525, $206F85B3, $B966D409, $CE61E49F,
$5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4,
$59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
$EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
$EAD54739, $9DD277AF, $04DB2615, $73DC1683,
$E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
$E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
$F00F9344, $8708A3D2, $1E01F268, $6906C2FE,
$F762575D, $806567CB, $196C3671, $6E6B06E7,
$FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC,
$F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
$D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252,
$D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
$D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
$DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
$CB61B38C, $BC66831A, $256FD2A0, $5268E236,
$CC0C7795, $BB0B4703, $220216B9, $5505262F,
$C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
$C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
$9B64C2B0, $EC63F226, $756AA39C, $026D930A,
$9C0906A9, $EB0E363F, $72076785, $05005713,
$95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38,
$92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
$86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E,
$81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
$88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
$8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
$A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
$A7672661, $D06016F7, $4969474D, $3E6E77DB,
$AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
$A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
$BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
$BAD03605, $CDD70693, $54DE5729, $23D967BF,
$B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
$B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
// Use CalcCRC32 as a procedure so CRCValue can be passed in but
// also returned. This allows multiple calls to CalcCRC32 for
// the "same" CRC-32 calculation.
PROCEDURE CalcCRC32 (p: pointer; ByteCount: DWORD; VAR CRCValue: DWORD);
// The following is a little cryptic (but executes very quickly).
// The algorithm is as follows:
// 1. exclusive-or the input byte with the low-order byte of
// the CRC register to get an INDEX
// 2. shift the CRC register eight bits to the right
// 3. exclusive-or the CRC register with the contents of
// Table[INDEX]
// 4. repeat steps 1 through 3 for all bytes
VAR
i: DWORD;
q: ^BYTE;
BEGIN
q := p;
FOR i := 0 TO ByteCount-1 DO BEGIN
CRCvalue := (CRCvalue SHR 8) XOR
Table[ q^ XOR (CRCvalue AND $000000FF) ];
INC(q)
END
END {CalcCRC32};
// The CRC-32 value calculated here matches the one from the PKZIP program.
// Use MemoryStream to read file in binary mode.
PROCEDURE CalcFileCRC32 (FromName: STRING; VAR CRCvalue: DWORD;
VAR TotalBytes: TInteger8;
VAR error: WORD);
VAR
Stream: TMemoryStream;
BEGIN
error := 0;
CRCValue := $FFFFFFFF;
Stream := TMemoryStream.Create;
TRY
TRY
Stream.LoadFromFile(FromName);
IF Stream.Size > 0
THEN CalcCRC32 (Stream.Memory, Stream.Size, CRCvalue)
EXCEPT
ON E: EReadError DO
error := 1
END;
CRCvalue := NOT CRCvalue;
TotalBytes := Stream.Size
FINALLY
Stream.Free
END;
END {CalcFileCRC32};
procedure TfrmVistAAbout.FormCreate(Sender: TObject);
var
CRC32: DWord;
TotalBytes: Int64;
Error: Word;
Text: String;
Version: String;
ProductName: String;
begin
CalcFileCRC32(Application.ExeName, CRC32, TotalBytes, Error);
lblCRC.Caption := 'CRC: ' + IntToHex(CRC32,8);
Text := Application.ExeName;
while pos('\',Text) > 0 do
begin
Text := copy(Text,pos('\',Text)+1,Length(Text));
end; // while
Text := copy(Text,1,Length(Text)-4);
Caption := 'About ' + Text;
getfileinfo(Version, ProductName);
lblProductName.Caption := ProductName;
lblVersion.Caption := 'Version: ' + Version;
lblProductName.Width := Panel1.Width-10;
lblGovStatement.Width := Panel1.Width-10;
if ProgramIcon.Picture.Graphic = nil then
begin
VistALogo.Left := (Panel1.Width - VistALogo.Width) div 2;
end;
end;
procedure TfrmVistAAbout.GetFileInfo(var Version: String; var ProductName: String);
var
VerInfoSize: DWORD; // holds the size of the version info resource
GetInfoSizeJunk: DWORD; // a junk variable, its value is ignored
VersionInfo: Pointer; // points to the version info resource
Translation: Pointer; // holds version info translation table
InfoPointer: Pointer; // a pointer to version information
VersionInfoSize: UINT; // holds the size of version information
VersionValue: string; // holds the version info request string
SearchRec: TSearchRec;
DateTimeVal: TDateTime;
WriteTime: Integer;
begin
{retrieve the size of the version information resource, if one exists}
VerInfoSize := GetFileVersionInfoSize(PChar(Application.ExeName),
GetInfoSizeJunk);
{if there was a version information resource available...}
if VerInfoSize>0 then
begin
{retrieve enough memory to hold the version resource}
GetMem(VersionInfo, VerInfoSize);
{retrieve the version resource for the selected file}
GetFileVersionInfo(PChar(Application.ExeName), 0,
VerInfoSize, VersionInfo);
{retrieve a pointer to the translation table}
VerQueryValue(VersionInfo, '\\VarFileInfo\\Translation',
Translation, VersionInfoSize);
{initialize the version value request string}
VersionValue :='\\StringFileInfo\\'+
IntToHex(LoWord(LongInt(Translation^)),4)+
IntToHex(HiWord(LongInt(Translation^)),4)+
'\\';
{retrieve and display the file version}
VerQueryValue(VersionInfo, PChar(VersionValue+'FileVersion'), InfoPointer,
VersionInfoSize);
Version := string(PChar(InfoPointer));
{retrieve and display the product name}
VerQueryValue(VersionInfo, PChar(VersionValue+'ProductName'), InfoPointer,
VersionInfoSize);
ProductName := string(PChar(InfoPointer));
{free the version resource memory}
FreeMem(VersionInfo, VerInfoSize);
end
else
begin
Version := 'Not in File';
ProductName := 'Not Identified In File';
end;
if findfirst(Application.ExeName, faAnyFile, SearchRec) = 0 then
begin
WriteTime := SearchRec.Time;
DateTimeVal := FileDateToDateTime(WriteTime);
lblDate.Caption := FormatDateTime('mmmm dd, yyyy hh:nn',DateTimeVal);
end;
end;
procedure ShowAboutBox;
begin
with TfrmVistAAbout.Create(Application) do
try
ShowModal;
finally
free;
end;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,267 @@
unit frmVistAAbout;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, jpeg, jconsts, Dialogs;
TYPE
TInteger8 = Int64;
type
TfrmVistAAbout = class(TForm)
Panel1: TPanel;
VistaLogo: TImage;
lblProductName: TLabel;
lblVersion: TLabel;
lblGovStatement: TLabel;
OKButton: TButton;
lblCRC: TLabel;
Memo1: TMemo;
lblDate: TLabel;
ProgramIcon: TImage;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure getfileinfo(var Version: String; var ProductName: String); virtual;
end;
procedure ShowAboutBox;
implementation
{$R *.DFM}
CONST
table: ARRAY[0..255] OF DWORD =
($00000000, $77073096, $EE0E612C, $990951BA,
$076DC419, $706AF48F, $E963A535, $9E6495A3,
$0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
$09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
$1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
$1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
$136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
$14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
$3B6E20C8, $4C69105E, $D56041E4, $A2677172,
$3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
$35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940,
$32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
$26D930AC, $51DE003A, $C8D75180, $BFD06116,
$21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
$2802B89E, $5F058808, $C60CD9B2, $B10BE924,
$2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
$76DC4190, $01DB7106, $98D220BC, $EFD5102A,
$71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
$7807C9A2, $0F00F934, $9609A88E, $E10E9818,
$7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
$6B6B51F4, $1C6C6162, $856530D8, $F262004E,
$6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
$65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C,
$62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
$4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
$4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
$4369E96A, $346ED9FC, $AD678846, $DA60B8D0,
$44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
$5005713C, $270241AA, $BE0B1010, $C90C2086,
$5768B525, $206F85B3, $B966D409, $CE61E49F,
$5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4,
$59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
$EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
$EAD54739, $9DD277AF, $04DB2615, $73DC1683,
$E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
$E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
$F00F9344, $8708A3D2, $1E01F268, $6906C2FE,
$F762575D, $806567CB, $196C3671, $6E6B06E7,
$FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC,
$F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
$D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252,
$D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
$D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
$DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
$CB61B38C, $BC66831A, $256FD2A0, $5268E236,
$CC0C7795, $BB0B4703, $220216B9, $5505262F,
$C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
$C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
$9B64C2B0, $EC63F226, $756AA39C, $026D930A,
$9C0906A9, $EB0E363F, $72076785, $05005713,
$95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38,
$92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
$86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E,
$81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
$88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
$8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
$A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
$A7672661, $D06016F7, $4969474D, $3E6E77DB,
$AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
$A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
$BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
$BAD03605, $CDD70693, $54DE5729, $23D967BF,
$B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
$B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
// Use CalcCRC32 as a procedure so CRCValue can be passed in but
// also returned. This allows multiple calls to CalcCRC32 for
// the "same" CRC-32 calculation.
PROCEDURE CalcCRC32 (p: pointer; ByteCount: DWORD; VAR CRCValue: DWORD);
// The following is a little cryptic (but executes very quickly).
// The algorithm is as follows:
// 1. exclusive-or the input byte with the low-order byte of
// the CRC register to get an INDEX
// 2. shift the CRC register eight bits to the right
// 3. exclusive-or the CRC register with the contents of
// Table[INDEX]
// 4. repeat steps 1 through 3 for all bytes
VAR
i: DWORD;
q: ^BYTE;
BEGIN
q := p;
FOR i := 0 TO ByteCount-1 DO BEGIN
CRCvalue := (CRCvalue SHR 8) XOR
Table[ q^ XOR (CRCvalue AND $000000FF) ];
INC(q)
END
END {CalcCRC32};
// The CRC-32 value calculated here matches the one from the PKZIP program.
// Use MemoryStream to read file in binary mode.
PROCEDURE CalcFileCRC32 (FromName: STRING; VAR CRCvalue: DWORD;
VAR TotalBytes: TInteger8;
VAR error: WORD);
VAR
Stream: TMemoryStream;
BEGIN
error := 0;
CRCValue := $FFFFFFFF;
Stream := TMemoryStream.Create;
TRY
TRY
Stream.LoadFromFile(FromName);
IF Stream.Size > 0
THEN CalcCRC32 (Stream.Memory, Stream.Size, CRCvalue)
EXCEPT
ON E: EReadError DO
error := 1
END;
CRCvalue := NOT CRCvalue;
TotalBytes := Stream.Size
FINALLY
Stream.Free
END;
END {CalcFileCRC32};
procedure TfrmVistAAbout.FormCreate(Sender: TObject);
var
CRC32: DWord;
TotalBytes: Int64;
Error: Word;
Text: String;
Version: String;
ProductName: String;
begin
CalcFileCRC32(Application.ExeName, CRC32, TotalBytes, Error);
lblCRC.Caption := 'CRC: ' + IntToHex(CRC32,8);
Text := Application.ExeName;
while pos('\',Text) > 0 do
begin
Text := copy(Text,pos('\',Text)+1,Length(Text));
end; // while
Text := copy(Text,1,Length(Text)-4);
Caption := 'About ' + Text;
getfileinfo(Version, ProductName);
lblProductName.Caption := ProductName;
lblVersion.Caption := 'Version: ' + Version;
lblProductName.Width := Panel1.Width-10;
lblGovStatement.Width := Panel1.Width-10;
if ProgramIcon.Picture.Graphic = nil then
begin
VistALogo.Left := (Panel1.Width - VistALogo.Width) div 2;
end;
end;
procedure TfrmVistAAbout.GetFileInfo(var Version: String; var ProductName: String);
var
VerInfoSize: DWORD; // holds the size of the version info resource
GetInfoSizeJunk: DWORD; // a junk variable, its value is ignored
VersionInfo: Pointer; // points to the version info resource
Translation: Pointer; // holds version info translation table
InfoPointer: Pointer; // a pointer to version information
VersionInfoSize: UINT; // holds the size of version information
VersionValue: string; // holds the version info request string
SearchRec: TSearchRec;
DateTimeVal: TDateTime;
WriteTime: Integer;
begin
{retrieve the size of the version information resource, if one exists}
VerInfoSize := GetFileVersionInfoSize(PChar(Application.ExeName),
GetInfoSizeJunk);
{if there was a version information resource available...}
if VerInfoSize>0 then
begin
{retrieve enough memory to hold the version resource}
GetMem(VersionInfo, VerInfoSize);
{retrieve the version resource for the selected file}
GetFileVersionInfo(PChar(Application.ExeName), 0,
VerInfoSize, VersionInfo);
{retrieve a pointer to the translation table}
VerQueryValue(VersionInfo, '\\VarFileInfo\\Translation',
Translation, VersionInfoSize);
{initialize the version value request string}
VersionValue :='\\StringFileInfo\\'+
IntToHex(LoWord(LongInt(Translation^)),4)+
IntToHex(HiWord(LongInt(Translation^)),4)+
'\\';
{retrieve and display the file version}
VerQueryValue(VersionInfo, PChar(VersionValue+'FileVersion'), InfoPointer,
VersionInfoSize);
Version := string(PChar(InfoPointer));
{retrieve and display the product name}
VerQueryValue(VersionInfo, PChar(VersionValue+'ProductName'), InfoPointer,
VersionInfoSize);
ProductName := string(PChar(InfoPointer));
{free the version resource memory}
FreeMem(VersionInfo, VerInfoSize);
end
else
begin
Version := 'Not in File';
ProductName := 'Not Identified In File';
end;
if findfirst(Application.ExeName, faAnyFile, SearchRec) = 0 then
begin
WriteTime := SearchRec.Time;
DateTimeVal := FileDateToDateTime(WriteTime);
lblDate.Caption := FormatDateTime('mmmm dd, yyyy hh:nn',DateTimeVal);
end;
end;
procedure ShowAboutBox;
begin
with TfrmVistAAbout.Create(Application) do
try
ShowModal;
finally
free;
end;
end;
end.

View File

@ -0,0 +1,9 @@
The SilentSignOn(p13) directory under Samples contains four (4) sample programs that illustrate different aspects of patch XWB*1.1*13. Source code is included for each of these programs.
The program XWBAppHandle1 is used to illustrate the use of the StartProgSLogin method in the RpcSLogin unit. This method is used to launch a second program (XWBAppHandle2) with a silent login using an AppHandle obtained from the server. The AppHandle and information about the server, listener port, and Division are passed on the command line when XWBAppHandle2 is launched. The StartProgSLogin method can also can be used to launch a non-RPCBroker related program and this can be demonstrated by entering the name of a program, and command line arguments if any, in an edit box prior to clicking the Start App2 button. This will launch the specified program without including any broker related arguments on the command line.
The program XWBAppHandle2 is used to illustrate the use of the GetCmdLine method in the RpcSLogin unit. This method identifies command line arguments related to the RPCBroker (identified by p=, s=, h=, and d= for listener port, server, AppHandle, and Division, respectively). If the arguments include an AppHandle, the connection to the server is attempted as well. This application will display information about the user logged into the server. If an attempt is made to start the application manually, a message box is displayed asking whether the user wants to login manually. If the response is 'OK' the normal RPCBroker login screen is shown. If the response is 'Cancel' the application terminates.
The program XWBAVCodes is used to illustrate a silent login in which the Access and Verify codes are provided by the program, as opposed to being entered in the RPCBroker login screen.
The program XWBOnFail is used to illustrate the different types of error handling which are available in patch XWB*1.1*13. These include permitting the application to handle errors via a specified procedure call, to showing normal errors, to simply providing the error message for the application to examine while otherwise ignoring errors completely.

View File

@ -0,0 +1,82 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=Vcl50;Vclx50;Vcldb50;Vclbde50;VclSmp50;vclado50;ibevnt50;vcldbx50;Qrpt50;TeeUI50;TeeDB50;Tee50;Dss50;TeeQR50;VCLIB50;Vclmid50;vclie50;Inetdb50;Inet50;NMFast50;webmid50;dclocx50;dclaxserver50;JLITestFDE;Rz252N50;Rz252D50;CS20Comps50;CSP20I50;gmunitsd5;gmctrlsd5;gmchrtedd5;gmdaouid5;GMDaod5;gmdbgend5;gmdbctrld5;gmadouid5;GMAdod5;democomponentsd5;Speech;Indy50;vclPerfUtils5;SharedRPCBroker_R50;XWB_R50;TMSColList;osg5220;osdg5220;CPRSctrls_50;KeaBroker_R50;ZipMasterD5;ICSDEL50;TCynthesisAppUpdateD5;Fmdc_R50;CodeRush50;CR_FormPopupFix50;CR_Standard50;Aruser;XUtilsR50;XUDT_R50;XU_R50
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Language]
ActiveLang=
ProjectLang=$00000409
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=1
MajorVer=1
MinorVer=1
Release=31
Build=8
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=Dept of Veteran Affairs, VHA, OI, SD&D, IIS
FileDescription=Sample Silent Login with lmAVCodes
FileVersion=1.1.31.8
InternalName=a
LegalCopyright=(c) 2002
LegalTrademarks=
OriginalFilename=
ProductName=XWBAVCodes
ProductVersion=1.1.31.0
Comments=

View File

@ -0,0 +1,15 @@
program XWBAVCodes;
uses
Forms,
fXWBAVCodes in 'fXWBAVCodes.pas' {Form1},
frmVistAAbout in 'frmVistAAbout.pas' {frmVistAAbout};
{$R *.RES}
begin
Application.Initialize;
Application.Title := 'Test4Silent';
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,82 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Language]
ActiveLang=
ProjectLang=$00000409
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=1
MajorVer=1
MinorVer=1
Release=31
Build=8
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=Dept. of Veteran Affairs, VHA, OI, SD&D, IIS
FileDescription=Example program launching another program using the lmAppHandle silent login
FileVersion=1.1.31.8
InternalName=
LegalCopyright=(c) 2002
LegalTrademarks=
OriginalFilename=
ProductName=XWBAppHandle1
ProductVersion=1.1.31.0
Comments=

View File

@ -0,0 +1,13 @@
program XWBAppHandle1;
uses
Forms,
fXWBAppHandle1 in 'fXWBAppHandle1.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,82 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Language]
ActiveLang=
ProjectLang=$00000409
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=1
MajorVer=1
MinorVer=1
Release=31
Build=9
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=Dept. of Veteran Affairs, VHA, OI, SD&D, IIS
FileDescription=Example program of starting an application using an AppHandle token
FileVersion=1.1.31.9
InternalName=
LegalCopyright=(c) 2002
LegalTrademarks=
OriginalFilename=
ProductName=XWBAppHandle2
ProductVersion=1.1.31.0
Comments=

View File

@ -0,0 +1,13 @@
program XWBAppHandle2;
uses
Forms,
fXWBAppHandle2 in 'fXWBAppHandle2.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,82 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Language]
ActiveLang=
ProjectLang=$00000409
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=1
MajorVer=1
MinorVer=1
Release=31
Build=7
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=Dept of Veteran Affairs, VHA, OI, SD&D, IIS
FileDescription=Example of available error handling mechanisms for RPCBroker
FileVersion=1.1.31.7
InternalName=
LegalCopyright=(c) 2002
LegalTrademarks=
OriginalFilename=
ProductName=XWBOnFail
ProductVersion=1.1.31.0
Comments=

View File

@ -0,0 +1,13 @@
program XWBOnFail;
uses
Forms,
fXWBOnFail in 'fXWBOnFail.pas' {frmXWBOnFail};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TfrmXWBOnFail, frmXWBOnFail);
Application.Run;
end.

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,231 @@
object Form1: TForm1
Left = 190
Top = 138
Width = 662
Height = 393
Caption =
'XWBAVCodes - UCX RPCBroker BackwardsCompatible - Silent Login wi' +
'th lmAVCodes (P40)'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = True
PixelsPerInch = 96
TextHeight = 13
object lblAccessCode: TLabel
Left = 24
Top = 71
Width = 79
Height = 13
Caption = 'Access Code:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object lblVerifyCode: TLabel
Left = 24
Top = 96
Width = 70
Height = 13
Caption = 'Verify Code:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object lblDUZ: TLabel
Left = 48
Top = 176
Width = 26
Height = 13
Caption = 'DUZ:'
end
object lblName: TLabel
Left = 48
Top = 216
Width = 31
Height = 13
Caption = 'Name:'
end
object lblDTime: TLabel
Left = 48
Top = 256
Width = 34
Height = 13
Caption = 'DTime:'
end
object lblUserName: TLabel
Left = 48
Top = 288
Width = 56
Height = 13
Caption = 'User Name:'
end
object lblServer: TLabel
Left = 24
Top = 21
Width = 42
Height = 13
Caption = 'Server:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object lblListenerPort: TLabel
Left = 24
Top = 46
Width = 73
Height = 13
Caption = 'ListenerPort:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object edtDUZ: TEdit
Left = 112
Top = 168
Width = 233
Height = 21
TabOrder = 3
end
object edtName: TEdit
Left = 112
Top = 208
Width = 233
Height = 21
TabOrder = 2
end
object edtDTime: TEdit
Left = 112
Top = 248
Width = 233
Height = 21
TabOrder = 1
end
object edtUserName: TEdit
Left = 112
Top = 280
Width = 233
Height = 21
TabOrder = 0
end
object btnConnect: TButton
Left = 175
Top = 128
Width = 75
Height = 25
Caption = 'Connect'
Default = True
TabOrder = 8
OnClick = btnConnectClick
end
object edtAccessCode: TEdit
Left = 112
Top = 66
Width = 249
Height = 21
PasswordChar = '*'
TabOrder = 6
end
object edtVerifyCode: TEdit
Left = 112
Top = 91
Width = 249
Height = 21
PasswordChar = '*'
TabOrder = 7
end
object btnExit: TButton
Left = 174
Top = 312
Width = 75
Height = 25
Caption = 'Exit'
TabOrder = 9
OnClick = btnExitClick
end
object edtServer: TEdit
Left = 112
Top = 16
Width = 249
Height = 21
TabOrder = 4
end
object edtListenerPort: TEdit
Left = 112
Top = 41
Width = 105
Height = 21
TabOrder = 5
end
object Memo1: TMemo
Left = 384
Top = 16
Width = 241
Height = 233
Lines.Strings = (
'This application provides an '
'example of a silent login. The '
'server, Listener Port, Access '
'Code, and Verify Code need to '
'be filled in - these data would '
'be supplied in some manner for '
'a silent login (Division can also '
'be supplied for a multidivision '
'individual). After fillng in the '
'information enter Return or '
'click on the Connect button. '
'The connection should be '
'made without the broker login '
'form appearing. User '
'information will be filled in for '
'the logged in user.')
TabOrder = 10
end
object brkrRPCB: TRPCBroker
ClearParameters = True
ClearResults = True
Connected = False
ListenerPort = 9200
RpcVersion = '0'
Server = 'DHCPSERVER'
KernelLogIn = True
LogIn.Mode = lmAVCodes
LogIn.PromptDivision = False
Left = 16
Top = 312
end
object MainMenu1: TMainMenu
Left = 24
Top = 144
object mnuFile: TMenuItem
Caption = '&File'
object mnuFileExit: TMenuItem
Caption = 'E&xit'
OnClick = mnuFileExitClick
end
end
object mnuHelp: TMenuItem
Caption = '&Help'
object mnuHelpAbout: TMenuItem
Caption = '&About'
OnClick = mnuHelpAboutClick
end
end
end
end

View File

@ -0,0 +1,129 @@
unit fXWBAVCodes;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Trpcb, RpcSLogin, Menus, frmVistAAbout;
type
TForm1 = class(TForm)
edtDUZ: TEdit;
edtName: TEdit;
edtDTime: TEdit;
edtUserName: TEdit;
btnConnect: TButton;
edtAccessCode: TEdit;
edtVerifyCode: TEdit;
lblAccessCode: TLabel;
lblVerifyCode: TLabel;
btnExit: TButton;
lblDUZ: TLabel;
lblName: TLabel;
lblDTime: TLabel;
lblUserName: TLabel;
edtServer: TEdit;
edtListenerPort: TEdit;
lblServer: TLabel;
lblListenerPort: TLabel;
Memo1: TMemo;
MainMenu1: TMainMenu;
mnuFile: TMenuItem;
mnuFileExit: TMenuItem;
mnuHelp: TMenuItem;
mnuHelpAbout: TMenuItem;
brkrRPCB: TRPCBroker;
procedure btnConnectClick(Sender: TObject);
procedure btnExitClick(Sender: TObject);
procedure mnuFileExitClick(Sender: TObject);
procedure mnuHelpAboutClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Login: TVistaLogin;
implementation
{$R *.DFM}
procedure TForm1.btnConnectClick(Sender: TObject);
var
NChars: Cardinal;
NameBuffer: PChar;
begin
if btnConnect.Caption = 'Connect' then
begin
{ check data there for silent login }
if (edtAccessCode.Text = '') or
(edtVerifyCode.Text = '') or
(edtServer.Text = '') or
(edtListenerPort.Text = '') then
ShowMessage('The four Bold edit boxes must be filled in before the connection can be made.')
else
begin
{ set up for silent login }
with BrkrRPCB do
begin
Login.AccessCode := edtAccessCode.Text;
Login.VerifyCode := edtVerifyCode.Text;
Server := edtServer.Text;
ListenerPort := StrToInt(edtListenerPort.Text);
KernelLogin := False;
Login.Mode := lmAVCodes;
Login.PromptDivision := True;
Connected := True;
if Connected = True then
begin
GetUserInfo(brkrRPCB);
edtDUZ.Text := User.DUZ;
edtName.Text := User.Name;
edtDTime.Text := User.DTime;
{ Get local username as well }
NChars := 0;
GetUserName(nil,NChars);
NameBuffer := StrAlloc(NChars);
if GetUserName(NameBuffer, NChars) then
edtUserName.Text := StrPas(NameBuffer)
else
edtUserName.Text := 'Can''t get name';
btnConnect.Caption := 'Disconnect';
btnExit.Default := True;
btnConnect.Default := False;
end; // if Connected = True
end; // with brkrRPCB do
end; // else
end // if btnConnect.Caption
else
begin
brkrRPCB.Connected := False;
btnConnect.Caption := 'Connect';
end;
edtAccessCode.Text := '';
edtVerifyCode.Text := '';
Application.ProcessMessages;
end;
procedure TForm1.btnExitClick(Sender: TObject);
begin
halt;
end;
procedure TForm1.mnuFileExitClick(Sender: TObject);
begin
halt;
end;
procedure TForm1.mnuHelpAboutClick(Sender: TObject);
begin
ShowAboutBox;
end;
end.

View File

@ -0,0 +1,169 @@
object Form1: TForm1
Left = 230
Top = 122
Width = 736
Height = 319
Caption =
'XWBAppHandle1 - UCX RPCBroker (see Options) use of lmAppHandle t' +
'o start a second application (p40)'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = mnuMainMenu
OldCreateOrder = True
PixelsPerInch = 96
TextHeight = 13
object lblOtherProgram: TLabel
Left = 44
Top = 176
Width = 71
Height = 13
Caption = 'Other Program:'
end
object lblOptional: TLabel
Left = 52
Top = 192
Width = 45
Height = 13
Caption = '(Optional)'
end
object lblWithFull: TLabel
Left = 124
Top = 200
Width = 232
Height = 13
Caption = 'With Full Directory Path if not on the System Path'
end
object btnConnect: TButton
Left = 201
Top = 232
Width = 75
Height = 25
Caption = '&Connect'
TabOrder = 0
OnClick = btnConnectClick
end
object btnStartApp2: TButton
Left = 326
Top = 232
Width = 75
Height = 25
Caption = 'Start App2'
TabOrder = 1
OnClick = btnStartApp2Click
end
object edtOtherProgram: TEdit
Left = 124
Top = 168
Width = 269
Height = 21
TabOrder = 2
end
object Memo1: TMemo
Left = 31
Top = 8
Width = 666
Height = 153
Lines.Strings = (
'This application can be used to start other programs, including ' +
'ones that use the '
'RPCBroker for connection to a server using a server generated to' +
'ken.'
''
'To connect with the server, simply press the connect button to s' +
'elect a server/listener port '
'combination, then sign in. After you are signed in, you can sta' +
'rt another Broker application '
'(XWBAppHandle2) by simply clicking on the "Start App2" button (w' +
'ith the Other Program '
'edit box empty of text).'
''
'A program such as Notepad with or without command line arguments' +
', can be started at '
'any time by entering the name (and arguments if any) in the Othe' +
'r Program edit box, then '
'clicking on the Start App2 button.'
'')
TabOrder = 3
end
object btnExit: TButton
Left = 451
Top = 232
Width = 75
Height = 25
Caption = 'Exit'
TabOrder = 4
OnClick = btnExitClick
end
object brkrRPCB: TRPCBroker
ClearParameters = True
ClearResults = True
Connected = False
ListenerPort = 9500
RpcVersion = '0'
Server = 'NXT-Server'
KernelLogIn = True
LogIn.Mode = lmAVCodes
LogIn.PromptDivision = False
OldConnectionOnly = False
Left = 16
Top = 224
end
object mnuMainMenu: TMainMenu
Left = 8
Top = 184
object mnuFile: TMenuItem
Caption = '&File'
object mnuFileExit: TMenuItem
Caption = '&E&xit'
OnClick = mnuFileExitClick
end
end
object mnuOptions: TMenuItem
Caption = 'Options'
object OnlyOldConnection1: TMenuItem
Caption = 'OnlyOldConnection'
end
object BackwardsCompatible1: TMenuItem
Action = actBackwardsCompatible
end
object DebugMode1: TMenuItem
Action = actDebugMode
end
end
object Help1: TMenuItem
Caption = '&Help'
object mnuAbout: TMenuItem
Caption = '&About'
OnClick = mnuAboutClick
end
end
end
object ActionList1: TActionList
Left = 64
Top = 224
object actOldConnectionOnly: TAction
Caption = 'Old Connection Mode Only'
OnExecute = actOldConnectionOnlyExecute
end
object actBackwardsCompatible: TAction
Caption = 'Backwards Compatible'
Checked = True
OnExecute = actBackwardsCompatibleExecute
end
object actDebugMode: TAction
Caption = 'Debug Mode'
OnExecute = actDebugModeExecute
end
end
end

View File

@ -0,0 +1,155 @@
unit fXWBAppHandle1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, RpcSlogin, Trpcb, RpcConf1, frmVistAAbout, Menus, ActnList;
type
TForm1 = class(TForm)
brkrRPCB: TRPCBroker;
btnConnect: TButton;
btnStartApp2: TButton;
edtOtherProgram: TEdit;
lblOtherProgram: TLabel;
lblOptional: TLabel;
lblWithFull: TLabel;
Memo1: TMemo;
btnExit: TButton;
mnuMainMenu: TMainMenu;
mnuFile: TMenuItem;
mnuFileExit: TMenuItem;
Help1: TMenuItem;
mnuAbout: TMenuItem;
mnuOptions: TMenuItem;
OnlyOldConnection1: TMenuItem;
ActionList1: TActionList;
actOldConnectionOnly: TAction;
actBackwardsCompatible: TAction;
actDebugMode: TAction;
BackwardsCompatible1: TMenuItem;
DebugMode1: TMenuItem;
procedure btnConnectClick(Sender: TObject);
procedure btnStartApp2Click(Sender: TObject);
procedure btnExitClick(Sender: TObject);
procedure mnuFileExitClick(Sender: TObject);
procedure mnuAboutClick(Sender: TObject);
procedure actOldConnectionOnlyExecute(Sender: TObject);
procedure actBackwardsCompatibleExecute(Sender: TObject);
procedure actDebugModeExecute(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.btnConnectClick(Sender: TObject);
var
Server, Port: String;
begin
if btnConnect.Caption = '&Connect' then
begin
GetServerInfo(Server, Port);
brkrRPCB.Server := Server;
brkrRPCB.ListenerPort := StrToInt(Port);
brkrRPCB.Connected := True;
if brkrRPCB.Connected then
begin
btnConnect.Caption := '&Disconnect';
mnuOptions.Enabled := False;
end;
end
else
begin
brkrRPCB.Connected := False;
btnConnect.Caption := '&Connect';
mnuOptions.Enabled := True;
end;
end;
procedure TForm1.btnStartApp2Click(Sender: TObject);
var
CurDir: String;
begin
if edtOtherProgram.Text <> '' then
begin
CurDir := edtOtherProgram.Text;
StartProgSLogin(CurDir,nil);
end
else
begin
{ Use Test2.exe and expecting it to be in the startup directory for the current application}
CurDir := ExtractFilePath(ParamStr(0)) + 'XWBAppHandle2.exe';
{ Now start application with silent login }
StartProgSLogin(CurDir, brkrRPCB);
end;
end;
procedure TForm1.btnExitClick(Sender: TObject);
begin
halt;
end;
procedure TForm1.mnuFileExitClick(Sender: TObject);
begin
Halt;
end;
procedure TForm1.mnuAboutClick(Sender: TObject);
begin
ShowAboutBox;
end;
procedure TForm1.actOldConnectionOnlyExecute(Sender: TObject);
begin
if actOldConnectionOnly.Checked then
begin
actOldConnectionOnly.Checked := False;
brkrRPCB.OldConnectionOnly := False;
end
else
begin
actOldConnectionOnly.Checked := True;
brkrRPCB.OldConnectionOnly := True;
end;
end;
procedure TForm1.actBackwardsCompatibleExecute(Sender: TObject);
begin
if actBackwardsCompatible.Checked then
begin
actBackwardsCompatible.Checked := False;
brkrRPCB.IsBackwardCompatibleConnection := False;
end
else
begin
brkrRPCB.IsBackwardCompatibleConnection := True;
actBackwardsCompatible.Checked := True;
end;
end;
procedure TForm1.actDebugModeExecute(Sender: TObject);
begin
if actDebugMode.Checked then
begin
actDebugMode.Checked := False;
brkrRPCB.DebugMode := False;
end
else
begin
brkrRPCB.DebugMode := True;
actDebugMode.Checked := True;
end;
end;
end.

View File

@ -0,0 +1,164 @@
object Form1: TForm1
Left = 201
Top = 168
Width = 635
Height = 334
Caption =
'XWBAppHandle2 - UCX RPCBroker BackwardsCompatible - Started by l' +
'mAppHandle (P40)'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = True
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object lblDUZ: TLabel
Left = 54
Top = 17
Width = 23
Height = 13
Caption = 'DUZ'
end
object lblName: TLabel
Left = 54
Top = 51
Width = 28
Height = 13
Caption = 'Name'
end
object lblDTime: TLabel
Left = 54
Top = 84
Width = 31
Height = 13
Caption = 'DTime'
end
object lblDivision: TLabel
Left = 54
Top = 118
Width = 37
Height = 13
Caption = 'Division'
end
object lblUserName: TLabel
Left = 54
Top = 152
Width = 50
Height = 13
Caption = 'UserName'
end
object Label1: TLabel
Left = 56
Top = 184
Width = 59
Height = 13
Caption = 'IsProduction'
end
object Label2: TLabel
Left = 56
Top = 216
Width = 64
Height = 13
Caption = 'DomainName'
end
object edtDuz: TEdit
Left = 126
Top = 8
Width = 280
Height = 21
TabStop = False
TabOrder = 0
end
object edtName: TEdit
Left = 126
Top = 42
Width = 280
Height = 21
TabStop = False
TabOrder = 2
end
object edtDTime: TEdit
Left = 126
Top = 76
Width = 280
Height = 21
TabStop = False
TabOrder = 3
end
object edtUserName: TEdit
Left = 126
Top = 143
Width = 280
Height = 21
TabStop = False
TabOrder = 4
end
object btnClose: TButton
Left = 188
Top = 248
Width = 75
Height = 25
Caption = 'Close'
Default = True
TabOrder = 1
OnClick = btnCloseClick
end
object edtDivision: TEdit
Left = 126
Top = 109
Width = 280
Height = 21
TabStop = False
TabOrder = 5
end
object edtIsProduction: TEdit
Left = 126
Top = 176
Width = 281
Height = 21
TabOrder = 6
end
object edtDomainName: TEdit
Left = 126
Top = 208
Width = 281
Height = 21
TabOrder = 7
end
object brkrRPCB: TRPCBroker
ClearParameters = True
ClearResults = True
Connected = False
ListenerPort = 9200
RpcVersion = '0'
Server = 'DHCPSERVER'
KernelLogIn = True
LogIn.Mode = lmAVCodes
LogIn.PromptDivision = False
Left = 8
Top = 160
end
object MainMenu1: TMainMenu
Left = 8
Top = 40
object File1: TMenuItem
Caption = '&File'
object Exit1: TMenuItem
Caption = 'E&xit'
OnClick = Exit1Click
end
end
object About1: TMenuItem
Caption = '&Help'
object About2: TMenuItem
Caption = '&About'
OnClick = About2Click
end
end
end
end

View File

@ -0,0 +1,110 @@
unit fXWBAppHandle2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Trpcb, RpcSLogin, RpcConf1, frmVistAAbout, Menus;
type
TForm1 = class(TForm)
brkrRPCB: TRPCBroker;
edtDuz: TEdit;
edtName: TEdit;
edtDTime: TEdit;
edtUserName: TEdit;
btnClose: TButton;
edtDivision: TEdit;
lblDUZ: TLabel;
lblName: TLabel;
lblDTime: TLabel;
lblDivision: TLabel;
lblUserName: TLabel;
MainMenu1: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
About1: TMenuItem;
About2: TMenuItem;
Label1: TLabel;
edtIsProduction: TEdit;
Label2: TLabel;
edtDomainName: TEdit;
procedure FormCreate(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure About2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Login: TVistaLogin;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
NChars: Cardinal;
NameBuffer: PChar;
Server, Port: String;
begin
{ check for silent login data on command line }
if not CheckCmdLine(brkrRPCB) then
begin // Couldn't log on via command line give choice
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
begin
GetServerInfo(Server, Port);
brkrRPCB.Server := Server;
brkrRPCB.ListenerPort := StrToInt(Port);
Caption := 'XWBAppHandle2 - Started by normal sign-on'
end
else
halt;
end;
{ Get and display information on logged in user }
GetUserInfo(brkrRPCB);
edtDUZ.Text := brkrRPCB.User.DUZ;
edtName.Text := brkrRPCB.User.Name;
edtDTime.Text := brkrRPCB.User.DTime;
edtDivision.Text := brkrRPCB.User.Division;
if brkrRPCB.Login.IsProductionAccount then
edtIsProduction.Text := 'True'
else
edtIsProduction.Text := 'False';
edtDomainName.Text := brkrRPCB.LogIn.DomainName;
{also show local username }
NChars := 0;
GetUserName(nil,NChars);
NameBuffer := StrAlloc(NChars);
if GetUserName(NameBuffer, NChars) then
edtUserName.Text := NameBuffer
else
edtUserName.Text := 'Can''t get name';
end;
procedure TForm1.btnCloseClick(Sender: TObject);
begin
halt;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Halt;
end;
procedure TForm1.About2Click(Sender: TObject);
begin
ShowAboutBox;
end;
end.

View File

@ -0,0 +1,180 @@
object frmXWBOnFail: TfrmXWBOnFail
Left = 207
Top = 127
Width = 557
Height = 343
Caption =
'XWBOnFail - UCX RPCBroker Backwards Compatible - Error Handling ' +
'Demo (P40)'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object lblLogin_ErrorText: TLabel
Left = 24
Top = 40
Width = 75
Height = 13
Caption = 'Login_ErrorText'
end
object btnConnect: TButton
Left = 213
Top = 256
Width = 75
Height = 25
Caption = 'Connect'
TabOrder = 0
OnClick = btnConnectClick
end
object rgrSelectAction: TRadioGroup
Left = 268
Top = 64
Width = 217
Height = 137
Caption = 'Select Action'
ItemIndex = 1
Items.Strings = (
'Use OnRPCBFailure property routine'
'Show Message Boxes'
'Capture Text Only')
TabOrder = 1
end
object btnExit: TButton
Left = 410
Top = 256
Width = 75
Height = 25
Caption = 'Exit'
TabOrder = 2
OnClick = btnExitClick
end
object Memo1: TMemo
Left = 16
Top = 64
Width = 217
Height = 169
Lines.Strings = (
'This is an example application to illustrate '
'the effects of TRPCBroker properties '
'related to Error Handling.'
''
'The OnRPCBFailure property can be set '
'to a procedure to handle errors without '
'user interaction. In the sample included '
'here, the error handler will save the error '
'message and a date/time stamp to a file '
'named "Error.Log" in the same directory '
'with the application program. YOU WILL '
'NOT SEE AN ERROR MESSAGE IN '
'THIS CASE!'
''
'If OnRPCBFailure property is not '
'assigned to a procedure, errors by default '
'would be shown in a message box '
'created by the TRPCBroker component. '
'This behavior is controlled by the '
'ShowErrorMsgs property, with a default '
'of semShow (Show Message Boxes). '
''
'If the ShowErrorMsgs property is set to '
'semRaise (Don'#39't Show Message Boxes), '
'the error will be permitted to be handled '
'by a higher part of the application. In '
'most cases this will produce an error '
'dialog box generated by the system in '
'general.'
''
'If the ShowErrorMsgs property is set to '
'semSet (Capture Text Only), there will be '
'no error action taken except for the '
'setting of error messages into the '
'RPCBError and/or Login.ErrorText '
'properties. In this case, the application '
'MUST check these properties '
'immediately after a call to the RPCBroker '
'to determine whether any errors were '
'encountered and to determine the action '
'to be taken.'
''
'Select the type of behavior desired by '
'clicking on one of the options to the right.'
''
'Then press Connect and either cancel '
'during the log-in dialog or generate an '
'error in some other manner. If you are '
'connected, the button will change to '
'Disconnect and you can click on it to '
'disconnect from the server.'
''
'Checking the check box "Use Silent Bad '
'Access/Verify" to the left will set the '
'AccessVerifyCodes property to '
#39'monkeysee;monkeydo'#39' which will cause '
'a silent login attempt and fails.'
'')
ScrollBars = ssVertical
TabOrder = 3
end
object edtErrorText: TEdit
Left = 8
Top = 8
Width = 473
Height = 21
TabOrder = 4
Text = 'RPCBroker_RPCBError property'
end
object edtLoginError: TEdit
Left = 104
Top = 32
Width = 225
Height = 21
TabOrder = 5
Text = 'RPCBroker_Login_ErrorText Property'
end
object cbxBadAccess: TCheckBox
Left = 16
Top = 256
Width = 169
Height = 17
Caption = 'Use Silent Bad Access/Verify'
TabOrder = 6
end
object RPCB: TRPCBroker
ClearParameters = True
ClearResults = True
Connected = False
ListenerPort = 9500
RpcVersion = '0'
Server = 'NXT-Server'
KernelLogIn = True
LogIn.Mode = lmAVCodes
LogIn.PromptDivision = False
Left = 408
Top = 32
end
object MainMenu1: TMainMenu
Left = 368
Top = 32
object File1: TMenuItem
Caption = '&File'
object Exit1: TMenuItem
Caption = 'E&xit'
OnClick = Exit1Click
end
end
object Help1: TMenuItem
Caption = '&Help'
object About1: TMenuItem
Caption = '&About'
OnClick = About1Click
end
end
end
end

View File

@ -0,0 +1,120 @@
unit fXWBOnFail;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Trpcb, Rpcconf1, ExtCtrls, frmVistAAbout, Menus;
type
TfrmXWBOnFail = class(TForm)
btnConnect: TButton;
RPCB: TRPCBroker;
rgrSelectAction: TRadioGroup;
btnExit: TButton;
Memo1: TMemo;
edtErrorText: TEdit;
edtLoginError: TEdit;
lblLogin_ErrorText: TLabel;
cbxBadAccess: TCheckBox;
MainMenu1: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
procedure btnConnectClick(Sender: TObject);
procedure btnExitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure MyErrorHandler(RPCBroker: TRPCBroker);
end;
var
frmXWBOnFail: TfrmXWBOnFail;
implementation
{$R *.DFM}
procedure TfrmXWBOnFail.MyErrorHandler(RPCBroker: TRPCBroker);
var
ErrorText: String;
Path: String;
StrLoc: TStringList;
NowVal: TDateTime;
begin
NowVal := Now;
ErrorText := RPCB.RPCBError;
StrLoc := TStringList.Create;
Path := ExtractFilePath(Application.ExeName);
Path := Path + 'Error.Log';
if FileExists(Path) then
StrLoc.LoadFromFile(Path);
StrLoc.Add(FormatDateTime('mm/dd/yyyy hh:mm:ss ',NowVal) + ErrorText);
StrLoc.SaveToFile(Path);
end;
procedure TfrmXWBOnFail.btnConnectClick(Sender: TObject);
begin
if btnConnect.Caption = 'Connect' then
begin
edtErrorText.Text := ''; // Clear out old values
edtLoginError.Text := '';
RPCB.AccessVerifyCodes := '';
RPCB.KernelLogIn := True;
if cbxBadAccess.Checked then
RPCB.AccessVerifyCodes := 'monkeysee;monkeydo';
RPCB.OnRPCBFailure := nil;
RPCB.ShowErrorMsgs := semRaise;
case rgrSelectAction.ItemIndex of //
0: RPCB.OnRPCBFailure := MyErrorHandler;
1: RPCB.ShowErrorMsgs := semRaise;
2: RPCB.ShowErrorMsgs := semQuiet;
end; // case
try
RPCB.Connected := True;
if RPCB.Connected then
btnConnect.Caption := 'Disconnect';
finally
edtErrorText.Text := RPCB.RPCBError;
edtLoginError.Text := RPCB.LogIn.ErrorText;
end;
end
else
begin
RPCB.Connected := False;
btnConnect.Caption := 'Connect';
end;
end;
procedure TfrmXWBOnFail.btnExitClick(Sender: TObject);
begin
halt;
end;
procedure TfrmXWBOnFail.FormCreate(Sender: TObject);
var
Server: String;
Port: String;
begin
GetServerInfo(Server, Port);
RPCB.Server := Server;
RPCB.ListenerPort := StrToInt(Port);
end;
procedure TfrmXWBOnFail.Exit1Click(Sender: TObject);
begin
Halt;
end;
procedure TfrmXWBOnFail.About1Click(Sender: TObject);
begin
ShowAboutBox;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,267 @@
unit frmVistAAbout;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, jpeg, jconsts, Dialogs;
TYPE
TInteger8 = Int64;
type
TfrmVistAAbout = class(TForm)
Panel1: TPanel;
VistaLogo: TImage;
lblProductName: TLabel;
lblVersion: TLabel;
lblGovStatement: TLabel;
OKButton: TButton;
lblCRC: TLabel;
Memo1: TMemo;
lblDate: TLabel;
ProgramIcon: TImage;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure getfileinfo(var Version: String; var ProductName: String); virtual;
end;
procedure ShowAboutBox;
implementation
{$R *.DFM}
CONST
table: ARRAY[0..255] OF DWORD =
($00000000, $77073096, $EE0E612C, $990951BA,
$076DC419, $706AF48F, $E963A535, $9E6495A3,
$0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
$09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
$1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
$1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
$136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
$14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
$3B6E20C8, $4C69105E, $D56041E4, $A2677172,
$3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
$35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940,
$32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
$26D930AC, $51DE003A, $C8D75180, $BFD06116,
$21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
$2802B89E, $5F058808, $C60CD9B2, $B10BE924,
$2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
$76DC4190, $01DB7106, $98D220BC, $EFD5102A,
$71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
$7807C9A2, $0F00F934, $9609A88E, $E10E9818,
$7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
$6B6B51F4, $1C6C6162, $856530D8, $F262004E,
$6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
$65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C,
$62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
$4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
$4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
$4369E96A, $346ED9FC, $AD678846, $DA60B8D0,
$44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
$5005713C, $270241AA, $BE0B1010, $C90C2086,
$5768B525, $206F85B3, $B966D409, $CE61E49F,
$5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4,
$59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
$EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
$EAD54739, $9DD277AF, $04DB2615, $73DC1683,
$E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
$E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
$F00F9344, $8708A3D2, $1E01F268, $6906C2FE,
$F762575D, $806567CB, $196C3671, $6E6B06E7,
$FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC,
$F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
$D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252,
$D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
$D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
$DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
$CB61B38C, $BC66831A, $256FD2A0, $5268E236,
$CC0C7795, $BB0B4703, $220216B9, $5505262F,
$C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
$C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
$9B64C2B0, $EC63F226, $756AA39C, $026D930A,
$9C0906A9, $EB0E363F, $72076785, $05005713,
$95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38,
$92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
$86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E,
$81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
$88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
$8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
$A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
$A7672661, $D06016F7, $4969474D, $3E6E77DB,
$AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
$A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
$BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
$BAD03605, $CDD70693, $54DE5729, $23D967BF,
$B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
$B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
// Use CalcCRC32 as a procedure so CRCValue can be passed in but
// also returned. This allows multiple calls to CalcCRC32 for
// the "same" CRC-32 calculation.
PROCEDURE CalcCRC32 (p: pointer; ByteCount: DWORD; VAR CRCValue: DWORD);
// The following is a little cryptic (but executes very quickly).
// The algorithm is as follows:
// 1. exclusive-or the input byte with the low-order byte of
// the CRC register to get an INDEX
// 2. shift the CRC register eight bits to the right
// 3. exclusive-or the CRC register with the contents of
// Table[INDEX]
// 4. repeat steps 1 through 3 for all bytes
VAR
i: DWORD;
q: ^BYTE;
BEGIN
q := p;
FOR i := 0 TO ByteCount-1 DO BEGIN
CRCvalue := (CRCvalue SHR 8) XOR
Table[ q^ XOR (CRCvalue AND $000000FF) ];
INC(q)
END
END {CalcCRC32};
// The CRC-32 value calculated here matches the one from the PKZIP program.
// Use MemoryStream to read file in binary mode.
PROCEDURE CalcFileCRC32 (FromName: STRING; VAR CRCvalue: DWORD;
VAR TotalBytes: TInteger8;
VAR error: WORD);
VAR
Stream: TMemoryStream;
BEGIN
error := 0;
CRCValue := $FFFFFFFF;
Stream := TMemoryStream.Create;
TRY
TRY
Stream.LoadFromFile(FromName);
IF Stream.Size > 0
THEN CalcCRC32 (Stream.Memory, Stream.Size, CRCvalue)
EXCEPT
ON E: EReadError DO
error := 1
END;
CRCvalue := NOT CRCvalue;
TotalBytes := Stream.Size
FINALLY
Stream.Free
END;
END {CalcFileCRC32};
procedure TfrmVistAAbout.FormCreate(Sender: TObject);
var
CRC32: DWord;
TotalBytes: Int64;
Error: Word;
Text: String;
Version: String;
ProductName: String;
begin
CalcFileCRC32(Application.ExeName, CRC32, TotalBytes, Error);
lblCRC.Caption := 'CRC: ' + IntToHex(CRC32,8);
Text := Application.ExeName;
while pos('\',Text) > 0 do
begin
Text := copy(Text,pos('\',Text)+1,Length(Text));
end; // while
Text := copy(Text,1,Length(Text)-4);
Caption := 'About ' + Text;
getfileinfo(Version, ProductName);
lblProductName.Caption := ProductName;
lblVersion.Caption := 'Version: ' + Version;
lblProductName.Width := Panel1.Width-10;
lblGovStatement.Width := Panel1.Width-10;
if ProgramIcon.Picture.Graphic = nil then
begin
VistALogo.Left := (Panel1.Width - VistALogo.Width) div 2;
end;
end;
procedure TfrmVistAAbout.GetFileInfo(var Version: String; var ProductName: String);
var
VerInfoSize: DWORD; // holds the size of the version info resource
GetInfoSizeJunk: DWORD; // a junk variable, its value is ignored
VersionInfo: Pointer; // points to the version info resource
Translation: Pointer; // holds version info translation table
InfoPointer: Pointer; // a pointer to version information
VersionInfoSize: UINT; // holds the size of version information
VersionValue: string; // holds the version info request string
SearchRec: TSearchRec;
DateTimeVal: TDateTime;
WriteTime: Integer;
begin
{retrieve the size of the version information resource, if one exists}
VerInfoSize := GetFileVersionInfoSize(PChar(Application.ExeName),
GetInfoSizeJunk);
{if there was a version information resource available...}
if VerInfoSize>0 then
begin
{retrieve enough memory to hold the version resource}
GetMem(VersionInfo, VerInfoSize);
{retrieve the version resource for the selected file}
GetFileVersionInfo(PChar(Application.ExeName), 0,
VerInfoSize, VersionInfo);
{retrieve a pointer to the translation table}
VerQueryValue(VersionInfo, '\\VarFileInfo\\Translation',
Translation, VersionInfoSize);
{initialize the version value request string}
VersionValue :='\\StringFileInfo\\'+
IntToHex(LoWord(LongInt(Translation^)),4)+
IntToHex(HiWord(LongInt(Translation^)),4)+
'\\';
{retrieve and display the file version}
VerQueryValue(VersionInfo, PChar(VersionValue+'FileVersion'), InfoPointer,
VersionInfoSize);
Version := string(PChar(InfoPointer));
{retrieve and display the product name}
VerQueryValue(VersionInfo, PChar(VersionValue+'ProductName'), InfoPointer,
VersionInfoSize);
ProductName := string(PChar(InfoPointer));
{free the version resource memory}
FreeMem(VersionInfo, VerInfoSize);
end
else
begin
Version := 'Not in File';
ProductName := 'Not Identified In File';
end;
if findfirst(Application.ExeName, faAnyFile, SearchRec) = 0 then
begin
WriteTime := SearchRec.Time;
DateTimeVal := FileDateToDateTime(WriteTime);
lblDate.Caption := FormatDateTime('mmmm dd, yyyy hh:nn',DateTimeVal);
end;
end;
procedure ShowAboutBox;
begin
with TfrmVistAAbout.Create(Application) do
try
ShowModal;
finally
free;
end;
end;
end.

View File

@ -0,0 +1,82 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Language]
ActiveLang=
ProjectLang=$00000409
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=1
MajorVer=1
MinorVer=1
Release=31
Build=8
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=Example Program using RPCBroker and different types of calls
FileVersion=1.1.31.8
InternalName=Broker Example
LegalCopyright=(c) 1997-2002
LegalTrademarks=
OriginalFilename=
ProductName=RPCBroker BrokerExample
ProductVersion=1.1.31.0
Comments=

View File

@ -0,0 +1,19 @@
program BrokerExample;
uses
Forms,
fBrokerExample in 'fBrokerExample.pas' {frmBrokerExample},
SplVista,
fSgnonDlg in '..\..\Source\fSgnonDlg.pas' {frmSignonDialog};
// include to display Vista splash
{$R *.RES}
begin
Application.CreateForm(TfrmBrokerExample, frmBrokerExample);
Application.CreateForm(TfrmSignonDialog, frmSignonDialog);
SplashOpen; // display splash screen
SplashClose(3000); // min splash time 3 seconds, then close
Application.Run;
end.

View File

@ -0,0 +1,42 @@
{**************************************************
RPC Broker Example About form ver. 1.1 9/2/97
Infrastructure Development Team
San Francisco IRM Field Office, Dept. of Veterans Affairs
**************************************************}
unit BrokerExampleAboutFrm;
interface
uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls;
type
TAboutBox = class(TForm)
Panel1: TPanel;
OKButton: TBitBtn;
ProgramIcon: TImage;
ProductName: TLabel;
Version: TLabel;
Copyright: TLabel;
Comments: TLabel;
procedure OKButtonClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
AboutBox: TAboutBox;
implementation
{$R *.DFM}
procedure TAboutBox.OKButtonClick(Sender: TObject);
begin
Close;
end;
end.

View File

@ -0,0 +1,136 @@
object AboutBox: TAboutBox
Left = 315
Top = 182
ActiveControl = OKButton
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsDialog
Caption = 'About RPC Broker Example'
ClientHeight = 213
ClientWidth = 305
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clBtnText
Font.Height = -13
Font.Name = 'System'
Font.Style = []
OldCreateOrder = True
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 16
object Panel1: TPanel
Left = 8
Top = 8
Width = 289
Height = 161
BevelInner = bvRaised
BevelOuter = bvLowered
TabOrder = 0
object ProgramIcon: TImage
Left = 8
Top = 8
Width = 65
Height = 57
Picture.Data = {
07544269746D617076020000424D760200000000000076000000280000002000
0000200000000100040000000000000200000000000000000000100000001000
000000000000000080000080000000808000800000008000800080800000C0C0
C000808080000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF
FF00000000000000000000000000000000000EE8787878EEEEEEE03F30878EEE
EEE00EE8787878EEEEEEE03F30878EEEEEE00EE8787878EEEEEEE03F30878EEE
EEE00EE8787878EEEEEEE03F30878EEEEEE00887787877788888803F3088787E
EEE00788787878878887803F3088887EEEE00788887888878887803F3088887E
EEE00877888887788888703F308887EEEEE00888777778888888037883088888
8EE007777777777777703787883087777EE00888888888888803787FF8830888
888008888888888880378777778830888880077777777788037873F3F3F87808
88E00888888888803787FFFFFFFF8830EEE00887777778800001111111111100
EEE00888888888888899B999B99999EEEEE00888888888888899B9B99BB9B9EE
EEE0088888888888899BB9BB99BB99EEEEE0078888888888899B999B999999EE
EEE0087788888778899B9B9BB9BB99EEEEE00888778778888E9B9B9BB9999EEE
EEE0088888788888EE9B99B9BB9BEEEEEEE00EE8888888EEEEE999B9999EEEEE
EEE00EEEE888EEEEEEEE99BB999EEEEEEEE00EEEEE8EEEEEEEEEE999B9EEEEEE
EEE00EEEEE8EEEEEEEEEEEE999EEEEEEEEE00EEEEE8EEEEEEEEEEEEE99EEEEEE
EEE00EEEEE8EEEEEEEEEEEEE9EEEEEEEEEE00EEEEE8EEEEEEEEEEEEEEEEEEEEE
EEE00EEEEEEEEEEEEEEEEEEEEEEEEEEEEEE00000000000000000000000000000
0000}
Stretch = True
IsControl = True
end
object ProductName: TLabel
Left = 88
Top = 16
Width = 118
Height = 13
Caption = 'RPC Broker Example'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBtnText
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
IsControl = True
end
object Version: TLabel
Left = 88
Top = 40
Width = 69
Height = 13
Caption = 'Version: 1.1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBtnText
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
IsControl = True
end
object Copyright: TLabel
Left = 8
Top = 80
Width = 238
Height = 13
Caption = 'Copyright: Department Of Veterans Affairs'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBtnText
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
IsControl = True
end
object Comments: TLabel
Left = 4
Top = 112
Width = 280
Height = 39
Caption =
'Your feedback is greatly appreciated. Please direct your commen' +
'ts to: G.RPC_BROKER_COMMENTS@FORUM.VA.GOV'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBtnText
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
WordWrap = True
IsControl = True
end
end
object OKButton: TBitBtn
Left = 111
Top = 178
Width = 77
Height = 27
Font.Charset = DEFAULT_CHARSET
Font.Color = clBtnText
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 1
OnClick = OKButtonClick
Kind = bkOK
Margin = 2
Spacing = -1
IsControl = True
end
end

View File

@ -0,0 +1,568 @@
object frmBrokerExample: TfrmBrokerExample
Left = 203
Top = 106
BorderStyle = bsSingle
Caption = 'RPCBroker Example (patch xwb*1.1*40 SharedRPCBroker)'
ClientHeight = 386
ClientWidth = 473
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clBtnText
Font.Height = -13
Font.Name = 'System'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = True
Position = poScreenCenter
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 16
object GroupBox2: TGroupBox
Left = 8
Top = 0
Width = 457
Height = 73
Caption = 'VistA Server'
TabOrder = 0
object Label2: TLabel
Left = 6
Top = 51
Width = 67
Height = 16
AutoSize = False
Caption = 'Status:'
end
object Label3: TLabel
Left = 82
Top = 51
Width = 88
Height = 16
Caption = 'Disconnected'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clRed
Font.Height = -13
Font.Name = 'System'
Font.Style = []
ParentColor = False
ParentFont = False
end
object btnConnect: TButton
Left = 354
Top = 12
Width = 91
Height = 25
Caption = '&Connect'
Default = True
TabOrder = 2
OnClick = btnConnectClick
end
object edtPort: TEdit
Left = 192
Top = 24
Width = 49
Height = 24
Hint = 'Listener port number'
ParentShowHint = False
ShowHint = True
TabOrder = 1
Text = '9200'
OnChange = edtServerChange
end
object edtServer: TEdit
Left = 8
Top = 24
Width = 177
Height = 24
Hint = 'Name of server or IP address'
ParentShowHint = False
ShowHint = True
TabOrder = 0
Text = 'BROKERSERVER'
OnChange = edtServerChange
end
object BitBtn1: TBitBtn
Left = 354
Top = 44
Width = 91
Height = 25
TabOrder = 3
Kind = bkClose
end
object btnGetServerInfo: TBitBtn
Left = 248
Top = 24
Width = 73
Height = 25
Hint = 'GetServerInfo'
Caption = 'Server'
ParentShowHint = False
ShowHint = True
TabOrder = 4
OnClick = btnGetServerInfoClick
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000120B0000120B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333000000000
00333FF777777777773F0000FFFFFFFFFF0377773F3F3F3F3F7308880F0F0F0F
0FF07F33737373737337088880FFFFFFFFF07F3337FFFFFFFFF7088880000000
00037F3337777777777308888033330F03337F3337F3FF7F7FFF088880300000
00007F3337F7777777770FFFF030FFFFFFF07F3FF7F7F3FFFFF708008030F000
00F07F7737F7F77777F70FFFF030F0AAE0F07F3FF7F7F7F337F708008030F0DA
D0F07F7737F7F7FFF7F70FFFF030F00000F07F33F7F7F77777370FF9F030FFFF
FFF07F3737F7FFFFFFF70FFFF030000000007FFFF7F777777777000000333333
3333777777333333333333333333333333333333333333333333}
NumGlyphs = 2
end
end
object PageControl1: TPageControl
Left = 8
Top = 76
Width = 457
Height = 305
ActivePage = TabSheet1
TabOrder = 1
object TabSheet1: TTabSheet
Caption = 'Echo string'
object lblSend: TLabel
Left = 8
Top = 24
Width = 96
Height = 16
Caption = 'Original string:'
end
object lblReturn: TLabel
Left = 8
Top = 144
Width = 93
Height = 16
Caption = 'Echoed string:'
end
object edtStrOrig: TEdit
Left = 8
Top = 40
Width = 225
Height = 24
TabOrder = 0
Text = 'Hello World!'
end
object edtStrRtrn: TEdit
Left = 8
Top = 160
Width = 225
Height = 24
ReadOnly = True
TabOrder = 1
end
object btnEchoString: TButton
Left = 8
Top = 88
Width = 225
Height = 25
Hint = 'XWB EXAMPLE ECHO STRING'
Caption = 'Execute RPC'
Default = True
ParentShowHint = False
ShowHint = True
TabOrder = 2
OnClick = btnEchoStringClick
end
object Memo1: TMemo
Left = 240
Top = 8
Width = 201
Height = 257
TabStop = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
Lines.Strings = (
'Uses TRPCBroker.Call method '
'to return a single string.'
''
'Original string passed in as '
'PType literal.'
''
'RPC: XWB EXAMPLE ECHO '
'STRING.'
''
'Return Value Type: SINGLE '
'VALUE.')
ParentColor = True
ParentFont = False
ReadOnly = True
TabOrder = 3
end
end
object TabSheet2: TTabSheet
Caption = 'Pass by reference'
object Label1: TLabel
Left = 8
Top = 24
Width = 70
Height = 16
Caption = 'Reference:'
end
object Label4: TLabel
Left = 8
Top = 144
Width = 40
Height = 16
Caption = 'Value:'
end
object edtReference: TEdit
Left = 8
Top = 40
Width = 225
Height = 24
TabOrder = 0
Text = '$HOROLOG'
end
object edtValue: TEdit
Left = 8
Top = 160
Width = 225
Height = 24
ReadOnly = True
TabOrder = 1
end
object btnPassByRef: TButton
Left = 8
Top = 88
Width = 225
Height = 25
Hint = 'XWB GET VARIABLE VALUE'
Caption = 'Execute RPC'
Default = True
ParentShowHint = False
ShowHint = True
TabOrder = 2
OnClick = btnPassByRefClick
end
object Memo2: TMemo
Left = 240
Top = 8
Width = 201
Height = 257
TabStop = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
Lines.Strings = (
'Uses TRPCBroker.strCall '
'method to return a single string.'
''
'Parameter passed in as PType '
'reference.'
''
'RPC: XWB GET VARIABLE '
'VALUE.'
''
'Return Value Type: SINGLE '
'VALUE.')
ParentColor = True
ParentFont = False
ReadOnly = True
TabOrder = 3
end
end
object TabSheet3: TTabSheet
Caption = 'Get list'
object Label5: TLabel
Left = 8
Top = 120
Width = 87
Height = 16
Caption = 'Returned list:'
end
object lstData: TListBox
Left = 8
Top = 136
Width = 225
Height = 129
ItemHeight = 16
TabOrder = 0
end
object btnGetList: TButton
Left = 8
Top = 88
Width = 225
Height = 25
Hint = 'XWB EXAMPLE GET LIST'
Caption = 'Execute RPC'
Default = True
ParentShowHint = False
ShowHint = True
TabOrder = 1
OnClick = btnGetListClick
end
object RadioButton1: TRadioButton
Left = 16
Top = 16
Width = 137
Height = 17
Caption = 'Number of lines'
Checked = True
TabOrder = 2
TabStop = True
end
object RadioButton2: TRadioButton
Left = 16
Top = 48
Width = 137
Height = 17
Caption = 'Kilobytes of data'
TabOrder = 3
end
object spnLines: TSpinEdit
Left = 160
Top = 16
Width = 65
Height = 26
MaxValue = 0
MinValue = 0
TabOrder = 4
Value = 50
end
object spnKbytes: TSpinEdit
Left = 160
Top = 48
Width = 65
Height = 26
MaxValue = 0
MinValue = 0
TabOrder = 5
Value = 32
end
object Memo3: TMemo
Left = 240
Top = 8
Width = 201
Height = 257
TabStop = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
Lines.Strings = (
'Uses TRPCBroker.Call method '
'to return several strings.'
''
'Two parameters passed in as '
'PType literal.'
''
'RPC: XWB EXAMPLE GET LIST.'
''
'Return Value Type: GLOBAL '
'ARRAY.'
''
'WORD WRAP ON field is True '
'to break appart call result into '
'separate Results strings instead '
'of one long Results[0] string.')
ParentColor = True
ParentFont = False
ReadOnly = True
TabOrder = 6
end
end
object TabSheet4: TTabSheet
Caption = 'WP Text'
object lblList: TLabel
Left = 8
Top = 56
Width = 177
Height = 17
AutoSize = False
Caption = 'REMOTE PROCEDURE file description:'
end
object btnWPText: TButton
Left = 8
Top = 16
Width = 225
Height = 25
Hint = 'XWB EXAMPLE WPTEXT'
Caption = 'Execute RPC'
Default = True
ParentShowHint = False
ShowHint = True
TabOrder = 0
OnClick = btnWPTextClick
end
object mmoText: TMemo
Left = 8
Top = 80
Width = 225
Height = 185
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 1
end
object Memo4: TMemo
Left = 240
Top = 8
Width = 201
Height = 257
TabStop = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
Lines.Strings = (
'Uses TRPCBroker.lstCall '
'method to return several strings.'
''
'No parameters are used in this '
'call.'
''
'RPC: XWB EXAMPLE WPTEXT.'
''
'Return Value Type: WORD '
'PROCESSING.'
''
'WORD WRAP ON field is False '
'to allow memo box to control '
'word wrapping as necessary.')
ParentColor = True
ParentFont = False
ReadOnly = True
TabOrder = 2
end
end
object TabSheet5: TTabSheet
Caption = 'Sort numbers'
object Label6: TLabel
Left = 8
Top = 120
Width = 87
Height = 16
Caption = 'Returned list:'
end
object Label7: TLabel
Left = 8
Top = 8
Width = 72
Height = 16
Caption = 'How many:'
end
object lblStatus: TLabel
Left = 8
Top = 56
Width = 57
Height = 16
Caption = 'lblStatus'
Visible = False
end
object lstSorted: TListBox
Left = 8
Top = 136
Width = 225
Height = 129
ItemHeight = 16
TabOrder = 0
end
object btnSortNum: TButton
Left = 8
Top = 88
Width = 225
Height = 25
Hint = 'XWB EXAMPLE SORT NUMBERS'
Caption = 'Execute RPC'
Default = True
ParentShowHint = False
ShowHint = True
TabOrder = 1
OnClick = btnSortNumClick
end
object spnNumbers: TSpinEdit
Left = 8
Top = 24
Width = 81
Height = 26
MaxValue = 10000
MinValue = 0
TabOrder = 2
Value = 500
end
object rgrDirection: TRadioGroup
Left = 104
Top = 8
Width = 121
Height = 65
Caption = 'Sort direction'
ItemIndex = 0
Items.Strings = (
'low -> high'
'high -> low')
TabOrder = 3
end
object Memo5: TMemo
Left = 240
Top = 8
Width = 201
Height = 257
TabStop = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
Lines.Strings = (
'Uses TRPCBroker.Call method '
'to return several strings.'
''
'First parameter passed in as '
'literal, second as list. See how '
'Mult is used.'
''
'RPC: XWB EXAMPLE SORT '
'NUMBERS.'
''
'Return Value Type: ARRAY.'
''
'This call can take a while to '
'complete. RPCTimeLimit '
'property is adjusted.')
ParentColor = True
ParentFont = False
ReadOnly = True
TabOrder = 4
end
end
end
object MainMenu1: TMainMenu
Left = 160
Top = 320
object Help1: TMenuItem
Caption = '&Help'
object AboutExample: TMenuItem
Caption = '&About RPC Broker Example...'
OnClick = AboutExampleClick
end
end
end
object Timer1: TTimer
OnTimer = Timer1Timer
Left = 16
Top = 320
end
object RPCBroker1: TSharedRPCBroker
ClearParameters = True
ClearResults = True
ListenerPort = 0
RpcVersion = '0'
LogIn.Mode = lmAVCodes
LogIn.PromptDivision = False
AllowShared = True
RPCTimeLimit = 30
Left = 84
Top = 327
end
end

View File

@ -0,0 +1,291 @@
{**************************************************
RPC Broker Example form ver. 1.1 9/3/97
Broker Development Team
San Francisco IRM Field Office, Dept. of Veterans Affairs
Disclaimer:
This example does not attempt to teach general Delphi and M programming.
We intentionally removed any safeguards from the code that prevents
passing values that are too small or too large. Therefore, the important
code remains uncluttered and the programmer is free to experiment and
push the program beyond its limits.
Purpose:
This sample application is an example of how to program client/server
applications in Delphi and M using the RPC Broker. The demonstrated features
include:
- Connecting to an M server
- Creating an application context
- Using the GetServerInfo function
- Displaying the VistA splash screen
- Setting the TRPCBroker Param property for each Param PType (literal,
reference, list)
- Calling RPCs with the Call method
- Calling RPCs with the lstCall and strCall methods
We encourage you to study the Delphi and M source code to see how the
Broker is used to accomplish these tasks. Try changing some of the
RPCBroker1 component properties to see what happens. Also, try other
values in the fields of the remote procedure records in the
REMOTE PROCEDURE file.
Warning: "Get list" and "Sort numbers" tabs can potentially take excessively
large data samples which can either crash server process or cause the
connection timeout. Final note, memory allocation errors are not recorded
in the Kernel error trap. They are recorded in the operating system error
trap.
Context option for this application:
XWB BROKER EXAMPLE
Remote procedures used:
XWB EXAMPLE ECHO STRING
XWB EXAMPLE GET LIST
XWB EXAMPLE SORT NUMBERS
XWB EXAMPLE WPTEXT
XWB GET VARIABLE VALUE
Server M routine:
XWBEXMPL
**************************************************}
unit fBrokerExample;
interface
uses
SysUtils,Forms, StdCtrls,Graphics, Dialogs, WinTypes,
Controls, Classes, ExtCtrls, TRPCB, XWBut1, MFunStr, Menus, WinProcs,
RpcConf1, Spin, ComCtrls, BrokerExampleAboutFrm, Buttons,
ActiveX, SharedRPCBroker;
type
TfrmBrokerExample = class(TForm)
GroupBox2: TGroupBox;
Label2: TLabel;
Label3: TLabel;
MainMenu1: TMainMenu;
Help1: TMenuItem;
AboutExample: TMenuItem;
btnConnect: TButton;
edtPort: TEdit;
edtServer: TEdit;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
lblSend: TLabel;
edtStrOrig: TEdit;
lblReturn: TLabel;
edtStrRtrn: TEdit;
btnEchoString: TButton;
lblList: TLabel;
Label1: TLabel;
edtReference: TEdit;
Label4: TLabel;
edtValue: TEdit;
btnPassByRef: TButton;
lstData: TListBox;
Label5: TLabel;
btnGetList: TButton;
btnWPText: TButton;
Label6: TLabel;
lstSorted: TListBox;
btnSortNum: TButton;
spnNumbers: TSpinEdit;
Label7: TLabel;
rgrDirection: TRadioGroup;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
spnLines: TSpinEdit;
spnKbytes: TSpinEdit;
Timer1: TTimer;
mmoText: TMemo;
lblStatus: TLabel;
BitBtn1: TBitBtn;
btnGetServerInfo: TBitBtn;
Memo1: TMemo;
Memo2: TMemo;
Memo3: TMemo;
Memo4: TMemo;
Memo5: TMemo;
RPCBroker1: TSharedRPCBroker;
procedure AboutExampleClick(Sender: TObject);
procedure btnEchoStringClick(Sender: TObject);
procedure btnConnectClick(Sender: TObject);
procedure btnPassByRefClick(Sender: TObject);
procedure btnGetListClick(Sender: TObject);
procedure btnSortNumClick(Sender: TObject);
procedure btnWPTextClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure btnGetServerInfoClick(Sender: TObject);
procedure edtServerChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
end;
var
frmBrokerExample: TfrmBrokerExample;
implementation
{$R *.DFM}
procedure TfrmBrokerExample.btnEchoStringClick(Sender: TObject);
begin
RPCBroker1.RemoteProcedure := 'XWB EXAMPLE ECHO STRING';
RPCBroker1.Param[0].Value := edtStrOrig.Text;
RPCBroker1.Param[0].PType := literal;
RPCBroker1.Call; //execute RPC
edtStrRtrn.Text := RPCBroker1.Results[0]; //for single value use Results[0]
end;
procedure TfrmBrokerExample.btnPassByRefClick(Sender: TObject);
begin
RPCBroker1.RemoteProcedure := 'XWB GET VARIABLE VALUE';
RPCBroker1.Param[0].Value := edtReference.Text;
RPCBroker1.Param[0].PType := reference;
edtValue.Text := RPCBroker1.strCall; //execute RPC and show result in one call
end;
procedure TfrmBrokerExample.btnGetListClick(Sender: TObject);
begin
RPCBroker1.RemoteProcedure := 'XWB EXAMPLE GET LIST';
if RadioButton1.Checked then begin
RPCBroker1.Param[0].Value := 'LINES';
RPCBroker1.Param[0].PType := literal;
RPCBroker1.Param[1].Value := IntToStr(spnLines.Value);
RPCBroker1.Param[1].PType := literal;
end
else begin
RPCBroker1.Param[0].Value := 'KILOBYTES';
RPCBroker1.Param[0].PType := literal;
RPCBroker1.Param[1].Value := IntToStr(spnKbytes.Value);
RPCBroker1.Param[1].PType := literal
end;
RPCBroker1.Call; //execute RPC
lstData.Items := RPCBroker1.Results; //show results of the call
end;
procedure TfrmBrokerExample.btnWPTextClick(Sender: TObject);
begin
RPCBroker1.RemoteProcedure := 'XWB EXAMPLE WPTEXT';
RPCBroker1.lstCall(mmoText.Lines); //execute RPC and show results in one call
end;
procedure TfrmBrokerExample.btnSortNumClick(Sender: TObject);
var
I, SaveRPCTimeLimit: integer;
begin
lblStatus.Visible := True; //turn on status label
lblStatus.Caption := 'building'; //tell user what's happenning
Application.ProcessMessages; //give Windows chance to paint
with RPCBroker1 do begin
RemoteProcedure := 'XWB EXAMPLE SORT NUMBERS';
if rgrDirection.ItemIndex = 0 then Param[0].Value := 'LO'
else Param[0].Value := 'HI';
Param[0].PType := literal;
with Param[1] do begin
PType := list; //tells Broker to pass Mult
for I := 0 to spnNumbers.Value - 1 do //build Mult one by one
Mult[IntToStr(Random(10000)+1)] := IntToStr(I); //subscript and value are strings!
end;
lblStatus.Caption := 'RPC running';
Application.ProcessMessages; //give Windows chance to paint
SaveRPCTimeLimit := RPCTimeLimit;
RPCTimeLimit := spnNumbers.Value div 10; //adjust in case a lot of numbers
Call; //execute RPC
lstSorted.Items := Results; //show results of the call
RPCTimeLimit := SaveRPCTimeLimit; //restore original value
end;
lblStatus.Visible := False; //turn off status label
end;
procedure TfrmBrokerExample.btnConnectClick(Sender: TObject);
begin
if btnConnect.Caption = '&Connect' then
begin //connect
RPCBroker1.ClearParameters := True; //try False, see what happens
try
RPCBroker1.Connected := True;
//establish connection
if not RPCBroker1.CreateContext('XWB BROKER EXAMPLE') then
ShowMessage('Context could not be created!');
except
on e: Exception do
ShowMessage('Error: ' + e.Message);
end;
end
else //disconnect
RPCBroker1.Connected := False;
end;
procedure TfrmBrokerExample.btnGetServerInfoClick(Sender: TObject);
var
strServer, strPort: string;
begin
if GetServerInfo(strServer, strPort)<> mrCancel then
begin {getsvrinfo}
edtServer.Text := strServer; //use chosen server
edtPort.Text := strPort; //use chosen port
end;
end;
procedure TfrmBrokerExample.edtServerChange(Sender: TObject);
begin
RPCBroker1.Server := edtServer.Text; //use specified server name/addr
RPCBroker1.ListenerPort := StrToInt(edtPort.Text); //use specified port
end;
procedure TfrmBrokerExample.Timer1Timer(Sender: TObject);
begin
if RPCBroker1.Connected then begin
btnConnect.Caption := '&Disconnect';
btnConnect.Default := False;
Label3.Caption := 'Connected';
Label3.Font.Color := clLime; // clGreen; // went to lime for higher contrast at some of the High contrast desktops
end
else begin
btnConnect.Caption := '&Connect';
btnConnect.Default := True;
Label3.Caption := 'Disconnected';
Label3.Font.Color := clRed; // Stayed with Red, generated a high contrast across all of the various combinations
// Attempted to use clHighlight, but it did not show up like a highlight.
end;
end;
procedure TfrmBrokerExample.AboutExampleClick(Sender: TObject);
begin
AboutBox.Show;
end;
procedure TfrmBrokerExample.FormCreate(Sender: TObject);
begin
CoInitialize(nil);
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,267 @@
unit frmVistAAbout;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, jpeg, jconsts, Dialogs;
TYPE
TInteger8 = Int64;
type
TfrmVistAAbout = class(TForm)
Panel1: TPanel;
VistaLogo: TImage;
lblProductName: TLabel;
lblVersion: TLabel;
lblGovStatement: TLabel;
OKButton: TButton;
lblCRC: TLabel;
Memo1: TMemo;
lblDate: TLabel;
ProgramIcon: TImage;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure getfileinfo(var Version: String; var ProductName: String); virtual;
end;
procedure ShowAboutBox;
implementation
{$R *.DFM}
CONST
table: ARRAY[0..255] OF DWORD =
($00000000, $77073096, $EE0E612C, $990951BA,
$076DC419, $706AF48F, $E963A535, $9E6495A3,
$0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
$09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
$1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
$1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
$136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
$14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
$3B6E20C8, $4C69105E, $D56041E4, $A2677172,
$3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
$35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940,
$32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
$26D930AC, $51DE003A, $C8D75180, $BFD06116,
$21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
$2802B89E, $5F058808, $C60CD9B2, $B10BE924,
$2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
$76DC4190, $01DB7106, $98D220BC, $EFD5102A,
$71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
$7807C9A2, $0F00F934, $9609A88E, $E10E9818,
$7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
$6B6B51F4, $1C6C6162, $856530D8, $F262004E,
$6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
$65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C,
$62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
$4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
$4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
$4369E96A, $346ED9FC, $AD678846, $DA60B8D0,
$44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
$5005713C, $270241AA, $BE0B1010, $C90C2086,
$5768B525, $206F85B3, $B966D409, $CE61E49F,
$5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4,
$59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
$EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
$EAD54739, $9DD277AF, $04DB2615, $73DC1683,
$E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
$E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
$F00F9344, $8708A3D2, $1E01F268, $6906C2FE,
$F762575D, $806567CB, $196C3671, $6E6B06E7,
$FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC,
$F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
$D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252,
$D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
$D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
$DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
$CB61B38C, $BC66831A, $256FD2A0, $5268E236,
$CC0C7795, $BB0B4703, $220216B9, $5505262F,
$C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
$C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
$9B64C2B0, $EC63F226, $756AA39C, $026D930A,
$9C0906A9, $EB0E363F, $72076785, $05005713,
$95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38,
$92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
$86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E,
$81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
$88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
$8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
$A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
$A7672661, $D06016F7, $4969474D, $3E6E77DB,
$AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
$A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
$BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
$BAD03605, $CDD70693, $54DE5729, $23D967BF,
$B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
$B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
// Use CalcCRC32 as a procedure so CRCValue can be passed in but
// also returned. This allows multiple calls to CalcCRC32 for
// the "same" CRC-32 calculation.
PROCEDURE CalcCRC32 (p: pointer; ByteCount: DWORD; VAR CRCValue: DWORD);
// The following is a little cryptic (but executes very quickly).
// The algorithm is as follows:
// 1. exclusive-or the input byte with the low-order byte of
// the CRC register to get an INDEX
// 2. shift the CRC register eight bits to the right
// 3. exclusive-or the CRC register with the contents of
// Table[INDEX]
// 4. repeat steps 1 through 3 for all bytes
VAR
i: DWORD;
q: ^BYTE;
BEGIN
q := p;
FOR i := 0 TO ByteCount-1 DO BEGIN
CRCvalue := (CRCvalue SHR 8) XOR
Table[ q^ XOR (CRCvalue AND $000000FF) ];
INC(q)
END
END {CalcCRC32};
// The CRC-32 value calculated here matches the one from the PKZIP program.
// Use MemoryStream to read file in binary mode.
PROCEDURE CalcFileCRC32 (FromName: STRING; VAR CRCvalue: DWORD;
VAR TotalBytes: TInteger8;
VAR error: WORD);
VAR
Stream: TMemoryStream;
BEGIN
error := 0;
CRCValue := $FFFFFFFF;
Stream := TMemoryStream.Create;
TRY
TRY
Stream.LoadFromFile(FromName);
IF Stream.Size > 0
THEN CalcCRC32 (Stream.Memory, Stream.Size, CRCvalue)
EXCEPT
ON E: EReadError DO
error := 1
END;
CRCvalue := NOT CRCvalue;
TotalBytes := Stream.Size
FINALLY
Stream.Free
END;
END {CalcFileCRC32};
procedure TfrmVistAAbout.FormCreate(Sender: TObject);
var
CRC32: DWord;
TotalBytes: Int64;
Error: Word;
Text: String;
Version: String;
ProductName: String;
begin
CalcFileCRC32(Application.ExeName, CRC32, TotalBytes, Error);
lblCRC.Caption := 'CRC: ' + IntToHex(CRC32,8);
Text := Application.ExeName;
while pos('\',Text) > 0 do
begin
Text := copy(Text,pos('\',Text)+1,Length(Text));
end; // while
Text := copy(Text,1,Length(Text)-4);
Caption := 'About ' + Text;
getfileinfo(Version, ProductName);
lblProductName.Caption := ProductName;
lblVersion.Caption := 'Version: ' + Version;
lblProductName.Width := Panel1.Width-10;
lblGovStatement.Width := Panel1.Width-10;
if ProgramIcon.Picture.Graphic = nil then
begin
VistALogo.Left := (Panel1.Width - VistALogo.Width) div 2;
end;
end;
procedure TfrmVistAAbout.GetFileInfo(var Version: String; var ProductName: String);
var
VerInfoSize: DWORD; // holds the size of the version info resource
GetInfoSizeJunk: DWORD; // a junk variable, its value is ignored
VersionInfo: Pointer; // points to the version info resource
Translation: Pointer; // holds version info translation table
InfoPointer: Pointer; // a pointer to version information
VersionInfoSize: UINT; // holds the size of version information
VersionValue: string; // holds the version info request string
SearchRec: TSearchRec;
DateTimeVal: TDateTime;
WriteTime: Integer;
begin
{retrieve the size of the version information resource, if one exists}
VerInfoSize := GetFileVersionInfoSize(PChar(Application.ExeName),
GetInfoSizeJunk);
{if there was a version information resource available...}
if VerInfoSize>0 then
begin
{retrieve enough memory to hold the version resource}
GetMem(VersionInfo, VerInfoSize);
{retrieve the version resource for the selected file}
GetFileVersionInfo(PChar(Application.ExeName), 0,
VerInfoSize, VersionInfo);
{retrieve a pointer to the translation table}
VerQueryValue(VersionInfo, '\\VarFileInfo\\Translation',
Translation, VersionInfoSize);
{initialize the version value request string}
VersionValue :='\\StringFileInfo\\'+
IntToHex(LoWord(LongInt(Translation^)),4)+
IntToHex(HiWord(LongInt(Translation^)),4)+
'\\';
{retrieve and display the file version}
VerQueryValue(VersionInfo, PChar(VersionValue+'FileVersion'), InfoPointer,
VersionInfoSize);
Version := string(PChar(InfoPointer));
{retrieve and display the product name}
VerQueryValue(VersionInfo, PChar(VersionValue+'ProductName'), InfoPointer,
VersionInfoSize);
ProductName := string(PChar(InfoPointer));
{free the version resource memory}
FreeMem(VersionInfo, VerInfoSize);
end
else
begin
Version := 'Not in File';
ProductName := 'Not Identified In File';
end;
if findfirst(Application.ExeName, faAnyFile, SearchRec) = 0 then
begin
WriteTime := SearchRec.Time;
DateTimeVal := FileDateToDateTime(WriteTime);
lblDate.Caption := FormatDateTime('mmmm dd, yyyy hh:nn',DateTimeVal);
end;
end;
procedure ShowAboutBox;
begin
with TfrmVistAAbout.Create(Application) do
try
ShowModal;
finally
free;
end;
end;
end.

View File

@ -0,0 +1,9 @@
The SilentSignOn(p13) directory under Samples contains four (4) sample programs that illustrate different aspects of patch XWB*1.1*13. Source code is included for each of these programs.
The program XWBAppHandle1 is used to illustrate the use of the StartProgSLogin method in the RpcSLogin unit. This method is used to launch a second program (XWBAppHandle2) with a silent login using an AppHandle obtained from the server. The AppHandle and information about the server, listener port, and Division are passed on the command line when XWBAppHandle2 is launched. The StartProgSLogin method can also can be used to launch a non-RPCBroker related program and this can be demonstrated by entering the name of a program, and command line arguments if any, in an edit box prior to clicking the Start App2 button. This will launch the specified program without including any broker related arguments on the command line.
The program XWBAppHandle2 is used to illustrate the use of the GetCmdLine method in the RpcSLogin unit. This method identifies command line arguments related to the RPCBroker (identified by p=, s=, h=, and d= for listener port, server, AppHandle, and Division, respectively). If the arguments include an AppHandle, the connection to the server is attempted as well. This application will display information about the user logged into the server. If an attempt is made to start the application manually, a message box is displayed asking whether the user wants to login manually. If the response is 'OK' the normal RPCBroker login screen is shown. If the response is 'Cancel' the application terminates.
The program XWBAVCodes is used to illustrate a silent login in which the Access and Verify codes are provided by the program, as opposed to being entered in the RPCBroker login screen.
The program XWBOnFail is used to illustrate the different types of error handling which are available in patch XWB*1.1*13. These include permitting the application to handle errors via a specified procedure call, to showing normal errors, to simply providing the error message for the application to examine while otherwise ignoring errors completely.

View File

@ -0,0 +1,82 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=Vcl50;Vclx50;Vcldb50;Vclbde50;VclSmp50;vclado50;ibevnt50;vcldbx50;Qrpt50;TeeUI50;TeeDB50;Tee50;Dss50;TeeQR50;VCLIB50;Vclmid50;vclie50;Inetdb50;Inet50;NMFast50;webmid50;dclocx50;dclaxserver50;JLITestFDE;Rz252N50;Rz252D50;CS20Comps50;CSP20I50;gmunitsd5;gmctrlsd5;gmchrtedd5;gmdaouid5;GMDaod5;gmdbgend5;gmdbctrld5;gmadouid5;GMAdod5;democomponentsd5;Speech;Indy50;vclPerfUtils5;SharedRPCBroker_R50;XWB_R50;TMSColList;osg5220;osdg5220;CPRSctrls_50;KeaBroker_R50;ZipMasterD5;ICSDEL50;TCynthesisAppUpdateD5;Fmdc_R50;CodeRush50;CR_FormPopupFix50;CR_Standard50;Aruser;XUtilsR50;XUDT_R50;XU_R50
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Language]
ActiveLang=
ProjectLang=$00000409
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=1
MajorVer=1
MinorVer=1
Release=31
Build=6
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=Dept of Veteran Affairs, VHA, OI, SD&D, IIS
FileDescription=Sample Silent Login with lmAVCodes
FileVersion=1.1.31.6
InternalName=a
LegalCopyright=(c) 2002
LegalTrademarks=
OriginalFilename=
ProductName=XWBAVCodes
ProductVersion=1.1.31.0
Comments=

View File

@ -0,0 +1,15 @@
program XWBAVCodes;
uses
Forms,
fXWBAVCodes in 'fXWBAVCodes.pas' {Form1},
frmVistAAbout in 'frmVistAAbout.pas' {frmVistAAbout};
{$R *.RES}
begin
Application.Initialize;
Application.Title := 'Test4Silent';
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@ -0,0 +1,82 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Language]
ActiveLang=
ProjectLang=$00000409
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=1
MajorVer=1
MinorVer=1
Release=31
Build=7
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=Dept. of Veteran Affairs, VHA, OI, SD&D, IIS
FileDescription=Example program launching another program using the lmAppHandle silent login
FileVersion=1.1.31.7
InternalName=
LegalCopyright=(c) 2002
LegalTrademarks=
OriginalFilename=
ProductName=XWBAppHandle1
ProductVersion=1.1.31.0
Comments=

View File

@ -0,0 +1,13 @@
program XWBAppHandle1;
uses
Forms,
fXWBAppHandle1 in 'fXWBAppHandle1.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@ -0,0 +1,82 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Language]
ActiveLang=
ProjectLang=$00000409
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=1
MajorVer=1
MinorVer=1
Release=31
Build=5
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=Dept. of Veteran Affairs, VHA, OI, SD&D, IIS
FileDescription=Example program of starting an application using an AppHandle token
FileVersion=1.1.31.5
InternalName=
LegalCopyright=(c) 2002
LegalTrademarks=
OriginalFilename=
ProductName=XWBAppHandle2
ProductVersion=1.1.31.0
Comments=

View File

@ -0,0 +1,13 @@
program XWBAppHandle2;
uses
Forms,
fXWBAppHandle2 in 'fXWBAppHandle2.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@ -0,0 +1,82 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Language]
ActiveLang=
ProjectLang=$00000409
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=1
MajorVer=1
MinorVer=1
Release=31
Build=8
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=Dept of Veteran Affairs, VHA, OI, SD&D, IIS
FileDescription=Example of available error handling mechanisms for RPCBroker
FileVersion=1.1.31.8
InternalName=
LegalCopyright=(c) 2002
LegalTrademarks=
OriginalFilename=
ProductName=XWBOnFail
ProductVersion=1.1.31.0
Comments=

View File

@ -0,0 +1,13 @@
program XWBOnFail;
uses
Forms,
fXWBOnFail in 'fXWBOnFail.pas' {frmXWBOnFail};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TfrmXWBOnFail, frmXWBOnFail);
Application.Run;
end.

View File

@ -0,0 +1,231 @@
object Form1: TForm1
Left = 190
Top = 138
Width = 574
Height = 393
Caption =
'XWBAVCodes - Silent Login with lmAVCodes (XWB*1.1*40 SharedRPCBr' +
'oker)'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = True
PixelsPerInch = 96
TextHeight = 13
object lblAccessCode: TLabel
Left = 24
Top = 71
Width = 79
Height = 13
Caption = 'Access Code:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object lblVerifyCode: TLabel
Left = 24
Top = 96
Width = 70
Height = 13
Caption = 'Verify Code:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object lblDUZ: TLabel
Left = 48
Top = 176
Width = 26
Height = 13
Caption = 'DUZ:'
end
object lblName: TLabel
Left = 48
Top = 216
Width = 31
Height = 13
Caption = 'Name:'
end
object lblDTime: TLabel
Left = 48
Top = 256
Width = 34
Height = 13
Caption = 'DTime:'
end
object lblUserName: TLabel
Left = 48
Top = 288
Width = 56
Height = 13
Caption = 'User Name:'
end
object lblServer: TLabel
Left = 24
Top = 21
Width = 42
Height = 13
Caption = 'Server:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object lblListenerPort: TLabel
Left = 24
Top = 46
Width = 73
Height = 13
Caption = 'ListenerPort:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object edtDUZ: TEdit
Left = 112
Top = 168
Width = 233
Height = 21
TabOrder = 3
end
object edtName: TEdit
Left = 112
Top = 208
Width = 233
Height = 21
TabOrder = 2
end
object edtDTime: TEdit
Left = 112
Top = 248
Width = 233
Height = 21
TabOrder = 1
end
object edtUserName: TEdit
Left = 112
Top = 280
Width = 233
Height = 21
TabOrder = 0
end
object btnConnect: TButton
Left = 175
Top = 128
Width = 75
Height = 25
Caption = 'Connect'
Default = True
TabOrder = 8
OnClick = btnConnectClick
end
object edtAccessCode: TEdit
Left = 112
Top = 66
Width = 249
Height = 21
PasswordChar = '*'
TabOrder = 6
end
object edtVerifyCode: TEdit
Left = 112
Top = 91
Width = 249
Height = 21
PasswordChar = '*'
TabOrder = 7
end
object btnExit: TButton
Left = 174
Top = 312
Width = 75
Height = 25
Caption = 'Exit'
TabOrder = 9
OnClick = btnExitClick
end
object edtServer: TEdit
Left = 112
Top = 16
Width = 249
Height = 21
TabOrder = 4
end
object edtListenerPort: TEdit
Left = 112
Top = 41
Width = 105
Height = 21
TabOrder = 5
end
object Memo1: TMemo
Left = 384
Top = 16
Width = 153
Height = 233
Lines.Strings = (
'This application provides an '
'example of a silent login. The '
'server, Listener Port, Access '
'Code, and Verify Code need to '
'be filled in - these data would '
'be supplied in some manner for '
'a silent login (Division can also '
'be supplied for a multidivision '
'individual). After fillng in the '
'information enter Return or '
'click on the Connect button. '
'The connection should be '
'made without the broker login '
'form appearing. User '
'information will be filled in for '
'the logged in user.')
TabOrder = 10
end
object MainMenu1: TMainMenu
Left = 24
Top = 144
object mnuFile: TMenuItem
Caption = '&File'
object mnuFileExit: TMenuItem
Caption = 'E&xit'
OnClick = mnuFileExitClick
end
end
object mnuHelp: TMenuItem
Caption = '&Help'
object mnuHelpAbout: TMenuItem
Caption = '&About'
OnClick = mnuHelpAboutClick
end
end
end
object brkrRPCB: TSharedRPCBroker
ClearParameters = True
ClearResults = True
ListenerPort = 0
RpcVersion = '0'
LogIn.Mode = lmAVCodes
LogIn.PromptDivision = False
OldConnectionOnly = False
AllowShared = True
RPCTimeLimit = 30
Left = 32
Top = 312
end
end

View File

@ -0,0 +1,129 @@
unit fXWBAVCodes;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Trpcb, RpcSLogin, Menus, frmVistAAbout, SharedRPCBroker;
type
TForm1 = class(TForm)
edtDUZ: TEdit;
edtName: TEdit;
edtDTime: TEdit;
edtUserName: TEdit;
btnConnect: TButton;
edtAccessCode: TEdit;
edtVerifyCode: TEdit;
lblAccessCode: TLabel;
lblVerifyCode: TLabel;
btnExit: TButton;
lblDUZ: TLabel;
lblName: TLabel;
lblDTime: TLabel;
lblUserName: TLabel;
edtServer: TEdit;
edtListenerPort: TEdit;
lblServer: TLabel;
lblListenerPort: TLabel;
Memo1: TMemo;
MainMenu1: TMainMenu;
mnuFile: TMenuItem;
mnuFileExit: TMenuItem;
mnuHelp: TMenuItem;
mnuHelpAbout: TMenuItem;
brkrRPCB: TSharedRPCBroker;
procedure btnConnectClick(Sender: TObject);
procedure btnExitClick(Sender: TObject);
procedure mnuFileExitClick(Sender: TObject);
procedure mnuHelpAboutClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Login: TVistaLogin;
implementation
{$R *.DFM}
procedure TForm1.btnConnectClick(Sender: TObject);
var
NChars: Cardinal;
NameBuffer: PChar;
begin
if btnConnect.Caption = 'Connect' then
begin
{ check data there for silent login }
if (edtAccessCode.Text = '') or
(edtVerifyCode.Text = '') or
(edtServer.Text = '') or
(edtListenerPort.Text = '') then
ShowMessage('The four Bold edit boxes must be filled in before the connection can be made.')
else
begin
{ set up for silent login }
with BrkrRPCB do
begin
Login.AccessCode := edtAccessCode.Text;
Login.VerifyCode := edtVerifyCode.Text;
Server := edtServer.Text;
ListenerPort := StrToInt(edtListenerPort.Text);
KernelLogin := False;
Login.Mode := lmAVCodes;
Login.PromptDivision := True;
Connected := True;
if Connected = True then
begin
GetUserInfo(brkrRPCB);
edtDUZ.Text := User.DUZ;
edtName.Text := User.Name;
edtDTime.Text := User.DTime;
{ Get local username as well }
NChars := 0;
GetUserName(nil,NChars);
NameBuffer := StrAlloc(NChars);
if GetUserName(NameBuffer, NChars) then
edtUserName.Text := StrPas(NameBuffer)
else
edtUserName.Text := 'Can''t get name';
btnConnect.Caption := 'Disconnect';
btnExit.Default := True;
btnConnect.Default := False;
end; // if Connected = True
end; // with brkrRPCB do
end; // else
end // if btnConnect.Caption
else
begin
brkrRPCB.Connected := False;
btnConnect.Caption := 'Connect';
end;
edtAccessCode.Text := '';
edtVerifyCode.Text := '';
Application.ProcessMessages;
end;
procedure TForm1.btnExitClick(Sender: TObject);
begin
halt;
end;
procedure TForm1.mnuFileExitClick(Sender: TObject);
begin
halt;
end;
procedure TForm1.mnuHelpAboutClick(Sender: TObject);
begin
ShowAboutBox;
end;
end.

View File

@ -0,0 +1,138 @@
object Form1: TForm1
Left = 230
Top = 122
Width = 503
Height = 319
Caption =
'XWBAppHandle1 -- use of lmAppHandle to start a second applicatio' +
'n'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = True
PixelsPerInch = 96
TextHeight = 13
object lblOtherProgram: TLabel
Left = 44
Top = 176
Width = 71
Height = 13
Caption = 'Other Program:'
end
object lblOptional: TLabel
Left = 52
Top = 192
Width = 45
Height = 13
Caption = '(Optional)'
end
object lblWithFull: TLabel
Left = 124
Top = 200
Width = 232
Height = 13
Caption = 'With Full Directory Path if not on the System Path'
end
object btnConnect: TButton
Left = 85
Top = 232
Width = 75
Height = 25
Caption = '&Connect'
TabOrder = 0
OnClick = btnConnectClick
end
object btnStartApp2: TButton
Left = 210
Top = 232
Width = 75
Height = 25
Caption = 'Start App2'
TabOrder = 1
OnClick = btnStartApp2Click
end
object edtOtherProgram: TEdit
Left = 124
Top = 168
Width = 233
Height = 21
TabOrder = 2
end
object Memo1: TMemo
Left = 31
Top = 8
Width = 433
Height = 153
Lines.Strings = (
'This application can be used to start other programs, including ' +
'ones that use the '
'RPCBroker for connection to a server using a server generated to' +
'ken.'
''
'To connect with the server, simply press the connect button to s' +
'elect a server/listener port '
'combination, then sign in. After you are signed in, you can sta' +
'rt another Broker application '
'(XWBAppHandle2) by simply clicking on the "Start App2" button (w' +
'ith the Other Program '
'edit box empty of text).'
''
'A program such as Notepad with or without command line arguments' +
', can be started at '
'any time by entering the name (and arguments if any) in the Othe' +
'r Program edit box, then '
'clicking on the Start App2 button.'
'')
TabOrder = 3
end
object btnExit: TButton
Left = 335
Top = 232
Width = 75
Height = 25
Caption = 'Exit'
TabOrder = 4
OnClick = btnExitClick
end
object MainMenu1: TMainMenu
Left = 8
Top = 184
object File1: TMenuItem
Caption = '&File'
object Exit1: TMenuItem
Caption = '&E&xit'
OnClick = Exit1Click
end
end
object Help1: TMenuItem
Caption = '&Help'
object About1: TMenuItem
Caption = '&About'
OnClick = About1Click
end
end
end
object brkrRPCB: TSharedRPCBroker
ClearParameters = True
ClearResults = True
ListenerPort = 0
RpcVersion = '0'
LogIn.Mode = lmAVCodes
LogIn.PromptDivision = False
AllowShared = True
RPCTimeLimit = 30
Left = 32
Top = 232
end
end

View File

@ -0,0 +1,99 @@
unit fXWBAppHandle1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, RpcSlogin, Trpcb, RpcConf1, frmVistAAbout, Menus,
SharedRPCBroker;
type
TForm1 = class(TForm)
btnConnect: TButton;
btnStartApp2: TButton;
edtOtherProgram: TEdit;
lblOtherProgram: TLabel;
lblOptional: TLabel;
lblWithFull: TLabel;
Memo1: TMemo;
btnExit: TButton;
MainMenu1: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
brkrRPCB: TSharedRPCBroker;
procedure btnConnectClick(Sender: TObject);
procedure btnStartApp2Click(Sender: TObject);
procedure btnExitClick(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.btnConnectClick(Sender: TObject);
var
Server, Port: String;
begin
if btnConnect.Caption = '&Connect' then
begin
GetServerInfo(Server, Port);
brkrRPCB.Server := Server;
brkrRPCB.ListenerPort := StrToInt(Port);
brkrRPCB.Connected := True;
if brkrRPCB.Connected then
btnConnect.Caption := '&Disconnect';
end
else
begin
brkrRPCB.Connected := False;
btnConnect.Caption := '&Connect';
end;
end;
procedure TForm1.btnStartApp2Click(Sender: TObject);
var
CurDir: String;
begin
if edtOtherProgram.Text <> '' then
begin
CurDir := edtOtherProgram.Text;
StartProgSLogin(CurDir,nil);
end
else
begin
{ Use Test2.exe and expecting it to be in the startup directory for the current application}
CurDir := ExtractFilePath(ParamStr(0)) + 'XWBAppHandle2.exe';
{ Now start application with silent login }
StartProgSLogin(CurDir, brkrRPCB);
end;
end;
procedure TForm1.btnExitClick(Sender: TObject);
begin
halt;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Halt;
end;
procedure TForm1.About1Click(Sender: TObject);
begin
ShowAboutBox;
end;
end.

View File

@ -0,0 +1,133 @@
object Form1: TForm1
Left = 201
Top = 168
Width = 460
Height = 279
Caption = 'XWBAppHandle2 - Started by lmAppHandle (RPCBroker)'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = True
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object lblDUZ: TLabel
Left = 54
Top = 17
Width = 23
Height = 13
Caption = 'DUZ'
end
object lblName: TLabel
Left = 54
Top = 51
Width = 28
Height = 13
Caption = 'Name'
end
object lblDTime: TLabel
Left = 54
Top = 84
Width = 31
Height = 13
Caption = 'DTime'
end
object lblDivision: TLabel
Left = 54
Top = 118
Width = 37
Height = 13
Caption = 'Division'
end
object lblUserName: TLabel
Left = 54
Top = 152
Width = 50
Height = 13
Caption = 'UserName'
end
object edtDuz: TEdit
Left = 118
Top = 8
Width = 280
Height = 21
TabStop = False
TabOrder = 0
end
object edtName: TEdit
Left = 118
Top = 42
Width = 280
Height = 21
TabStop = False
TabOrder = 2
end
object edtDTime: TEdit
Left = 118
Top = 76
Width = 280
Height = 21
TabStop = False
TabOrder = 3
end
object edtUserName: TEdit
Left = 118
Top = 143
Width = 280
Height = 21
TabStop = False
TabOrder = 4
end
object btnClose: TButton
Left = 188
Top = 192
Width = 75
Height = 25
Caption = 'Close'
Default = True
TabOrder = 1
OnClick = btnCloseClick
end
object edtDivision: TEdit
Left = 118
Top = 109
Width = 280
Height = 21
TabStop = False
TabOrder = 5
end
object MainMenu1: TMainMenu
Left = 8
Top = 40
object File1: TMenuItem
Caption = '&File'
object Exit1: TMenuItem
Caption = 'E&xit'
OnClick = Exit1Click
end
end
object About1: TMenuItem
Caption = '&Help'
object About2: TMenuItem
Caption = '&About'
OnClick = About2Click
end
end
end
object brkrRPCB: TSharedRPCBroker
ClearParameters = True
ClearResults = True
ListenerPort = 0
RpcVersion = '0'
LogIn.Mode = lmAVCodes
LogIn.PromptDivision = False
AllowShared = True
RPCTimeLimit = 30
Left = 24
Top = 192
end
end

View File

@ -0,0 +1,102 @@
unit fXWBAppHandle2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Trpcb, RpcSLogin, RpcConf1, frmVistAAbout, Menus,
SharedRPCBroker;
type
TForm1 = class(TForm)
edtDuz: TEdit;
edtName: TEdit;
edtDTime: TEdit;
edtUserName: TEdit;
btnClose: TButton;
edtDivision: TEdit;
lblDUZ: TLabel;
lblName: TLabel;
lblDTime: TLabel;
lblDivision: TLabel;
lblUserName: TLabel;
MainMenu1: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
About1: TMenuItem;
About2: TMenuItem;
brkrRPCB: TSharedRPCBroker;
procedure FormCreate(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure About2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Login: TVistaLogin;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
NChars: Cardinal;
NameBuffer: PChar;
Server, Port: String;
begin
{ check for silent login data on command line }
if not CheckCmdLine(brkrRPCB) then
begin // Couldn't log on via command line give choice
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
begin
GetServerInfo(Server, Port);
brkrRPCB.Server := Server;
brkrRPCB.ListenerPort := StrToInt(Port);
Caption := 'XWBAppHandle2 - Started by normal sign-on'
end
else
halt;
end;
{ Get and display information on logged in user }
GetUserInfo(brkrRPCB);
edtDUZ.Text := brkrRPCB.User.DUZ;
edtName.Text := brkrRPCB.User.Name;
edtDTime.Text := brkrRPCB.User.DTime;
edtDivision.Text := brkrRPCB.User.Division;
{also show local username }
NChars := 0;
GetUserName(nil,NChars);
NameBuffer := StrAlloc(NChars);
if GetUserName(NameBuffer, NChars) then
edtUserName.Text := NameBuffer
else
edtUserName.Text := 'Can''t get name';
end;
procedure TForm1.btnCloseClick(Sender: TObject);
begin
halt;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Halt;
end;
procedure TForm1.About2Click(Sender: TObject);
begin
ShowAboutBox;
end;
end.

View File

@ -0,0 +1,178 @@
object frmXWBOnFail: TfrmXWBOnFail
Left = 207
Top = 127
Width = 509
Height = 343
Caption = 'XWBOnFail - Error Handling Demo (XWB*1.1*40 SharedRPCBroker)'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object lblLogin_ErrorText: TLabel
Left = 24
Top = 40
Width = 75
Height = 13
Caption = 'Login_ErrorText'
end
object btnConnect: TButton
Left = 213
Top = 256
Width = 75
Height = 25
Caption = 'Connect'
TabOrder = 0
OnClick = btnConnectClick
end
object rgrSelectAction: TRadioGroup
Left = 268
Top = 64
Width = 217
Height = 137
Caption = 'Select Action'
ItemIndex = 1
Items.Strings = (
'Use OnRPCBFailure property routine'
'Show Message Boxes'
'Capture Text Only')
TabOrder = 1
end
object btnExit: TButton
Left = 410
Top = 256
Width = 75
Height = 25
Caption = 'Exit'
TabOrder = 2
OnClick = btnExitClick
end
object Memo1: TMemo
Left = 16
Top = 64
Width = 217
Height = 169
Lines.Strings = (
'This is an example application to illustrate '
'the effects of TRPCBroker properties '
'related to Error Handling.'
''
'The OnRPCBFailure property can be set '
'to a procedure to handle errors without '
'user interaction. In the sample included '
'here, the error handler will save the error '
'message and a date/time stamp to a file '
'named "Error.Log" in the same directory '
'with the application program. YOU WILL '
'NOT SEE AN ERROR MESSAGE IN '
'THIS CASE!'
''
'If OnRPCBFailure property is not '
'assigned to a procedure, errors by default '
'would be shown in a message box '
'created by the TRPCBroker component. '
'This behavior is controlled by the '
'ShowErrorMsgs property, with a default '
'of semShow (Show Message Boxes). '
''
'If the ShowErrorMsgs property is set to '
'semRaise (Don'#39't Show Message Boxes), '
'the error will be permitted to be handled '
'by a higher part of the application. In '
'most cases this will produce an error '
'dialog box generated by the system in '
'general.'
''
'If the ShowErrorMsgs property is set to '
'semSet (Capture Text Only), there will be '
'no error action taken except for the '
'setting of error messages into the '
'RPCBError and/or Login.ErrorText '
'properties. In this case, the application '
'MUST check these properties '
'immediately after a call to the RPCBroker '
'to determine whether any errors were '
'encountered and to determine the action '
'to be taken.'
''
'Select the type of behavior desired by '
'clicking on one of the options to the right.'
''
'Then press Connect and either cancel '
'during the log-in dialog or generate an '
'error in some other manner. If you are '
'connected, the button will change to '
'Disconnect and you can click on it to '
'disconnect from the server.'
''
'Checking the check box "Use Silent Bad '
'Access/Verify" to the left will set the '
'AccessVerifyCodes property to '
#39'monkeysee;monkeydo'#39' which will cause '
'a silent login attempt and fails.'
'')
ScrollBars = ssVertical
TabOrder = 3
end
object edtErrorText: TEdit
Left = 8
Top = 8
Width = 473
Height = 21
TabOrder = 4
Text = 'RPCBroker_RPCBError property'
end
object edtLoginError: TEdit
Left = 104
Top = 32
Width = 225
Height = 21
TabOrder = 5
Text = 'RPCBroker_Login_ErrorText Property'
end
object cbxBadAccess: TCheckBox
Left = 16
Top = 256
Width = 169
Height = 17
Caption = 'Use Silent Bad Access/Verify'
TabOrder = 6
end
object MainMenu1: TMainMenu
Left = 112
Top = 8
object File1: TMenuItem
Caption = '&File'
object Exit1: TMenuItem
Caption = 'E&xit'
OnClick = Exit1Click
end
end
object Help1: TMenuItem
Caption = '&Help'
object About1: TMenuItem
Caption = '&About'
OnClick = About1Click
end
end
end
object RPCB: TSharedRPCBroker
ClearParameters = True
ClearResults = True
ListenerPort = 0
RpcVersion = '0'
LogIn.Mode = lmAVCodes
LogIn.PromptDivision = False
OldConnectionOnly = False
AllowShared = True
RPCTimeLimit = 30
Left = 8
Top = 224
end
end

View File

@ -0,0 +1,121 @@
unit fXWBOnFail;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Trpcb, Rpcconf1, ExtCtrls, frmVistAAbout, Menus,
SharedRPCBroker;
type
TfrmXWBOnFail = class(TForm)
btnConnect: TButton;
rgrSelectAction: TRadioGroup;
btnExit: TButton;
Memo1: TMemo;
edtErrorText: TEdit;
edtLoginError: TEdit;
lblLogin_ErrorText: TLabel;
cbxBadAccess: TCheckBox;
MainMenu1: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
RPCB: TSharedRPCBroker;
procedure btnConnectClick(Sender: TObject);
procedure btnExitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure MyErrorHandler(RPCBroker: TRPCBroker);
end;
var
frmXWBOnFail: TfrmXWBOnFail;
implementation
{$R *.DFM}
procedure TfrmXWBOnFail.MyErrorHandler(RPCBroker: TRPCBroker);
var
ErrorText: String;
Path: String;
StrLoc: TStringList;
NowVal: TDateTime;
begin
NowVal := Now;
ErrorText := RPCB.RPCBError;
StrLoc := TStringList.Create;
Path := ExtractFilePath(Application.ExeName);
Path := Path + 'Error.Log';
if FileExists(Path) then
StrLoc.LoadFromFile(Path);
StrLoc.Add(FormatDateTime('mm/dd/yyyy hh:mm:ss ',NowVal) + ErrorText);
StrLoc.SaveToFile(Path);
end;
procedure TfrmXWBOnFail.btnConnectClick(Sender: TObject);
begin
if btnConnect.Caption = 'Connect' then
begin
edtErrorText.Text := ''; // Clear out old values
edtLoginError.Text := '';
RPCB.AccessVerifyCodes := '';
RPCB.KernelLogIn := True;
if cbxBadAccess.Checked then
RPCB.AccessVerifyCodes := 'monkeysee;monkeydo';
RPCB.OnRPCBFailure := nil;
RPCB.ShowErrorMsgs := semRaise;
case rgrSelectAction.ItemIndex of //
0: RPCB.OnRPCBFailure := MyErrorHandler;
1: RPCB.ShowErrorMsgs := semRaise;
2: RPCB.ShowErrorMsgs := semQuiet;
end; // case
try
RPCB.Connected := True;
if RPCB.Connected then
btnConnect.Caption := 'Disconnect';
finally
edtErrorText.Text := RPCB.RPCBError;
edtLoginError.Text := RPCB.LogIn.ErrorText;
end;
end
else
begin
RPCB.Connected := False;
btnConnect.Caption := 'Connect';
end;
end;
procedure TfrmXWBOnFail.btnExitClick(Sender: TObject);
begin
halt;
end;
procedure TfrmXWBOnFail.FormCreate(Sender: TObject);
var
Server: String;
Port: String;
begin
GetServerInfo(Server, Port);
RPCB.Server := Server;
RPCB.ListenerPort := StrToInt(Port);
end;
procedure TfrmXWBOnFail.Exit1Click(Sender: TObject);
begin
Halt;
end;
procedure TfrmXWBOnFail.About1Click(Sender: TObject);
begin
ShowAboutBox;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,267 @@
unit frmVistAAbout;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, jpeg, jconsts, Dialogs;
TYPE
TInteger8 = Int64;
type
TfrmVistAAbout = class(TForm)
Panel1: TPanel;
VistaLogo: TImage;
lblProductName: TLabel;
lblVersion: TLabel;
lblGovStatement: TLabel;
OKButton: TButton;
lblCRC: TLabel;
Memo1: TMemo;
lblDate: TLabel;
ProgramIcon: TImage;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure getfileinfo(var Version: String; var ProductName: String); virtual;
end;
procedure ShowAboutBox;
implementation
{$R *.DFM}
CONST
table: ARRAY[0..255] OF DWORD =
($00000000, $77073096, $EE0E612C, $990951BA,
$076DC419, $706AF48F, $E963A535, $9E6495A3,
$0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
$09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
$1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
$1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
$136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
$14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
$3B6E20C8, $4C69105E, $D56041E4, $A2677172,
$3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
$35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940,
$32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
$26D930AC, $51DE003A, $C8D75180, $BFD06116,
$21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
$2802B89E, $5F058808, $C60CD9B2, $B10BE924,
$2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
$76DC4190, $01DB7106, $98D220BC, $EFD5102A,
$71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
$7807C9A2, $0F00F934, $9609A88E, $E10E9818,
$7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
$6B6B51F4, $1C6C6162, $856530D8, $F262004E,
$6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
$65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C,
$62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
$4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
$4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
$4369E96A, $346ED9FC, $AD678846, $DA60B8D0,
$44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
$5005713C, $270241AA, $BE0B1010, $C90C2086,
$5768B525, $206F85B3, $B966D409, $CE61E49F,
$5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4,
$59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
$EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
$EAD54739, $9DD277AF, $04DB2615, $73DC1683,
$E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
$E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
$F00F9344, $8708A3D2, $1E01F268, $6906C2FE,
$F762575D, $806567CB, $196C3671, $6E6B06E7,
$FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC,
$F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
$D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252,
$D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
$D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
$DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
$CB61B38C, $BC66831A, $256FD2A0, $5268E236,
$CC0C7795, $BB0B4703, $220216B9, $5505262F,
$C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
$C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
$9B64C2B0, $EC63F226, $756AA39C, $026D930A,
$9C0906A9, $EB0E363F, $72076785, $05005713,
$95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38,
$92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
$86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E,
$81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
$88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
$8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
$A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
$A7672661, $D06016F7, $4969474D, $3E6E77DB,
$AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
$A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
$BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
$BAD03605, $CDD70693, $54DE5729, $23D967BF,
$B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
$B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
// Use CalcCRC32 as a procedure so CRCValue can be passed in but
// also returned. This allows multiple calls to CalcCRC32 for
// the "same" CRC-32 calculation.
PROCEDURE CalcCRC32 (p: pointer; ByteCount: DWORD; VAR CRCValue: DWORD);
// The following is a little cryptic (but executes very quickly).
// The algorithm is as follows:
// 1. exclusive-or the input byte with the low-order byte of
// the CRC register to get an INDEX
// 2. shift the CRC register eight bits to the right
// 3. exclusive-or the CRC register with the contents of
// Table[INDEX]
// 4. repeat steps 1 through 3 for all bytes
VAR
i: DWORD;
q: ^BYTE;
BEGIN
q := p;
FOR i := 0 TO ByteCount-1 DO BEGIN
CRCvalue := (CRCvalue SHR 8) XOR
Table[ q^ XOR (CRCvalue AND $000000FF) ];
INC(q)
END
END {CalcCRC32};
// The CRC-32 value calculated here matches the one from the PKZIP program.
// Use MemoryStream to read file in binary mode.
PROCEDURE CalcFileCRC32 (FromName: STRING; VAR CRCvalue: DWORD;
VAR TotalBytes: TInteger8;
VAR error: WORD);
VAR
Stream: TMemoryStream;
BEGIN
error := 0;
CRCValue := $FFFFFFFF;
Stream := TMemoryStream.Create;
TRY
TRY
Stream.LoadFromFile(FromName);
IF Stream.Size > 0
THEN CalcCRC32 (Stream.Memory, Stream.Size, CRCvalue)
EXCEPT
ON E: EReadError DO
error := 1
END;
CRCvalue := NOT CRCvalue;
TotalBytes := Stream.Size
FINALLY
Stream.Free
END;
END {CalcFileCRC32};
procedure TfrmVistAAbout.FormCreate(Sender: TObject);
var
CRC32: DWord;
TotalBytes: Int64;
Error: Word;
Text: String;
Version: String;
ProductName: String;
begin
CalcFileCRC32(Application.ExeName, CRC32, TotalBytes, Error);
lblCRC.Caption := 'CRC: ' + IntToHex(CRC32,8);
Text := Application.ExeName;
while pos('\',Text) > 0 do
begin
Text := copy(Text,pos('\',Text)+1,Length(Text));
end; // while
Text := copy(Text,1,Length(Text)-4);
Caption := 'About ' + Text;
getfileinfo(Version, ProductName);
lblProductName.Caption := ProductName;
lblVersion.Caption := 'Version: ' + Version;
lblProductName.Width := Panel1.Width-10;
lblGovStatement.Width := Panel1.Width-10;
if ProgramIcon.Picture.Graphic = nil then
begin
VistALogo.Left := (Panel1.Width - VistALogo.Width) div 2;
end;
end;
procedure TfrmVistAAbout.GetFileInfo(var Version: String; var ProductName: String);
var
VerInfoSize: DWORD; // holds the size of the version info resource
GetInfoSizeJunk: DWORD; // a junk variable, its value is ignored
VersionInfo: Pointer; // points to the version info resource
Translation: Pointer; // holds version info translation table
InfoPointer: Pointer; // a pointer to version information
VersionInfoSize: UINT; // holds the size of version information
VersionValue: string; // holds the version info request string
SearchRec: TSearchRec;
DateTimeVal: TDateTime;
WriteTime: Integer;
begin
{retrieve the size of the version information resource, if one exists}
VerInfoSize := GetFileVersionInfoSize(PChar(Application.ExeName),
GetInfoSizeJunk);
{if there was a version information resource available...}
if VerInfoSize>0 then
begin
{retrieve enough memory to hold the version resource}
GetMem(VersionInfo, VerInfoSize);
{retrieve the version resource for the selected file}
GetFileVersionInfo(PChar(Application.ExeName), 0,
VerInfoSize, VersionInfo);
{retrieve a pointer to the translation table}
VerQueryValue(VersionInfo, '\\VarFileInfo\\Translation',
Translation, VersionInfoSize);
{initialize the version value request string}
VersionValue :='\\StringFileInfo\\'+
IntToHex(LoWord(LongInt(Translation^)),4)+
IntToHex(HiWord(LongInt(Translation^)),4)+
'\\';
{retrieve and display the file version}
VerQueryValue(VersionInfo, PChar(VersionValue+'FileVersion'), InfoPointer,
VersionInfoSize);
Version := string(PChar(InfoPointer));
{retrieve and display the product name}
VerQueryValue(VersionInfo, PChar(VersionValue+'ProductName'), InfoPointer,
VersionInfoSize);
ProductName := string(PChar(InfoPointer));
{free the version resource memory}
FreeMem(VersionInfo, VerInfoSize);
end
else
begin
Version := 'Not in File';
ProductName := 'Not Identified In File';
end;
if findfirst(Application.ExeName, faAnyFile, SearchRec) = 0 then
begin
WriteTime := SearchRec.Time;
DateTimeVal := FileDateToDateTime(WriteTime);
lblDate.Caption := FormatDateTime('mmmm dd, yyyy hh:nn',DateTimeVal);
end;
end;
procedure ShowAboutBox;
begin
with TfrmVistAAbout.Create(Application) do
try
ShowModal;
finally
free;
end;
end;
end.

BIN
BDK32/ServerList.exe Normal file

Binary file not shown.

BIN
BDK32/Serverlist.hlp Normal file

Binary file not shown.

View File

@ -0,0 +1,867 @@
unit RPCSharedBrokerSessionMgr1_TLB;
// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //
// PASTLWTR : $Revision: 1.88.1.0.1.0 $
// File generated on 1/25/2002 11:58:49 AM from Type Library described below.
// *************************************************************************//
// NOTE:
// Items guarded by $IFDEF_LIVE_SERVER_AT_DESIGN_TIME are used by properties
// which return objects that may need to be explicitly created via a function
// call prior to any access via the property. These items have been disabled
// in order to prevent accidental use from within the object inspector. You
// may enable them by defining LIVE_SERVER_AT_DESIGN_TIME or by selectively
// removing them from the $IFDEF blocks. However, such items must still be
// programmatically created via a method of the appropriate CoClass before
// they can be used.
// ************************************************************************ //
// Type Lib: D:\Development\RPCSharedBroker\Exe1\RPCSharedBrokerSessionMgr1.exe (1)
// IID\LCID: {1F7D1EB0-E54F-46F0-B485-2D56743EBB70}\0
// Helpfile:
// DepndLst:
// (1) v2.0 stdole, (C:\WINNT\System32\stdole2.tlb)
// (2) v4.0 StdVCL, (C:\WINNT\System32\STDVCL40.DLL)
// Errors:
// Error creating palette bitmap of (TSharedBroker) : Invalid GUID format
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
interface
uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL;
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
RPCSharedBrokerSessionMgr1MajorVersion = 1;
RPCSharedBrokerSessionMgr1MinorVersion = 0;
LIBID_RPCSharedBrokerSessionMgr1: TGUID = '{1F7D1EB0-E54F-46F0-B485-2D56743EBB70}';
IID_ISharedBroker: TGUID = '{E1D9A5E6-B7C6-40AD-AC34-6A3E12BDC328}';
DIID_ISharedBrokerEvents: TGUID = '{CBEA7167-4F9B-465A-B82E-4CEBDF933C35}';
CLASS_SharedBroker: TGUID = '{EB44A5CD-1871-429F-A5BC-19C71B722182}';
// *********************************************************************//
// Declaration of Enumerations defined in Type Library
// *********************************************************************//
// Constants for enum ISharedBrokerErrorCode
type
ISharedBrokerErrorCode = TOleEnum;
const
GeneralFailure = $00000000;
Success = $00000001;
UniqueRpcIdDoesNotExist = $00000002;
UniqueClientIdDoesNotExist = $00000003;
RpcHistoryIndexOutOfRange = $00000004;
RpcHistoryNotEnabled = $00000005;
CouldNotSetContext = $00000006;
CouldNotConnect = $00000007;
ClientIndexOutOfRange = $00000008;
NilClientPointer = $00000009;
ConnectionIndexOutOfRange = $0000000A;
// Constants for enum IRegistryRootEnum
type
IRegistryRootEnum = TOleEnum;
const
HKCR = $00000000;
HKCU = $00000001;
HKLM = $00000002;
HKU = $00000003;
HKCC = $00000004;
HKDD = $00000005;
// Constants for enum ISharedBrokerConnection
type
ISharedBrokerConnection = TOleEnum;
const
Failed = $00000000;
New = $00000001;
Shared = $00000002;
Debug = $00000003;
// Constants for enum ISharedBrokerClient
type
ISharedBrokerClient = TOleEnum;
const
BrokerClient = $00000000;
DebuggerClient = $00000001;
// Constants for enum ISharedBrokerShowErrorMsgs
type
ISharedBrokerShowErrorMsgs = TOleEnum;
const
isemRaise = $00000000;
isemQuiet = $00000001;
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
ISharedBroker = interface;
ISharedBrokerDisp = dispinterface;
ISharedBrokerEvents = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
SharedBroker = ISharedBroker;
// *********************************************************************//
// Interface: ISharedBroker
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {E1D9A5E6-B7C6-40AD-AC34-6A3E12BDC328}
// *********************************************************************//
ISharedBroker = interface(IDispatch)
['{E1D9A5E6-B7C6-40AD-AC34-6A3E12BDC328}']
function BrokerConnect(const ClientName: WideString; ConnectionType: ISharedBrokerClient;
const ServerPort: WideString; WantDebug: WordBool;
AllowShared: WordBool; KernelLogin: WordBool;
ShowErrMsgs: ISharedBrokerShowErrorMsgs; RpcTimeLim: SYSINT;
var LoginStr: WideString; out UniqueClientIId: SYSINT;
out ErrorMsg: WideString): ISharedBrokerErrorCode; safecall;
function BrokerDisconnect: ISharedBrokerErrorCode; safecall;
function BrokerSetContext(const OptionName: WideString): ISharedBrokerErrorCode; safecall;
function BrokerCall(const RpcName: WideString; const RpcParams: WideString;
RpcTimeLimit: Integer; out RpcResults: WideString;
out UniqueRpcCallId: Integer): ISharedBrokerErrorCode; safecall;
function ReadRegDataDefault(Root: IRegistryRootEnum; const Key: WideString;
const Name: WideString; const Default: WideString;
out RegResult: WideString): ISharedBrokerErrorCode; safecall;
function Get_RpcVersion: WideString; safecall;
procedure Set_RpcVersion(const version: WideString); safecall;
function Get_RpcHistoryEnabled: WordBool; safecall;
procedure Set_RpcHistoryEnabled(enabled: WordBool); safecall;
function Get_PerClientRpcHistoryLimit: Integer; safecall;
procedure Set_PerClientRpcHistoryLimit(limit: Integer); safecall;
function GetRpcHistoryCountForClient(UniqueClientId: Integer; out rpcHistoryCount: Integer): ISharedBrokerErrorCode; safecall;
function GetClientIdAndNameFromIndex(clientIndex: Integer; out UniqueClientId: Integer;
out ClientName: WideString): ISharedBrokerErrorCode; safecall;
function LogoutConnectedClients(logoutTimeLimit: Integer): ISharedBrokerErrorCode; safecall;
function GetClientNameFromUniqueClientId(UniqueClientId: Integer; out ClientName: WideString): ISharedBrokerErrorCode; safecall;
function GetActiveBrokerConnectionIndexCount(out connectionIndexCount: Integer): ISharedBrokerErrorCode; safecall;
function GetActiveBrokerConnectionInfo(connectionIndex: Integer;
out connectedServerIp: WideString;
out connectedServerPort: Integer;
out lastContext: WideString): ISharedBrokerErrorCode; safecall;
function GetActiveBrokerConnectionIndexFromUniqueClientId(UniqueClientId: Integer;
out connectionIndex: Integer): ISharedBrokerErrorCode; safecall;
function GetRpcCallFromHistory(uniqueRpcId: Integer; out UniqueClientId: Integer;
out brokerContext: WideString; out RpcName: WideString;
out RpcParams: WideString; out rpcResult: WideString;
out rpcStartDateTime: Double; out rpcDuration: Integer): ISharedBrokerErrorCode; safecall;
function GetRpcCallFromHistoryIndex(UniqueClientId: Integer; rpcCallIndex: Integer;
out uniqueRpcId: Integer; out brokerContext: WideString;
out RpcName: WideString; out RpcParams: WideString;
out rpcResult: WideString; out rpcStartDateTime: Double;
out rpcDuration: Integer): ISharedBrokerErrorCode; safecall;
function GetRpcClientIdFromHistory(uniqueRpcId: Integer; out UniqueClientId: Integer;
out ClientName: WideString): ISharedBrokerErrorCode; safecall;
function GetConnectedClientCount(out connectedClientCount: Integer): ISharedBrokerErrorCode; safecall;
function Get_CurrentContext: WideString; safecall;
function Get_User: WideString; safecall;
function Get_Login: WideString; safecall;
procedure Set_Login(const Value: WideString); safecall;
function Get_RpcbError: WideString; safecall;
function Get_Socket: Integer; safecall;
function Get_KernelLogin: WordBool; safecall;
procedure Set_KernelLogin(Value: WordBool); safecall;
function Get_ShowErrorMsgs: ISharedBrokerShowErrorMsgs; safecall;
procedure Set_ShowErrorMsgs(Value: ISharedBrokerShowErrorMsgs); safecall;
property RpcVersion: WideString read Get_RpcVersion write Set_RpcVersion;
property RpcHistoryEnabled: WordBool read Get_RpcHistoryEnabled write Set_RpcHistoryEnabled;
property PerClientRpcHistoryLimit: Integer read Get_PerClientRpcHistoryLimit write Set_PerClientRpcHistoryLimit;
property CurrentContext: WideString read Get_CurrentContext;
property User: WideString read Get_User;
property Login: WideString read Get_Login write Set_Login;
property RpcbError: WideString read Get_RpcbError;
property Socket: Integer read Get_Socket;
property KernelLogin: WordBool read Get_KernelLogin write Set_KernelLogin;
property ShowErrorMsgs: ISharedBrokerShowErrorMsgs read Get_ShowErrorMsgs write Set_ShowErrorMsgs;
end;
// *********************************************************************//
// DispIntf: ISharedBrokerDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {E1D9A5E6-B7C6-40AD-AC34-6A3E12BDC328}
// *********************************************************************//
ISharedBrokerDisp = dispinterface
['{E1D9A5E6-B7C6-40AD-AC34-6A3E12BDC328}']
function BrokerConnect(const ClientName: WideString; ConnectionType: ISharedBrokerClient;
const ServerPort: WideString; WantDebug: WordBool;
AllowShared: WordBool; KernelLogin: WordBool;
ShowErrMsgs: ISharedBrokerShowErrorMsgs; RpcTimeLim: SYSINT;
var LoginStr: WideString; out UniqueClientIId: SYSINT;
out ErrorMsg: WideString): ISharedBrokerErrorCode; dispid 1;
function BrokerDisconnect: ISharedBrokerErrorCode; dispid 2;
function BrokerSetContext(const OptionName: WideString): ISharedBrokerErrorCode; dispid 3;
function BrokerCall(const RpcName: WideString; const RpcParams: WideString;
RpcTimeLimit: Integer; out RpcResults: WideString;
out UniqueRpcCallId: Integer): ISharedBrokerErrorCode; dispid 4;
function ReadRegDataDefault(Root: IRegistryRootEnum; const Key: WideString;
const Name: WideString; const Default: WideString;
out RegResult: WideString): ISharedBrokerErrorCode; dispid 5;
property RpcVersion: WideString dispid 7;
property RpcHistoryEnabled: WordBool dispid 6;
property PerClientRpcHistoryLimit: Integer dispid 8;
function GetRpcHistoryCountForClient(UniqueClientId: Integer; out rpcHistoryCount: Integer): ISharedBrokerErrorCode; dispid 10;
function GetClientIdAndNameFromIndex(clientIndex: Integer; out UniqueClientId: Integer;
out ClientName: WideString): ISharedBrokerErrorCode; dispid 11;
function LogoutConnectedClients(logoutTimeLimit: Integer): ISharedBrokerErrorCode; dispid 12;
function GetClientNameFromUniqueClientId(UniqueClientId: Integer; out ClientName: WideString): ISharedBrokerErrorCode; dispid 13;
function GetActiveBrokerConnectionIndexCount(out connectionIndexCount: Integer): ISharedBrokerErrorCode; dispid 14;
function GetActiveBrokerConnectionInfo(connectionIndex: Integer;
out connectedServerIp: WideString;
out connectedServerPort: Integer;
out lastContext: WideString): ISharedBrokerErrorCode; dispid 15;
function GetActiveBrokerConnectionIndexFromUniqueClientId(UniqueClientId: Integer;
out connectionIndex: Integer): ISharedBrokerErrorCode; dispid 16;
function GetRpcCallFromHistory(uniqueRpcId: Integer; out UniqueClientId: Integer;
out brokerContext: WideString; out RpcName: WideString;
out RpcParams: WideString; out rpcResult: WideString;
out rpcStartDateTime: Double; out rpcDuration: Integer): ISharedBrokerErrorCode; dispid 17;
function GetRpcCallFromHistoryIndex(UniqueClientId: Integer; rpcCallIndex: Integer;
out uniqueRpcId: Integer; out brokerContext: WideString;
out RpcName: WideString; out RpcParams: WideString;
out rpcResult: WideString; out rpcStartDateTime: Double;
out rpcDuration: Integer): ISharedBrokerErrorCode; dispid 18;
function GetRpcClientIdFromHistory(uniqueRpcId: Integer; out UniqueClientId: Integer;
out ClientName: WideString): ISharedBrokerErrorCode; dispid 19;
function GetConnectedClientCount(out connectedClientCount: Integer): ISharedBrokerErrorCode; dispid 20;
property CurrentContext: WideString readonly dispid 9;
property User: WideString readonly dispid 22;
property Login: WideString dispid 23;
property RpcbError: WideString readonly dispid 24;
property Socket: Integer readonly dispid 25;
property KernelLogin: WordBool dispid 26;
property ShowErrorMsgs: ISharedBrokerShowErrorMsgs dispid 27;
end;
// *********************************************************************//
// DispIntf: ISharedBrokerEvents
// Flags: (4096) Dispatchable
// GUID: {CBEA7167-4F9B-465A-B82E-4CEBDF933C35}
// *********************************************************************//
ISharedBrokerEvents = dispinterface
['{CBEA7167-4F9B-465A-B82E-4CEBDF933C35}']
procedure OnLogout; dispid 1;
procedure OnRpcCallRecorded(uniqueRpcId: SYSINT); dispid 2;
procedure OnClientConnect(UniqueClientId: SYSINT; Connection: ISharedBrokerConnection); dispid 3;
procedure OnClientDisconnect(UniqueClientId: SYSINT); dispid 4;
procedure OnContextChanged(connectionIndex: SYSINT; const NewContext: WideString); dispid 5;
procedure OnRPCBFailure(const ErrorText: WideString); dispid 6;
procedure OnLoginError(const ErrorText: WideString); dispid 7;
procedure OnConnectionDropped(connectionIndex: SYSINT; const ErrorText: WideString); dispid 8;
end;
// *********************************************************************//
// The Class CoSharedBroker provides a Create and CreateRemote method to
// create instances of the default interface ISharedBroker exposed by
// the CoClass SharedBroker. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoSharedBroker = class
class function Create: ISharedBroker;
class function CreateRemote(const MachineName: string): ISharedBroker;
end;
TSharedBrokerOnRpcCallRecorded = procedure(Sender: TObject; uniqueRpcId: SYSINT) of object;
TSharedBrokerOnClientConnect = procedure(Sender: TObject; UniqueClientId: SYSINT;
Connection: ISharedBrokerConnection) of object;
TSharedBrokerOnClientDisconnect = procedure(Sender: TObject; UniqueClientId: SYSINT) of object;
TSharedBrokerOnContextChanged = procedure(Sender: TObject; connectionIndex: SYSINT;
var NewContext: OleVariant) of object;
TSharedBrokerOnRPCBFailure = procedure(Sender: TObject; var ErrorText: OleVariant) of object;
TSharedBrokerOnLoginError = procedure(Sender: TObject; var ErrorText: OleVariant) of object;
TSharedBrokerOnConnectionDropped = procedure(Sender: TObject; connectionIndex: SYSINT;
var ErrorText: OleVariant) of object;
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TSharedBroker
// Help String : SharedBroker Object
// Default Interface: ISharedBroker
// Def. Intf. DISP? : No
// Event Interface: ISharedBrokerEvents
// TypeFlags : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
TSharedBrokerProperties= class;
{$ENDIF}
TSharedBroker = class(TOleServer)
private
FOnLogout: TNotifyEvent;
FOnRpcCallRecorded: TSharedBrokerOnRpcCallRecorded;
FOnClientConnect: TSharedBrokerOnClientConnect;
FOnClientDisconnect: TSharedBrokerOnClientDisconnect;
FOnContextChanged: TSharedBrokerOnContextChanged;
FOnRPCBFailure: TSharedBrokerOnRPCBFailure;
FOnLoginError: TSharedBrokerOnLoginError;
FOnConnectionDropped: TSharedBrokerOnConnectionDropped;
FIntf: ISharedBroker;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps: TSharedBrokerProperties;
function GetServerProperties: TSharedBrokerProperties;
{$ENDIF}
function GetDefaultInterface: ISharedBroker;
protected
procedure InitServerData; override;
procedure InvokeEvent(DispID: TDispID; var Params: TVariantArray); override;
function Get_RpcVersion: WideString;
procedure Set_RpcVersion(const version: WideString);
function Get_RpcHistoryEnabled: WordBool;
procedure Set_RpcHistoryEnabled(enabled: WordBool);
function Get_PerClientRpcHistoryLimit: Integer;
procedure Set_PerClientRpcHistoryLimit(limit: Integer);
function Get_CurrentContext: WideString;
function Get_User: WideString;
function Get_Login: WideString;
procedure Set_Login(const Value: WideString);
function Get_RpcbError: WideString;
function Get_Socket: Integer;
function Get_KernelLogin: WordBool;
procedure Set_KernelLogin(Value: WordBool);
function Get_ShowErrorMsgs: ISharedBrokerShowErrorMsgs;
procedure Set_ShowErrorMsgs(Value: ISharedBrokerShowErrorMsgs);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Connect; override;
procedure ConnectTo(svrIntf: ISharedBroker);
procedure Disconnect; override;
function BrokerConnect(const ClientName: WideString; ConnectionType: ISharedBrokerClient;
const ServerPort: WideString; WantDebug: WordBool;
AllowShared: WordBool; KernelLogin: WordBool;
ShowErrMsgs: ISharedBrokerShowErrorMsgs; RpcTimeLim: SYSINT;
var LoginStr: WideString; out UniqueClientIId: SYSINT;
out ErrorMsg: WideString): ISharedBrokerErrorCode;
function BrokerDisconnect: ISharedBrokerErrorCode;
function BrokerSetContext(const OptionName: WideString): ISharedBrokerErrorCode;
function BrokerCall(const RpcName: WideString; const RpcParams: WideString;
RpcTimeLimit: Integer; out RpcResults: WideString;
out UniqueRpcCallId: Integer): ISharedBrokerErrorCode;
function ReadRegDataDefault(Root: IRegistryRootEnum; const Key: WideString;
const Name: WideString; const Default: WideString;
out RegResult: WideString): ISharedBrokerErrorCode;
function GetRpcHistoryCountForClient(UniqueClientId: Integer; out rpcHistoryCount: Integer): ISharedBrokerErrorCode;
function GetClientIdAndNameFromIndex(clientIndex: Integer; out UniqueClientId: Integer;
out ClientName: WideString): ISharedBrokerErrorCode;
function LogoutConnectedClients(logoutTimeLimit: Integer): ISharedBrokerErrorCode;
function GetClientNameFromUniqueClientId(UniqueClientId: Integer; out ClientName: WideString): ISharedBrokerErrorCode;
function GetActiveBrokerConnectionIndexCount(out connectionIndexCount: Integer): ISharedBrokerErrorCode;
function GetActiveBrokerConnectionInfo(connectionIndex: Integer;
out connectedServerIp: WideString;
out connectedServerPort: Integer;
out lastContext: WideString): ISharedBrokerErrorCode;
function GetActiveBrokerConnectionIndexFromUniqueClientId(UniqueClientId: Integer;
out connectionIndex: Integer): ISharedBrokerErrorCode;
function GetRpcCallFromHistory(uniqueRpcId: Integer; out UniqueClientId: Integer;
out brokerContext: WideString; out RpcName: WideString;
out RpcParams: WideString; out rpcResult: WideString;
out rpcStartDateTime: Double; out rpcDuration: Integer): ISharedBrokerErrorCode;
function GetRpcCallFromHistoryIndex(UniqueClientId: Integer; rpcCallIndex: Integer;
out uniqueRpcId: Integer; out brokerContext: WideString;
out RpcName: WideString; out RpcParams: WideString;
out rpcResult: WideString; out rpcStartDateTime: Double;
out rpcDuration: Integer): ISharedBrokerErrorCode;
function GetRpcClientIdFromHistory(uniqueRpcId: Integer; out UniqueClientId: Integer;
out ClientName: WideString): ISharedBrokerErrorCode;
function GetConnectedClientCount(out connectedClientCount: Integer): ISharedBrokerErrorCode;
property DefaultInterface: ISharedBroker read GetDefaultInterface;
property CurrentContext: WideString read Get_CurrentContext;
property User: WideString read Get_User;
property RpcbError: WideString read Get_RpcbError;
property Socket: Integer read Get_Socket;
property RpcVersion: WideString read Get_RpcVersion write Set_RpcVersion;
property RpcHistoryEnabled: WordBool read Get_RpcHistoryEnabled write Set_RpcHistoryEnabled;
property PerClientRpcHistoryLimit: Integer read Get_PerClientRpcHistoryLimit write Set_PerClientRpcHistoryLimit;
property Login: WideString read Get_Login write Set_Login;
property KernelLogin: WordBool read Get_KernelLogin write Set_KernelLogin;
property ShowErrorMsgs: ISharedBrokerShowErrorMsgs read Get_ShowErrorMsgs write Set_ShowErrorMsgs;
published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
property Server: TSharedBrokerProperties read GetServerProperties;
{$ENDIF}
property OnLogout: TNotifyEvent read FOnLogout write FOnLogout;
property OnRpcCallRecorded: TSharedBrokerOnRpcCallRecorded read FOnRpcCallRecorded write FOnRpcCallRecorded;
property OnClientConnect: TSharedBrokerOnClientConnect read FOnClientConnect write FOnClientConnect;
property OnClientDisconnect: TSharedBrokerOnClientDisconnect read FOnClientDisconnect write FOnClientDisconnect;
property OnContextChanged: TSharedBrokerOnContextChanged read FOnContextChanged write FOnContextChanged;
property OnRPCBFailure: TSharedBrokerOnRPCBFailure read FOnRPCBFailure write FOnRPCBFailure;
property OnLoginError: TSharedBrokerOnLoginError read FOnLoginError write FOnLoginError;
property OnConnectionDropped: TSharedBrokerOnConnectionDropped read FOnConnectionDropped write FOnConnectionDropped;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object : TSharedBroker
// (This object is used by the IDE's Property Inspector to allow editing
// of the properties of this server)
// *********************************************************************//
TSharedBrokerProperties = class(TPersistent)
private
FServer: TSharedBroker;
function GetDefaultInterface: ISharedBroker;
constructor Create(AServer: TSharedBroker);
protected
function Get_RpcVersion: WideString;
procedure Set_RpcVersion(const version: WideString);
function Get_RpcHistoryEnabled: WordBool;
procedure Set_RpcHistoryEnabled(enabled: WordBool);
function Get_PerClientRpcHistoryLimit: Integer;
procedure Set_PerClientRpcHistoryLimit(limit: Integer);
function Get_CurrentContext: WideString;
function Get_User: WideString;
function Get_Login: WideString;
procedure Set_Login(const Value: WideString);
function Get_RpcbError: WideString;
function Get_Socket: Integer;
function Get_KernelLogin: WordBool;
procedure Set_KernelLogin(Value: WordBool);
function Get_ShowErrorMsgs: ISharedBrokerShowErrorMsgs;
procedure Set_ShowErrorMsgs(Value: ISharedBrokerShowErrorMsgs);
public
property DefaultInterface: ISharedBroker read GetDefaultInterface;
published
property RpcVersion: WideString read Get_RpcVersion write Set_RpcVersion;
property RpcHistoryEnabled: WordBool read Get_RpcHistoryEnabled write Set_RpcHistoryEnabled;
property PerClientRpcHistoryLimit: Integer read Get_PerClientRpcHistoryLimit write Set_PerClientRpcHistoryLimit;
property Login: WideString read Get_Login write Set_Login;
property KernelLogin: WordBool read Get_KernelLogin write Set_KernelLogin;
property ShowErrorMsgs: ISharedBrokerShowErrorMsgs read Get_ShowErrorMsgs write Set_ShowErrorMsgs;
end;
{$ENDIF}
// procedure Register;
implementation
uses ComObj;
class function CoSharedBroker.Create: ISharedBroker;
begin
Result := CreateComObject(CLASS_SharedBroker) as ISharedBroker;
end;
class function CoSharedBroker.CreateRemote(const MachineName: string): ISharedBroker;
begin
Result := CreateRemoteComObject(MachineName, CLASS_SharedBroker) as ISharedBroker;
end;
procedure TSharedBroker.InitServerData;
const
CServerData: TServerData = (
ClassID: '{EB44A5CD-1871-429F-A5BC-19C71B722182}';
IntfIID: '{E1D9A5E6-B7C6-40AD-AC34-6A3E12BDC328}';
EventIID: '{CBEA7167-4F9B-465A-B82E-4CEBDF933C35}';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TSharedBroker.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
ConnectEvents(punk);
Fintf:= punk as ISharedBroker;
end;
end;
procedure TSharedBroker.ConnectTo(svrIntf: ISharedBroker);
begin
Disconnect;
FIntf := svrIntf;
ConnectEvents(FIntf);
end;
procedure TSharedBroker.DisConnect;
begin
if Fintf <> nil then
begin
DisconnectEvents(FIntf);
FIntf := nil;
end;
end;
function TSharedBroker.GetDefaultInterface: ISharedBroker;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
Result := FIntf;
end;
constructor TSharedBroker.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps := TSharedBrokerProperties.Create(Self);
{$ENDIF}
end;
destructor TSharedBroker.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps.Free;
{$ENDIF}
inherited Destroy;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TSharedBroker.GetServerProperties: TSharedBrokerProperties;
begin
Result := FProps;
end;
{$ENDIF}
procedure TSharedBroker.InvokeEvent(DispID: TDispID; var Params: TVariantArray);
begin
case DispID of
-1: Exit; // DISPID_UNKNOWN
1: if Assigned(FOnLogout) then
FOnLogout(Self);
2: if Assigned(FOnRpcCallRecorded) then
FOnRpcCallRecorded(Self, Params[0] {SYSINT});
3: if Assigned(FOnClientConnect) then
FOnClientConnect(Self, Params[0] {SYSINT}, Params[1] {ISharedBrokerConnection});
4: if Assigned(FOnClientDisconnect) then
FOnClientDisconnect(Self, Params[0] {SYSINT});
5: if Assigned(FOnContextChanged) then
FOnContextChanged(Self, Params[0] {SYSINT}, Params[1] {const WideString});
6: if Assigned(FOnRPCBFailure) then
FOnRPCBFailure(Self, Params[0] {const WideString});
7: if Assigned(FOnLoginError) then
FOnLoginError(Self, Params[0] {const WideString});
8: if Assigned(FOnConnectionDropped) then
FOnConnectionDropped(Self, Params[0] {SYSINT}, Params[1] {const WideString});
end; {case DispID}
end;
function TSharedBroker.Get_RpcVersion: WideString;
begin
Result := DefaultInterface.Get_RpcVersion;
end;
procedure TSharedBroker.Set_RpcVersion(const version: WideString);
begin
DefaultInterface.Set_RpcVersion(version);
end;
function TSharedBroker.Get_RpcHistoryEnabled: WordBool;
begin
Result := DefaultInterface.Get_RpcHistoryEnabled;
end;
procedure TSharedBroker.Set_RpcHistoryEnabled(enabled: WordBool);
begin
DefaultInterface.Set_RpcHistoryEnabled(enabled);
end;
function TSharedBroker.Get_PerClientRpcHistoryLimit: Integer;
begin
Result := DefaultInterface.Get_PerClientRpcHistoryLimit;
end;
procedure TSharedBroker.Set_PerClientRpcHistoryLimit(limit: Integer);
begin
DefaultInterface.Set_PerClientRpcHistoryLimit(limit);
end;
function TSharedBroker.Get_CurrentContext: WideString;
begin
Result := DefaultInterface.Get_CurrentContext;
end;
function TSharedBroker.Get_User: WideString;
begin
Result := DefaultInterface.Get_User;
end;
function TSharedBroker.Get_Login: WideString;
begin
Result := DefaultInterface.Get_Login;
end;
procedure TSharedBroker.Set_Login(const Value: WideString);
begin
DefaultInterface.Set_Login(Value);
end;
function TSharedBroker.Get_RpcbError: WideString;
begin
Result := DefaultInterface.Get_RpcbError;
end;
function TSharedBroker.Get_Socket: Integer;
begin
Result := DefaultInterface.Get_Socket;
end;
function TSharedBroker.Get_KernelLogin: WordBool;
begin
Result := DefaultInterface.Get_KernelLogin;
end;
procedure TSharedBroker.Set_KernelLogin(Value: WordBool);
begin
DefaultInterface.Set_KernelLogin(Value);
end;
function TSharedBroker.Get_ShowErrorMsgs: ISharedBrokerShowErrorMsgs;
begin
Result := DefaultInterface.Get_ShowErrorMsgs;
end;
procedure TSharedBroker.Set_ShowErrorMsgs(Value: ISharedBrokerShowErrorMsgs);
begin
DefaultInterface.Set_ShowErrorMsgs(Value);
end;
function TSharedBroker.BrokerConnect(const ClientName: WideString;
ConnectionType: ISharedBrokerClient;
const ServerPort: WideString; WantDebug: WordBool;
AllowShared: WordBool; KernelLogin: WordBool;
ShowErrMsgs: ISharedBrokerShowErrorMsgs; RpcTimeLim: SYSINT;
var LoginStr: WideString; out UniqueClientIId: SYSINT;
out ErrorMsg: WideString): ISharedBrokerErrorCode;
begin
Result := DefaultInterface.BrokerConnect(ClientName, ConnectionType, ServerPort, WantDebug,
AllowShared, KernelLogin, ShowErrMsgs, RpcTimeLim,
LoginStr, UniqueClientIId, ErrorMsg);
end;
function TSharedBroker.BrokerDisconnect: ISharedBrokerErrorCode;
begin
Result := DefaultInterface.BrokerDisconnect;
end;
function TSharedBroker.BrokerSetContext(const OptionName: WideString): ISharedBrokerErrorCode;
begin
Result := DefaultInterface.BrokerSetContext(OptionName);
end;
function TSharedBroker.BrokerCall(const RpcName: WideString; const RpcParams: WideString;
RpcTimeLimit: Integer; out RpcResults: WideString;
out UniqueRpcCallId: Integer): ISharedBrokerErrorCode;
begin
Result := DefaultInterface.BrokerCall(RpcName, RpcParams, RpcTimeLimit, RpcResults,
UniqueRpcCallId);
end;
function TSharedBroker.ReadRegDataDefault(Root: IRegistryRootEnum; const Key: WideString;
const Name: WideString; const Default: WideString;
out RegResult: WideString): ISharedBrokerErrorCode;
begin
Result := DefaultInterface.ReadRegDataDefault(Root, Key, Name, Default, RegResult);
end;
function TSharedBroker.GetRpcHistoryCountForClient(UniqueClientId: Integer;
out rpcHistoryCount: Integer): ISharedBrokerErrorCode;
begin
Result := DefaultInterface.GetRpcHistoryCountForClient(UniqueClientId, rpcHistoryCount);
end;
function TSharedBroker.GetClientIdAndNameFromIndex(clientIndex: Integer;
out UniqueClientId: Integer;
out ClientName: WideString): ISharedBrokerErrorCode;
begin
Result := DefaultInterface.GetClientIdAndNameFromIndex(clientIndex, UniqueClientId, ClientName);
end;
function TSharedBroker.LogoutConnectedClients(logoutTimeLimit: Integer): ISharedBrokerErrorCode;
begin
Result := DefaultInterface.LogoutConnectedClients(logoutTimeLimit);
end;
function TSharedBroker.GetClientNameFromUniqueClientId(UniqueClientId: Integer;
out ClientName: WideString): ISharedBrokerErrorCode;
begin
Result := DefaultInterface.GetClientNameFromUniqueClientId(UniqueClientId, ClientName);
end;
function TSharedBroker.GetActiveBrokerConnectionIndexCount(out connectionIndexCount: Integer): ISharedBrokerErrorCode;
begin
Result := DefaultInterface.GetActiveBrokerConnectionIndexCount(connectionIndexCount);
end;
function TSharedBroker.GetActiveBrokerConnectionInfo(connectionIndex: Integer;
out connectedServerIp: WideString;
out connectedServerPort: Integer;
out lastContext: WideString): ISharedBrokerErrorCode;
begin
Result := DefaultInterface.GetActiveBrokerConnectionInfo(connectionIndex, connectedServerIp,
connectedServerPort, lastContext);
end;
function TSharedBroker.GetActiveBrokerConnectionIndexFromUniqueClientId(UniqueClientId: Integer;
out connectionIndex: Integer): ISharedBrokerErrorCode;
begin
Result := DefaultInterface.GetActiveBrokerConnectionIndexFromUniqueClientId(UniqueClientId,
connectionIndex);
end;
function TSharedBroker.GetRpcCallFromHistory(uniqueRpcId: Integer; out UniqueClientId: Integer;
out brokerContext: WideString;
out RpcName: WideString; out RpcParams: WideString;
out rpcResult: WideString;
out rpcStartDateTime: Double; out rpcDuration: Integer): ISharedBrokerErrorCode;
begin
Result := DefaultInterface.GetRpcCallFromHistory(uniqueRpcId, UniqueClientId, brokerContext,
RpcName, RpcParams, rpcResult, rpcStartDateTime,
rpcDuration);
end;
function TSharedBroker.GetRpcCallFromHistoryIndex(UniqueClientId: Integer; rpcCallIndex: Integer;
out uniqueRpcId: Integer;
out brokerContext: WideString;
out RpcName: WideString;
out RpcParams: WideString;
out rpcResult: WideString;
out rpcStartDateTime: Double;
out rpcDuration: Integer): ISharedBrokerErrorCode;
begin
Result := DefaultInterface.GetRpcCallFromHistoryIndex(UniqueClientId, rpcCallIndex, uniqueRpcId,
brokerContext, RpcName, RpcParams,
rpcResult, rpcStartDateTime, rpcDuration);
end;
function TSharedBroker.GetRpcClientIdFromHistory(uniqueRpcId: Integer;
out UniqueClientId: Integer;
out ClientName: WideString): ISharedBrokerErrorCode;
begin
Result := DefaultInterface.GetRpcClientIdFromHistory(uniqueRpcId, UniqueClientId, ClientName);
end;
function TSharedBroker.GetConnectedClientCount(out connectedClientCount: Integer): ISharedBrokerErrorCode;
begin
Result := DefaultInterface.GetConnectedClientCount(connectedClientCount);
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TSharedBrokerProperties.Create(AServer: TSharedBroker);
begin
inherited Create;
FServer := AServer;
end;
function TSharedBrokerProperties.GetDefaultInterface: ISharedBroker;
begin
Result := FServer.DefaultInterface;
end;
function TSharedBrokerProperties.Get_RpcVersion: WideString;
begin
Result := DefaultInterface.Get_RpcVersion;
end;
procedure TSharedBrokerProperties.Set_RpcVersion(const version: WideString);
begin
DefaultInterface.Set_RpcVersion(version);
end;
function TSharedBrokerProperties.Get_RpcHistoryEnabled: WordBool;
begin
Result := DefaultInterface.Get_RpcHistoryEnabled;
end;
procedure TSharedBrokerProperties.Set_RpcHistoryEnabled(enabled: WordBool);
begin
DefaultInterface.Set_RpcHistoryEnabled(enabled);
end;
function TSharedBrokerProperties.Get_PerClientRpcHistoryLimit: Integer;
begin
Result := DefaultInterface.Get_PerClientRpcHistoryLimit;
end;
procedure TSharedBrokerProperties.Set_PerClientRpcHistoryLimit(limit: Integer);
begin
DefaultInterface.Set_PerClientRpcHistoryLimit(limit);
end;
function TSharedBrokerProperties.Get_CurrentContext: WideString;
begin
Result := DefaultInterface.Get_CurrentContext;
end;
function TSharedBrokerProperties.Get_User: WideString;
begin
Result := DefaultInterface.Get_User;
end;
function TSharedBrokerProperties.Get_Login: WideString;
begin
Result := DefaultInterface.Get_Login;
end;
procedure TSharedBrokerProperties.Set_Login(const Value: WideString);
begin
DefaultInterface.Set_Login(Value);
end;
function TSharedBrokerProperties.Get_RpcbError: WideString;
begin
Result := DefaultInterface.Get_RpcbError;
end;
function TSharedBrokerProperties.Get_Socket: Integer;
begin
Result := DefaultInterface.Get_Socket;
end;
function TSharedBrokerProperties.Get_KernelLogin: WordBool;
begin
Result := DefaultInterface.Get_KernelLogin;
end;
procedure TSharedBrokerProperties.Set_KernelLogin(Value: WordBool);
begin
DefaultInterface.Set_KernelLogin(Value);
end;
function TSharedBrokerProperties.Get_ShowErrorMsgs: ISharedBrokerShowErrorMsgs;
begin
Result := DefaultInterface.Get_ShowErrorMsgs;
end;
procedure TSharedBrokerProperties.Set_ShowErrorMsgs(Value: ISharedBrokerShowErrorMsgs);
begin
DefaultInterface.Set_ShowErrorMsgs(Value);
end;
{$ENDIF}
{
procedure Register;
begin
RegisterComponents('Kernel',[TSharedBroker]);
end;
}
end.

View File

@ -0,0 +1,85 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=Vcl50;Vclx50;Vcldb50;Vclbde50;VclSmp50;vclado50;ibevnt50;vcldbx50;Qrpt50;TeeUI50;TeeDB50;Tee50;Dss50;TeeQR50;VCLIB50;Vclmid50;vclie50;Inetdb50;Inet50;NMFast50;webmid50;dclocx50;dclaxserver50;JLITestFDE;Rz252N50;Rz252D50;CS20Comps50;CSP20I50;gmunitsd5;gmctrlsd5;gmchrtedd5;gmdaouid5;GMDaod5;gmdbgend5;gmdbctrld5;gmadouid5;GMAdod5;democomponentsd5;XUtilsR50;XUDT_R50;XU_R50;Indy50;XWB_R50
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Language]
ActiveLang=
ProjectLang=$00000409
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=1
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=Dept. Veteran Affairs, VHA, OI, SD&D, Infrastructure Enhancement
FileDescription=
FileVersion=1.0.0.1
InternalName=
LegalCopyright=(c) 2002
LegalTrademarks=
OriginalFilename=
ProductName=RPCSharedBrokerDebugger
ProductVersion=1.0.0.0
Comments=
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;

View File

@ -0,0 +1,17 @@
program SharedBrokerDebugger;
uses
Forms,
uBrokerConnectionInfo in 'uBrokerConnectionInfo.pas',
uClientInfo in 'uClientInfo.pas',
fSharedBrokerDebugger in 'fSharedBrokerDebugger.pas' {frmSharedBrokerDebugger},
fClientRPCLogger in 'fClientRPCLogger.pas' {frmRpcClientLogger},
uRpcLogEntry in 'uRpcLogEntry.pas';
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TfrmSharedBrokerDebugger, frmSharedBrokerDebugger);
Application.Run;
end.

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,166 @@
unit fClientInfo;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
uBrokerConnectionInfo;
type
TForm2 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;
{
/// <summary>
/// Summary description for ClientInfo.
/// </summary>
}
TClientInfo = class(TPersistent)
private
FUniqueId: Integer;
FName: String;
FBrokerConnectionIndex: Integer;
FRpcHistoryEnabled: Boolean;
FRpcLogger: TClientRpcLogger;
FVisible: Boolean;
protected
function GetVisible: Boolean;
procedure SetVisible(Value: Boolean);
procedure Initialize;
public
Constructor Create; overload; virtual;
Constructor Create(uniqueId: Integer; name: String; connectionIndex: Integer; historyEnabled: Boolean); overload; virtual;
procedure AddRpcLogEntry(entry: TRpcLogEntry; overrideCheckBox: Boolean);
function MakeCheckBoxString: String;
function ToString: String;
property Visible: Boolean read GetVisible write SetVisible;
property Name: String read FName write FName;
property RpcHistoryEnabled: Boolean read FRpcHistoryEnabled write FRPCHistoryEnabled;
property UniqueId: Integer read FUniqueId write FUniqueId;
property BrokerConnectionIndex: Integer read FBrokerConnectionIndex write FBrokerConnectionIndex;
end;
const
kRpcHistoryEnabledDefault: Boolean = true;
kBrokerConnectionIndexDefault: Integer = -1;
var
Form2: TForm2;
implementation
{$R *.DFM}
Constructor TClientInfo.Create;
begin
inherited;
Initialize;
end;
{
/// <summary>
/// ClientInfo parameterized constructor
/// </summary>
/// <param name="uniqueId"></param>
/// <param name="name"></param>
/// <param name="connectionIndex"></param>
/// <param name="historyEnabled"></param>
}
Constructor TClientInfo.Create(uniqueId: Integer; name: String; connectionIndex: Integer; historyEnabled: Boolean);
begin
Create;
FUniqueId := uniqueId;
FName := name;
FBrokerConnectionIndex := connectionIndex;
FRpcHistoryEnabled := historyEnabled;
end;
procedure TClientInfo.AddRpcLogEntry(entry: TRpcLogEntry; overrideCheckBox: Boolean);
begin
if(FRpcLogger <> nil) then
FRpcLogger.AddRpcLogEntry(entry,overrideCheckBox);
end;
procedure TClientInfo.SetVisible(Value: Boolean);
begin
if(value) then
begin
if(FRpcLogger = nil) then
begin
FRpcLogger := TClientRpcLogger.Create;
// TODO FRpcLogger.OnRpcLoggerClose += new EventHandler(OnRpcLoggerClosedEventHandler);
FRpcLogger.Text := 'RPC Log for '+Name+' ID='+IntToStr(UniqueId);
end;
FRpcLogger.Visible := true;
end
else
begin
if(FRpcLogger <> nil) then
begin
FRpcLogger.Visible := false;
FRpcLogger := nil;
end;
end;
end;
function TClientInfo.GetVisible: Boolean;
begin
result := false;
if (FRpcLogger <> nil) then
result := FRpcLogger.Visible;
end;
{
/// <summary>
/// OnLogClosed is called when the ClientRpcLogger window is called
/// Any event handlers by owners of this object should assign
/// an event handler to this event
/// </summary>
}
// TODO
// public EventHandler OnLogClosed;
{
/// <summary>
/// MakeCheckBoxString creates a string based on the internal members
/// This string is intended to be used for check box list entries.
/// </summary>
/// <param name="checkBoxString"></param>
}
function TClientInfo.MakeCheckBoxString: String;
begin
Result := ToString;
end;
{
/// <summary>
/// ToString returns a readable string representation of the member
/// </summary>
/// <returns></returns>
}
function TClientInfo.ToString: String;
begin
result := FName+' connection='+IntToStr(FBrokerConnectionIndex)+' id='+IntToStr(FUniqueId);
end;
procedure TClientInfo.Initialize;
begin
FBrokerConnectionIndex := kBrokerConnectionIndexDefault;
FRpcHistoryEnabled := kRpcHistoryEnabledDefault;
FRpcLogger := nil;
end;
// TODO
{
procedure TClientInfo.OnRpcLoggerClosedEventHandler(object sender, EventArgs e)
begin
// Pass the message on to my owner
Visible := false;
OnLogClosed(Self,nil);
end;
}
end.

View File

@ -0,0 +1,264 @@
object frmRpcClientLogger: TfrmRpcClientLogger
Left = 173
Top = 0
Width = 665
Height = 578
Caption = 'frmRpcClientLogger'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
OnClose = FormClose
PixelsPerInch = 96
TextHeight = 13
object lblMaxRPCEntries: TLabel
Left = 232
Top = 16
Width = 104
Height = 13
Anchors = [akTop, akRight]
Caption = '&Maximum RPC Entries'
end
object cbxEnableRPCLogging: TCheckBox
Left = 528
Top = 16
Width = 121
Height = 17
Alignment = taLeftJustify
Anchors = [akTop, akRight]
Caption = '&Enable RPC Logging'
Checked = True
State = cbChecked
TabOrder = 7
end
object UpDown1: TUpDown
Left = 425
Top = 8
Width = 15
Height = 21
Anchors = [akTop, akRight]
Associate = maxRpcLogEntriesNumericUpDown
Min = 0
Position = 100
TabOrder = 0
Wrap = False
OnClick = UpDown1Click
end
object maxRpcLogEntriesNumericUpDown: TEdit
Left = 360
Top = 8
Width = 65
Height = 21
Anchors = [akTop, akRight]
TabOrder = 6
Text = '100'
end
object rpcLogListBox: TListBox
Left = 8
Top = 32
Width = 641
Height = 143
Anchors = [akLeft, akTop, akRight]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
ItemHeight = 14
ParentFont = False
PopupMenu = PopupMenu1
TabOrder = 1
OnClick = rpcLogListBoxClick
end
object Panel1: TPanel
Left = 8
Top = 165
Width = 641
Height = 153
Anchors = [akLeft, akTop, akRight, akBottom]
TabOrder = 2
object lblRPCName: TLabel
Left = 16
Top = 16
Width = 53
Height = 13
Caption = 'RPC Name'
end
object lblRPCDebugID: TLabel
Left = 240
Top = 120
Width = 71
Height = 13
Caption = 'RPC Debug ID'
end
object lblClientName: TLabel
Left = 16
Top = 88
Width = 57
Height = 13
Caption = 'Client Name'
end
object lblClientDebugID: TLabel
Left = 16
Top = 120
Width = 75
Height = 13
Caption = 'Client Debug ID'
end
object lblContext: TLabel
Left = 16
Top = 56
Width = 36
Height = 13
Caption = 'Context'
end
object lblDuration: TLabel
Left = 440
Top = 120
Width = 40
Height = 13
Caption = 'Duration'
end
object lblParams: TLabel
Left = 8
Top = 136
Width = 35
Height = 13
Caption = 'Params'
end
object lblResults: TLabel
Left = 336
Top = 136
Width = 35
Height = 13
Caption = 'Results'
end
object edtRPCName: TEdit
Left = 96
Top = 16
Width = 521
Height = 13
BorderStyle = bsNone
Color = clBtnFace
TabOrder = 1
end
object edtRPCDebugID: TEdit
Left = 320
Top = 120
Width = 73
Height = 13
BorderStyle = bsNone
Color = clBtnFace
TabOrder = 5
end
object edtClientName: TEdit
Left = 96
Top = 88
Width = 521
Height = 13
BorderStyle = bsNone
Color = clBtnFace
TabOrder = 3
end
object edtClientDebugID: TEdit
Left = 96
Top = 120
Width = 89
Height = 13
BorderStyle = bsNone
Color = clBtnFace
TabOrder = 4
end
object edtContext: TEdit
Left = 96
Top = 56
Width = 521
Height = 13
BorderStyle = bsNone
Color = clBtnFace
TabOrder = 2
end
object edtDuration1: TEdit
Left = 496
Top = 120
Width = 121
Height = 13
BorderStyle = bsNone
Color = clBtnFace
TabOrder = 6
end
object Edit2: TEdit
Left = 512
Top = 136
Width = 121
Height = 21
TabOrder = 0
Text = 'Edit2'
Visible = False
end
end
object ParamsMemoBox: TRichEdit
Left = 8
Top = 320
Width = 313
Height = 161
Anchors = [akLeft, akBottom]
Lines.Strings = (
'')
TabOrder = 3
end
object ResultsMemoBox: TRichEdit
Left = 336
Top = 320
Width = 313
Height = 161
Anchors = [akLeft, akRight, akBottom]
TabOrder = 4
end
object btnClose: TButton
Left = 291
Top = 496
Width = 75
Height = 25
Anchors = [akLeft, akRight, akBottom]
Caption = 'Close'
TabOrder = 5
OnClick = btnCloseClick
end
object MainMenu1: TMainMenu
Left = 152
object File1: TMenuItem
Caption = '&File'
object mnuFileClose: TMenuItem
Caption = '&Close'
OnClick = mnuFileCloseClick
end
end
object Edit1: TMenuItem
Caption = '&Edit'
object mnuEditCopyToClipboard: TMenuItem
Caption = '&Copy Current RPC To ClipBoard'
Enabled = False
OnClick = mnuEditCopyToClipboardClick
end
end
object HGelp1: TMenuItem
Caption = '&Help'
object mnuHelpAbout: TMenuItem
Caption = '&About'
end
end
end
object PopupMenu1: TPopupMenu
Left = 232
Top = 80
object mnuPopupCopyToClipboard: TMenuItem
Caption = '&Copy To Clipboard'
OnClick = mnuPopupCopyToClipboardClick
end
end
end

View File

@ -0,0 +1,190 @@
unit fClientRPCLogger;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls, Clipbrd, Menus, uRpcLogEntry;
type
TfrmRpcClientLogger = class(TForm)
cbxEnableRPCLogging: TCheckBox;
lblMaxRPCEntries: TLabel;
UpDown1: TUpDown;
maxRpcLogEntriesNumericUpDown: TEdit;
rpcLogListBox: TListBox;
Panel1: TPanel;
lblRPCName: TLabel;
lblRPCDebugID: TLabel;
lblClientName: TLabel;
lblClientDebugID: TLabel;
lblContext: TLabel;
lblDuration: TLabel;
edtRPCName: TEdit;
edtRPCDebugID: TEdit;
edtClientName: TEdit;
edtClientDebugID: TEdit;
edtContext: TEdit;
edtDuration1: TEdit;
lblParams: TLabel;
lblResults: TLabel;
MainMenu1: TMainMenu;
PopupMenu1: TPopupMenu;
File1: TMenuItem;
mnuFileClose: TMenuItem;
Edit1: TMenuItem;
HGelp1: TMenuItem;
mnuHelpAbout: TMenuItem;
mnuEditCopyToClipboard: TMenuItem;
mnuPopupCopyToClipboard: TMenuItem;
ParamsMemoBox: TRichEdit;
ResultsMemoBox: TRichEdit;
Edit2: TEdit;
btnClose: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
procedure mnuEditCopyToClipboardClick(Sender: TObject);
procedure rpcLogListBoxClick(Sender: TObject);
procedure mnuPopupCopyToClipboardClick(Sender: TObject);
procedure mnuFileCloseClick(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure DisplayRpcEntry(entry: TRpcLogEntry);
procedure AddRpcLogEntry(entry: TRPCLogEntry; overrideCheckBox: Boolean);
end;
var
frmRpcClientLogger: TfrmRpcClientLogger;
implementation
{$R *.DFM}
procedure TfrmRpcClientLogger.AddRpcLogEntry(entry: TRPCLogEntry; overrideCheckBox: Boolean);
var
Str, Str1: String;
Max: Integer;
begin
if (cbxEnableRPCLogging.Checked or overrideCheckBox) then
begin
// If the list is full we need to delete the 0th item till we have room for one.
while (rpcLogListBox.Items.Count >= StrToInt(maxRpcLogEntriesNumericUpDown.Text)) do
rpcLogListBox.Items.Delete(0);
with entry do
begin
Max := 30;
if Length(Name) > 30 then
Max := Length(Name);
Str := Copy(Name+' ',1,Max);
Str1 := ' '+IntToStr(Duration);
Str := Str + ' cId: '+IntToStr(UniqueClientId)+' time ='+Copy(Str1,Length(Str1)-5,Length(Str1))+' ms rpcId: '+IntToStr(UniqueId)+' '+ClientName;
end; // with
rpcLogListBox.Items.AddObject(Str, entry);
end;
end;
procedure TfrmRpcClientLogger.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//
end;
procedure TfrmRpcClientLogger.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
//
end;
procedure TfrmRpcClientLogger.mnuEditCopyToClipboardClick(Sender: TObject);
begin
if RpcLogListBox.ItemIndex > -1 then
mnuPopupCopyToClipboardClick(Self);
end;
procedure TfrmRpcClientLogger.rpcLogListBoxClick(Sender: TObject);
begin
DisplayRpcEntry(TRpcLogEntry(rpcLogListBox.Items.Objects[rpcLogListBox.ItemIndex]));
mnuEditCopyToClipboard.Enabled := True;
end;
procedure TfrmRpcClientLogger.mnuPopupCopyToClipboardClick(Sender: TObject);
var
RPCEntry: TRpcLogEntry;
begin
RPCEntry := TRpcLogEntry(RpcLogListBox.Items.Objects[RpcLogListBox.ItemIndex]);
Edit2.Text := RPCEntry.CreateClipBoardString;
Edit2.SelectAll;
Edit2.CopyToClipBoard;
end;
// private void rpcLogListBox_SelectedIndexChanged(object sender, System.EventArgs e)
procedure TfrmRpcClientLogger.DisplayRpcEntry(entry: TRpcLogEntry);
var
Str : String;
begin
Str := entry.CreateParamsDisplayString; //.Split('\n');
ParamsMemoBox.Lines.Clear;
ParamsMemoBox.Lines.Add(Str);
resultsMemoBox.Text := entry.CreateResultsDisplayString();
edtRpcName.Text := entry.Name;
edtRPCDebugId.Text := IntToStr(entry.UniqueId);
edtContext.Text := entry.Context;
if(entry.Duration < 1) then
edtDuration1.Text := '<1ms'
else
edtDuration1.Text := IntToStr(entry.Duration) + ' ms';
edtClientName.Text := entry.ClientName;
edtClientDebugId.Text := IntToStr(entry.UniqueClientId);
end;
{
procedure TfrmRpcClientLogger.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
OnRpcLoggerClose(Self,nil);
end;
procedure TfrmRpcClientLogger.UpDown1Click(Sender: TObject;
Button: TUDBtnType);
begin
// In case the max entry value is less than the rpc log entries delete the entries
while (StrToInt(maxRpcLogEntriesNumericUpDown.Text) < rpcLogListBox.Items.Count)
rpcLogListBox.Items.Delete(0);
end;
procedure TfrmRpcClientLogger.mnuEditCopyToClipboardClick(Sender: TObject);
var
Clip: TClipBoard;
begin
// Build a string and put it on the clipboard here.
// Clipboard.SetDataObject(((RpcLogEntry)rpcLogListBox.SelectedItem).CreateClipboardString());
Clip ::= ClipBoard;
Clip.SetTextBuf(PChar((RpcLogEntry)(rpcLogListBox.Items[rpcLogListBox.ItemIndex]).CreateClipboardString));
end;
procedure TfrmRpcClientLogger.rpcLogListBoxClick(Sender: TObject);
begin
DisplayRpcEntry((RpcLogEntry)rpcLogListBox.Items[rpcLogListBox.SelectedIndex]);
mnuEditCopyToClipboard.Enabled := True;
end;
procedure TfrmRpcClientLogger.mnuPopupCopyToClipboardClick(
Sender: TObject);
begin
mnuEditCopyToClipboardClick(Sender);
end;
}
procedure TfrmRpcClientLogger.mnuFileCloseClick(Sender: TObject);
begin
Self.Visible := False;
end;
procedure TfrmRpcClientLogger.btnCloseClick(Sender: TObject);
begin
Self.Visible := False;
end;
end.

View File

@ -0,0 +1,180 @@
object frmSharedBrokerDebugger: TfrmSharedBrokerDebugger
Left = 146
Top = 0
Width = 639
Height = 571
Caption = 'SharedRPCBroker Debugger'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 16
Top = 16
Width = 139
Height = 13
Caption = 'Current Shared Broker Clients'
end
object Label2: TLabel
Left = 16
Top = 200
Width = 126
Height = 13
Caption = 'Actual Broker Connections'
end
object Label3: TLabel
Left = 16
Top = 328
Width = 109
Height = 13
Caption = 'Client Connections Log'
end
object lblMaxRPCEntries: TLabel
Left = 328
Top = 16
Width = 80
Height = 13
Caption = '&Max RPC Entries'
end
object Label4: TLabel
Left = 160
Top = 16
Width = 152
Height = 13
Caption = 'Check a box to view RPCs'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label5: TLabel
Left = 176
Top = 200
Width = 235
Height = 13
Caption = 'Check a box to view RPCs and their data'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object btnExit: TButton
Left = 278
Top = 492
Width = 75
Height = 25
Caption = 'E&xit'
TabOrder = 6
OnClick = btnExitClick
end
object EnableRpcCallLogForAllClientsCheckBox: TCheckBox
Left = 480
Top = 16
Width = 129
Height = 17
Alignment = taLeftJustify
Caption = '&Enable RPC Call Log'
Checked = True
State = cbChecked
TabOrder = 2
end
object CurrentClientsCheckedListBox: TCheckListBox
Left = 16
Top = 32
Width = 593
Height = 161
OnClickCheck = CurrentClientsCheckedListBoxClickCheck
ItemHeight = 13
TabOrder = 3
end
object actualBrokerConnectionsCheckedListBox: TCheckListBox
Left = 16
Top = 216
Width = 593
Height = 105
OnClickCheck = actualBrokerConnectionsCheckedListBoxClickCheck
ItemHeight = 13
TabOrder = 4
end
object RpcCallLogListBox: TListBox
Left = 520
Top = 456
Width = 65
Height = 57
TabStop = False
ItemHeight = 13
TabOrder = 0
Visible = False
end
object maxAllClientRpcLogEntriesNumericUpDown: TEdit
Left = 416
Top = 8
Width = 41
Height = 21
TabOrder = 1
Text = '100'
end
object UpDown1: TUpDown
Left = 457
Top = 8
Width = 15
Height = 21
Associate = maxAllClientRpcLogEntriesNumericUpDown
Min = 0
Position = 100
TabOrder = 7
Wrap = False
end
object clientConnectionsLogRichTextBox: TRichEdit
Left = 16
Top = 344
Width = 593
Height = 137
Lines.Strings = (
'')
TabOrder = 5
end
object mVistaSession: TSharedBroker
AutoConnect = False
ConnectKind = ckRunningOrNew
Left = 56
Top = 488
end
object MainMenu1: TMainMenu
Left = 120
Top = 496
object File1: TMenuItem
Caption = '&File'
object Exit1: TMenuItem
Caption = 'E&xit'
OnClick = Exit1Click
end
end
object Edit1: TMenuItem
Caption = '&Edit'
object CopyConnectionsLogToClipboard1: TMenuItem
Caption = '&Copy Connections Log To Clipboard'
OnClick = CopyConnectionsLogToClipboard1Click
end
end
object Help1: TMenuItem
Caption = '&Help'
object About1: TMenuItem
Caption = '&About'
OnClick = About1Click
end
end
end
end

Some files were not shown because too many files have changed in this diff Show More