//***************************************************************************************** // Copyright (c) 2000 Michael Kurz // All rights reserved. // If you want to use this source in your applications contact: // // $FileName : cRPCServer.Pkg // $ProjectName : RPC (Remote Procedure Call) between DF programs // $Author : Michael Kurz // $Created : 16.01.2001 @ 14:25 // // Contents: // Defines the cRPCServer class which allows other programs to call procedures in // the VDF program which contains an object of this class. // this class is subclassed from cRPCClient, so it also is able to access procedures // from other RPCServers. // // Remarks: // All RPC Functions and Procedure can be defined like normal Procedures and functions // accecpt that you must use the commands with the RPC_ Praefix. // // $Rev History // //***************************************************************************************** // Example of how to use it: (In the RPC Server VDF placed inside the MainPanel) // // Object oRPCServer is a cRPCServer // set ConnectName to "RPCSERVERNAME" // Must be the same like the psServerName in the RPCClient // // // RPC_Procedure TestProcedure1 String sName // showln "RPC Server TestProcedure: " sName // RPC_End_Procedure // // RPC_Function TestFunction2 String sName1 String sName2 String sName3 String sName4 String sName5 returns String // showln "RPC Server TestFunction: " // showln "Name1: " sName1 // showln "Name2: " sName2 // showln "Name3: " sName3 // showln "Name4: " sName4 // showln "Name5: " sName5 // Function_Return "RPC Function returned this" // RPC_End_Function // End_Object // // Inside the RPC Client VDF: // // Object oRPCClient is a cRPCClient // set psServerName to "RPCSERVERNAME" // Name of the VDF programm which is the server. // // // Declare the functions which are defined in the RPC Server VDF. // RPC_External_Procedure TestProcedure1 String sName // RPC_External_Function TestFunction1 String sName1 String sName2 String sName3 String sName4 String sName5 returns String // End_Object // Use cRPCClient.Pkg // An overwritten Procedure command which registers the procedure in the RPCServer. // This command can only be used within a cRPCServer. #COMMAND RPC_Procedure R #IFSAME !$ CRPCSERVER #ELSE #ERROR 200 RPC_Procedure command can only be used within a cRPCServer Class! #ENDIF #SPUSH !$ #SET $$ !1 Procedure !1 !2 !3 !4 !5 !6 !7 !8 !9 #ENDCOMMAND #COMMAND RPC_End_Procedure End_Procedure Send AllowExternalCall MSG_!$ Self #SPOP $$ #ENDCOMMAND // An overwritten Function command which registers the procedure in the RPCServer. // This command can only be used within a cRPCServer. #COMMAND RPC_Function R #IFSAME !$ CRPCSERVER #ELSE #ERROR 200 RPC_Function command can only be used within a cRPCServer Class! #ENDIF #SPUSH !$ #SET $$ !1 Function !1 !2 !3 !4 !5 !6 !7 !8 !9 #ENDCOMMAND #COMMAND RPC_End_Function End_Function Send AllowExternalCall GET_!$ Self #SPOP $$ #ENDCOMMAND // Should give the ability to use RPC "Remove Procedure Call" between // Dataflexprograms. Class cRPCServer Is a cRPCClient Procedure OnCopyData Integer wParam Integer lParam End_Procedure Procedure Construct_Object Set External_Class_Name "cRPCManager" To "#32770" // Is the classname for a Dialog, cant use static becouse there is a problem with VDF6 and its mixing up classes! Set External_Message WM_COPYDATA To msg_OnCopyData Forward Send Construct_Object Set focus_mode To nonfocusable Property String psValue Public "" // Last received value! Object oFunctionIDs Is an Array End_Object Object oDestObjectIDs Is an Array End_Object End_Procedure // Sets the name for the RPC access. // The left 20 characters of the value 0 are used for identifying the program. Procedure Set ConnectName String sName String sOld Move (Pad(sName,20)) To sName Get value Item 0 To sOld Move (Overstrike(sName,sOld,1)) To sName Set value Item 0 To sName End_Procedure Function ConnectName Returns String Function_Return (Value(Self,0)) End_Function // Adds a procedure to the external call list. Procedure AllowExternalCallID Integer iID Integer iMsg Integer iDest Set value Of (oFunctionIds(Self)) Item iID To iMsg Set value Of (oDestObjectIds(Self)) Item iID To iDest End_Procedure // Adds a procedure to the external call list. Procedure AllowExternalCall Integer iMsg Integer iDest Send AllowExternalCallID (Item_Count(oFunctionIDs(Self))) iMsg iDest End_Procedure // Is called to Identify what should be done with the given data. // Becouse this is part of a RPC system this will be a method with parameters. Function DoAction String sData Returns Integer String sRet sName Integer iRet iMsg iDest Get ParseRPCBlock sData To iRet If iRet Begin Get psMessageName To sName // If (Left(sName,3)) ne "MSG_" move ("MSG_"+sName) To sName If sName Ne "" Move (Eval(sName)) To iMsg Else Begin Get value Of (oFunctionIds(Self)) Item (piMessageID(Self)) To iMsg Get value Of (oDestObjectIds(Self)) Item (piMessageID(Self)) To iDest End If iMsg Ne 0 Begin If iDest Get iMsg Of iDest (Value(oParameters(Self),0)) ; (Value(oParameters(Self),1)) ; (Value(oParameters(Self),2)) ; (Value(oParameters(Self),3)) ; (Value(oParameters(Self),4)) ; (Value(oParameters(Self),5)) ; (Value(oParameters(Self),6)) ; To sRet Else Get iMsg (Value(oParameters(Self),0)) ; (Value(oParameters(Self),1)) ; (Value(oParameters(Self),2)) ; (Value(oParameters(Self),3)) ; (Value(oParameters(Self),4)) ; (Value(oParameters(Self),5)) ; (Value(oParameters(Self),6)) ; To sRet End End Send SetWindowResponse (Window_Handle(Self)) sRet End_Function // Is sent when a new datablock is received by WM_COPYDATA. Procedure OnCopyData Integer wParam Integer lParam String sData Move (RPCReceiveData(lParam)) To sData // Send Info_box (Replaces(Character(0),sData,"\n")) Set psValue To sData Procedure_Return (DoAction(Self,sData)) End_Procedure // Enter the own window_handle into the UserData of the main window of the // application. So it's easy available from other programs. Procedure Page_Object Integer iFlag Integer hoID iRet Set Window_Style BS_AUTO3STATE To True Set Window_Style BS_OWNERDRAW To True Forward Send Page_Object iFlag If iFlag Begin Get Main_Panel_ID To hoID If hoID Begin Move (SetWindowLong(Window_Handle(hoID),GWL_USERDATA,Window_Handle(Self))) To iRet End End End_Procedure End_Class