//***************************************************************************************** // Copyright (c) 2000 Michael Kurz // All rights reserved. // If you want to use this source in your applications conatct: // // $FileName : cRPCClient.Pkg // $ProjectName : RPC (Remote Procedure Call) between DF programs // $Author : Michael Kurz // $Created : 16.01.2001 @ 14:25 // // Contents: // Defines the cRPCClient class which allows to call procedure in DF programs // which have the cRPCServer class included. // // $Rev History // //***************************************************************************************** // Example of how to use it: // // Object oRPCClient is a cRPCClient // set psServerName to "RPCSERVER" // 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 // // Getting windows and Classnames of these windows... External_Function FindWindowEx "FindWindowExA" User32.dll Handle hParent Handle hChild Pointer pClass Pointer pWindowName Returns Handle External_Function GetClassName "GetClassNameA" User32.dll Handle hwnd Pointer pName Integer iL Returns Integer // Get Some extra infos about a window. Define GWL_WNDPROC For (-4) Define GWL_HINSTANCE For (-6) Define GWL_HWNDPARENT For (-8) Define GWL_STYLE For (-16) Define GWL_EXSTYLE For (-20) Define GWL_USERDATA For (-21) Define GWL_ID For (-12) // Declarations to use WM_COPYDATA... TYPE COPYDATASTRUCT Field COPYDATASTRUCT.dwData as Pointer Field COPYDATASTRUCT.cbData as Dword Field COPYDATASTRUCT.lpData as Pointer END_TYPE Define WM_COPYDATA For |CI$004A // Gets the Caption of Window... Function RPCWindowCaption Global Handle hwnd Returns String String sCaption Pointer pCaption Integer iRet Move (Repeat(Character(0),801)) To sCaption // Think of a max. of 800 character +1 for safety! GetAddress Of sCaption To pCaption Move (GetWindowText(hwnd,pCaption,800)) To iRet // Tries to get the WindowCaption text! Move (CString(sCaption)) To sCaption Move (Trim(sCaption)) To sCaption Function_Return sCaption End_Function // Gets the Caption of Window... Function SetWindowCaption Global Handle hwnd String sCaption Returns String String sCap Integer iRet Move sCaption To sCap Append sCap (Character(0)) Move (SetWindowText(hwnd,sCap)) To iRet // Tries to get the WindowCaption text! Function_Return iRet End_Function // Becous commands doent support loops a loop need to be implemented with // an Recursive Call of a command. #COMMAND RPC_Internal_StoreParameters #IFSAME !1 String Number Handle Integer Returns #ELSE Send DefineParameter !1 #ENDIF #IF !0>1 RPC_Internal_StoreParameters !2 !3 !4 !5 !6 !7 !8 !9 #ENDIF #ENDCOMMAND // Is used to create an CallStatement for a RPC Procedure defined in a RPCServer // Procedures. #COMMAND RPC_External_Procedure Procedure !1 !2 !3 !4 !5 !6 !7 !8 !9 Send ClearAllParameters #IF !0>2 RPC_Internal_StoreParameters !3 !5 !7 !9 #ENDIF Procedure_Return (InvokeMessage(Self,0,"MSG_!1")) End_Procedure #ENDCOMMAND #COMMAND RPC_External_Procedure_Front Procedure !1 !2 !3 !4 !5 !6 !7 !8 !9 Send ClearAllParameters #IF !0>2 RPC_Internal_StoreParameters !3 !5 !7 !9 #ENDIF Procedure_Return (InvokeMessageEx(Self,0,"MSG_!1",true)) End_Procedure #ENDCOMMAND // Functions. #COMMAND RPC_External_Function Function !1 !2 !3 !4 !5 !6 !7 !8 !9 Send ClearAllParameters #IFSAME !4 Returns RPC_Internal_StoreParameters !3 #ELSE #IFSAME !6 Returns RPC_Internal_StoreParameters !3 !5 #ELSE #IFSAME !8 Returns RPC_Internal_StoreParameters !3 !5 !7 #ELSE RPC_Internal_StoreParameters !3 !5 !7 !9 #ENDIF #ENDIF #ENDIF Function_Return (InvokeMessage(Self,0,"GET_!1")) End_Function #ENDCOMMAND #COMMAND RPC_External_Function_Front Function !1 !2 !3 !4 !5 !6 !7 !8 !9 Send ClearAllParameters #IFSAME !4 Returns RPC_Internal_StoreParameters !3 #ELSE #IFSAME !6 Returns RPC_Internal_StoreParameters !3 !5 #ELSE #IFSAME !8 Returns RPC_Internal_StoreParameters !3 !5 !7 #ELSE RPC_Internal_StoreParameters !3 !5 !7 !9 #ENDIF #ENDIF #ENDIF Function_Return (InvokeMessage(Self,0,"GET_!1",True)) End_Function #ENDCOMMAND // Tries to get a Window_Handle to a DF RPC server. // How is it done? // 1.All DFWin.. windows are checked // 2.The GetClassLong value is got (should contain the Window_Handle of the RPCManager) // 3.The label of this Manager is got and compared with the given Name // 4.If identical the window_handle is retourned. Function RPCWindow_Handle Global String sName Returns Handle Integer iRet Handle hwnd Pointer pPtr pClass String sClass Move (FindWindowEx(0,0,0,0)) To hwnd Move (GetWindow(hwnd,GW_HWNDFIRST)) To hwnd //____Alle_windows_durchlaufen...________________________ While (hwnd Ne 0) Move (GetWindowLong(hwnd,GWL_USERDATA)) To pPtr // Should be the window_handle of the RPCManger Move (Repeat(Character(0),20)) To sClass GetAddress Of sClass To pClass Move (GetClassName(hwnd,pClass,11)) To iRet // Only Dataflexclasses! Move (Left(sClass,10)) To sClass If pPtr Ne 0 If ((sClass Eq "DFFrameCla") Or (sClass Eq "DFWinClass")) Begin // If a DFClass and the Window_Handle is set! If (Trim(Left(RPCWindowCaption(pPtr),20))) Eq sName Begin Function_Return pPtr End End Move (GetWindow(hwnd,GW_HWNDNEXT)) To hwnd End Function_Return 0 End_Function // Sends data via WM_COPYDATA to the specific window Function RPCSendData Global Handle hwndReceiver Handle hwndSender String sStr Returns Integer String sBuff sData Pointer pBuff pData iL Integer iRet Move (Length(sStr)) To iL Move sStr To sData GetAddress Of sData To pData Zerotype COPYDATASTRUCT To sBuff put 3 To sBuff at COPYDATASTRUCT.dwData put (iL) To sBuff at COPYDATASTRUCT.cbData put pData To sBuff at COPYDATASTRUCT.lpData GetAddress Of sBuff To pBuff Move (SendMessage(hwndReceiver,WM_COPYDATA,hwndSender,pBuff)) To iRet Function_Return iRet End_Function // Gets the String out of the given Pointer. Function RPCReceiveData Global Pointer pCopyData Returns String String sData Pointer pData pTxt Integer iRet iL Zerotype COPYDATASTRUCT To sData GetAddress Of sData To pData Move (CopyMemory(pData,pCopyData,COPYDATASTRUCT_SIZE)) To iRet getbuff From sData at COPYDATASTRUCT.cbData To iL getbuff From sData at COPYDATASTRUCT.lpData To pTxt Move (Repeat(Character(0),iL)) To sData GetAddress Of sData To pData Move (CopyMemory(pData,pTxt,iL)) To iRet Function_Return (sData) End_Function // To Store the RPC information in a DataBlock and retrieve it from there. TYPE tRPC_Header Field tRPC_Header.cStartCode as Char 4 // StartCode Field tRPC_Header.dMessageID as Dword // ID of the Message Field tRPC_Header.sMessageName as Char 100 // max 100 characters allowed Field tRPC_Header.dParameters as Dword // Number of parameters END_TYPE TYPE tRPC_Parameter Field tRPC_Parameter.dOffset as Dword Field tRPC_Parameter.dLength as Dword END_TYPE // Allows to connect to a RPCServer in a Dataflexprogram. Class cRPCClient Is a DFControl // Adding properties and setting default values Procedure Construct_Object Forward Send Construct_Object Property String psServerName Public "" Property String psVDFName Public "" Property Handle phServerHandle Public 0 Property String psStartCode Public "RPC" Property Integer piMessageID Public 0 Property String psMessageName Public "" Object oParameters Is an Array End_Object Set Focus_Mode To nonfocusable End_Procedure // Checks if the server handle is valid! Function isServerHandleValid Returns Integer Handle hwnd Get phServerHandle To hwnd If hwnd Ne 0 Begin If (Trim(Left(RPCWindowCaption(hwnd),20))) Eq (psServerName(Self)) Function_Return 1 Set phServerHandle To 0 End Function_Return 0 End_Function // Checks if an instance of the Server is running. Function isServerRunning Returns Integer Handle hwnd Move (RPCWindow_Handle(psServerName(Self))) To hwnd Function_Return hwnd End_Function // Will connect to the specified server. Procedure ConnectToServer Integer iMainID iRet Handle hwnd If Not (isServerHandleValid(Self)) Begin Move (RPCWindow_Handle(psServerName(Self))) To hwnd If hwnd Set phServerHandle To hwnd Else Begin If (psVDFName(Self)) Eq "" RUNPROGRAM BACKGROUND "DFRUN" (psServerName(Self)) Else RUNPROGRAM BACKGROUND "DFRUN" (psVDFName(Self)) Move (RPCWindow_Handle(psServerName(Self))) To hwnd If hwnd Set phServerHandle To hwnd Get Main_Panel_ID To iMainID If iMainID Move (SetForeGroundWindow(Window_Handle(iMainID))) To iRet End End End_Procedure // Waits for the respone of the last call of InvokeMessage Function WaitForResponse Returns String Integer iL iC Handle hwnd String sCaption sResponse Get phServerHandle To hwnd Repeat Move (RPCWindowCaption(hwnd)) To sCaption Move (Length(sCaption)-20) To iL If iL Lt 0 Move 0 To iL Move (Right(sCaption,iL)) To sCaption If (Trim(sCaption)) Ne "#WAIT#" Function_Return sCaption Until (1) End_Function // Sets the return value. Procedure SetWindowResponse Handle hwndReceiver String sResp String sCaption Integer iRet Move (RPCWindowCaption(hwndReceiver)) To sCaption Move (Pad(sCaption,20)) To sCaption Append sCaption sResp Move (SetWindowCaption(hwndReceiver,sCaption)) To iRet End_Procedure // calls the specific message. Function InvokeMessageEx Integer iMsgID String sName Integer iToFront Returns String String sData sRet sCaption Handle hwndReceiver hwndSender iRet Set piMessageID To iMsgID Set psMessageName To sName Send ConnectToServer Get phServerHandle To hwndReceiver Get Window_Handle To hwndSender If (iToFront) If hwndReceiver move (SetForeGroundWindow(hwndReceiver)) to iRet Send SetWindowResponse (phServerHandle(Self)) "#WAIT#" Get CreateRPCBlock To sData Get RPCSendData hwndReceiver hwndSender sData To iRet Get WaitForResponse To sRet Send ClearAllParameters Function_Return sRet End_Function Function InvokeMessage Integer iMsgID String sName Returns String Function_Return (InvokeMessageEx(Self,iMsgID,sName,False)) End_Function // Legt einen Parameters fest. Procedure DefineParameter String sPara Set value Of (oParameters(Self)) Item (Item_Count(oParameters(Self))) To sPara End_Procedure Procedure ClearAllParameters Send Delete_Data To (oParameters(Self)) End_Procedure // Creates a DataBlock. Function CreateRPCBlock Returns String String sBlock sData sPara sValue Integer iParas iL iC iOffset Get Item_Count Of (oParameters(Self)) To iParas Zerotype tRPC_Header To sBlock Put_String (psStartCode(Self)) To sBlock at tRPC_Header.cStartCode Put (piMessageID(Self)) To sBlock at tRPC_Header.dMessageID Put_String (psMessageName(Self)) To sBlock at tRPC_Header.sMessageName Put iParas To sBlock at tRPC_Header.dParameters Move (tRPC_Header_Size +(iParas*tRPC_Parameter_Size)+1) To iOffset //____Append_all_Parameters_Data..._____________ For iC From 0 To (iParas-1) Get value Of (oParameters(Self)) Item iC To sValue Move (Length(sValue)) To iL Zerotype tRPC_Parameter To sPara Put iOffset To sPara at tRPC_Parameter.dOffset Put iL To sPara at tRPC_Parameter.dLength Move (iOffset+iL) To iOffset Append sBlock sPara Append sData sValue End Append sBlock sData GetBuff From sBlock at tRPC_Header.dMessageID To iC Get ParseRPCBlock sBlock To iC Function_Return sBlock End_Function // Holt einen Parameter aus dem RPC DatenBlock! Function ParseRPCParameter String sBlock Integer iNr Returns String String sPara sRet Integer iOffset iPos iL Move tRPC_Header_Size To iOffset Move (((iNr-1)*tRPC_Parameter_Size)+iOffset+1) To iOffset Move (Mid(sBlock,tRPC_Parameter_Size,iOffset)) To sPara GetBuff From sPara at tRPC_Parameter.dOffset To iPos GetBuff From sPara at tRPC_Parameter.dLength To iL Move (Mid(sBlock,iL,iPos)) To sRet Function_Return sRet End_Function // Füllt alle Parameter und die Message ID ein! Function ParseRPCBlock String sBlock Returns Integer Integer iPos iParas iMsgID iL iC String sPara sStartCode sName GetBuff_String From sBlock at tRPC_Header.cStartCode To sStartCode Move (CString(sStartCode)) To sStartCode If (Trim(sStartCode)) Eq (psStartCode(Self)) Begin GetBuff From sBlock at tRPC_Header.dMessageID To iMsgID GetBuff From sBlock at tRPC_Header.dParameters To iParas GetBuff_String From sBlock at tRPC_Header.sMessageName To sName Set piMessageID To iMsgID Set psMessageName To (CString(sName)) Send Delete_Data To (oParameters(Self)) For iC From 1 To iParas Move (ParseRPCParameter(Self,sBlock,iC)) To sPara Set value Of (oParameters(Self)) Item (iC-1) To sPara End Function_Return 1 // Ok was an RPC Block End Function_Return 0 // No RPC Data End_Function End_Class