Upgrade to version 27
This commit is contained in:
kdtop3
parent
244f628889
commit
ad6be8316c
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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.
|
|
@ -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
|
||||
|
|
@ -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.
|
|
@ -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
|
||||
|
|
@ -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.
|
||||
|
||||
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
|
@ -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
|
|
@ -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.
|
||||
|
||||
|
||||
|
|
@ -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.
|
||||
|
|
@ -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=
|
||||
|
|
@ -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.
|
|
@ -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=
|
||||
|
|
@ -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.
|
|
@ -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=
|
||||
|
|
@ -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.
|
|
@ -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=
|
||||
|
|
@ -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.
|
|
@ -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
|
||||
|
|
@ -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.
|
||||
|
||||
|
|
@ -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
|
||||
|
|
@ -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.
|
||||
|
|
@ -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
|
||||
|
|
@ -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.
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
|
@ -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.
|
||||
|
||||
|
||||
|
|
@ -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=
|
||||
|
|
@ -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.
|
||||
Binary file not shown.
Binary file not shown.
|
|
@ -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.
|
||||
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
|
@ -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.
|
||||
|
||||
|
||||
|
|
@ -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.
|
||||
|
|
@ -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=
|
||||
|
|
@ -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.
|
|
@ -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=
|
||||
|
|
@ -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.
|
|
@ -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=
|
||||
|
|
@ -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.
|
|
@ -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=
|
||||
|
|
@ -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.
|
|
@ -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
|
||||
|
|
@ -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.
|
||||
|
||||
|
|
@ -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
|
||||
|
|
@ -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.
|
||||
|
|
@ -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
|
||||
|
|
@ -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.
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
|
@ -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.
|
||||
|
||||
|
||||
Binary file not shown.
Binary file not shown.
|
|
@ -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.
|
||||
|
|
@ -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;
|
||||
|
|
@ -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.
|
|
@ -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.
|
||||
|
||||
|
|
@ -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
|
||||
|
|
@ -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.
|
||||
|
|
@ -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
Loading…
Reference in New Issue