537 lines
28 KiB
Plaintext
537 lines
28 KiB
Plaintext
Function Messaging_Services(@Service, @Params)
|
|
/***********************************************************************************************************************
|
|
|
|
This program is proprietary and is not to be used by or disclosed to others, nor is it to be copied without written
|
|
permission from SRP Computer Solutions, Inc.
|
|
|
|
Name : Messaging_Services
|
|
|
|
Description : Handler program for all Messaging services.
|
|
|
|
Notes :
|
|
|
|
Parameters :
|
|
Service [in] -- Name of the service being requested
|
|
Param1-10 [in/out] -- Additional request parameter holders
|
|
Response [out] -- Response to be sent back to the Controller (MCP) or requesting procedure
|
|
|
|
Metadata :
|
|
|
|
History : (Date, Initials, Notes)
|
|
05/30/18 dmb Original programmer.
|
|
06/17/18 dmb Add the ReleaseLock service.
|
|
06/18/18 dmb Refine the way CallBackType and CallBack arguments are handled. Update the ProcessCallBack
|
|
gosub to make it easier to understand how the call backs are handled.
|
|
|
|
***********************************************************************************************************************/
|
|
|
|
#pragma precomp SRP_PreCompiler
|
|
|
|
$insert LOGICAL
|
|
$insert SERVICE_SETUP
|
|
$insert MESSAGING_EQUATES
|
|
|
|
Declare function Get_Property, GetCurrentProcessId, Database_Services, SRP_String
|
|
Declare subroutine Set_Property, Utility
|
|
|
|
GoToService else
|
|
Error_Services('Add', Service : ' is not a valid service request within the ' : ServiceModule : ' module.')
|
|
end
|
|
|
|
Return Response OR ''
|
|
|
|
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
// Service Parameter Options
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
Options BOOLEAN = True$, False$
|
|
Options MESSAGES = 'GetLockOwner', 'GetLoggedInUsers', 'SetPopupMessage', 'ReleaseLock', 'CloseSession', 'RunProcedure', 'RefreshSchedule'
|
|
Options MESSAGE_TYPES = 'Request', 'Response'
|
|
Options CALLBACK_TYPES = 'Procedure', 'EventHandler'
|
|
|
|
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
// Services
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SendMessage
|
|
//
|
|
// Sends out a message for processing. This uses the DirectConnect control to broadcast the message and picked up by
|
|
// all sessions running the DirectControl control.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SendMessage(Message=MESSAGES, Type=MESSAGE_TYPES, Sender, Recipients, Arguments, CallBackType=CALLBACK_TYPES, CallBack, DebugMode)
|
|
|
|
If Message NE '' then
|
|
If Sender EQ '' then Sender = @Station
|
|
MessageObj = ''
|
|
If SRP_JSON(MessageObj, 'NEW', 'OBJECT') then
|
|
SRP_JSON(MessageObj, 'SETVALUE', 'Message', Message, 'STRING')
|
|
SRP_JSON(MessageObj, 'SETVALUE', 'Sender', Sender, 'STRING')
|
|
SRP_JSON(MessageObj, 'SETVALUE', 'Type', Type, 'STRING')
|
|
SRP_JSON(MessageObj, 'SETVALUE', 'Recipients', Recipients, 'STRING')
|
|
SRP_JSON(MessageObj, 'SETVALUE', 'Arguments', Arguments, 'STRING')
|
|
SRP_JSON(MessageObj, 'SETVALUE', 'CallBackType', CallBackType, 'STRING')
|
|
Swap '@WINDOW' with @Window in CallBack
|
|
Swap '@Window' with @Window in CallBack
|
|
SRP_JSON(MessageObj, 'SETVALUE', 'CallBack', CallBack, 'STRING')
|
|
SRP_JSON(MessageObj, 'SETVALUE', 'DebugMode', DebugMode, 'BOOLEAN')
|
|
JSONMessage = SRP_JSON(MessageObj, 'STRINGIFY', 'FAST')
|
|
SRP_JSON(MessageObj, 'RELEASE')
|
|
Convert \0A\ to '' in JSONMessage
|
|
Convert \0D\ to '' in JSONMessage
|
|
B64Message = SRP_Encode(JSONMessage, 'BASE64')
|
|
objDirectConnect = ''
|
|
If SRP_COM(objDirectConnect, 'CREATE', 'SRP.DirectConnectSync') then
|
|
SRP_COM(objDirectConnect, 'CALL', 'Broadcast', Server.Name$, Server.Port$, B64Message)
|
|
SRP_COM(objDirectConnect, 'RELEASE')
|
|
end
|
|
end
|
|
end else
|
|
Error_Services('Add', 'Message argument was missing in the ' : Service : ' service.')
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// ProcessMessage
|
|
//
|
|
// Processes an incoming message. This service parses the message (which is expected be Base64 encoded). If the message
|
|
// type is 'Request', it will get routed to the appropriate service. Otherwise, it is assumed to be a 'Response' and
|
|
// the entire JSON message will be passed on to the caller to decide what to do with it.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service ProcessMessage(B64Message)
|
|
|
|
MessageResponse = ''
|
|
|
|
If B64Message NE '' then
|
|
JSONMessage = SRP_Decode(B64Message, 'BASE64')
|
|
ParseResponse = SRP_JSON(MessageObj, 'PARSE', JSONMessage)
|
|
If ParseResponse EQ '' then
|
|
Recipients = SRP_JSON(MessageObj, 'GETVALUE', 'Recipients', '')
|
|
// Check to see if the this station is a recepient of this message. If the Recipients is 'ALL', then swap
|
|
// this word with the current @Station in order to make sure the current station is found. Assume that
|
|
// multiple Recipients will be @FM delimited.
|
|
Convert ',' to @FM in Recipients
|
|
Convert @STM to @FM in Recipients
|
|
Convert @TM to @FM in Recipients
|
|
Convert @SVM to @FM in Recipients
|
|
Convert @VM to @FM in Recipients
|
|
Convert @Lower_Case to @Upper_Case in Recipients
|
|
IsMessageRecepient = False$ ; // Assume not a recepient for this message for now.
|
|
Locate 'ALL' in Recipients using @FM setting fPos then
|
|
IsMessageRecepient = True$
|
|
end else
|
|
Locate @Station in Recipients using @FM setting fPos then
|
|
IsMessageRecepient = True$
|
|
end else
|
|
Locate @User4 in Recipients using @FM setting fPos then
|
|
IsMessageRecepient = True$
|
|
end else
|
|
Locate @Username in Recipients using @FM setting fPos then
|
|
IsMessageRecepient = True$
|
|
end
|
|
end
|
|
end
|
|
end
|
|
If IsMessageRecepient then
|
|
Message = SRP_JSON(MessageObj, 'GETVALUE', 'Message', '')
|
|
Type = SRP_JSON(MessageObj, 'GETVALUE', 'Type', '')
|
|
Sender = SRP_JSON(MessageObj, 'GETVALUE', 'Sender', '')
|
|
Arguments = SRP_JSON(MessageObj, 'GETVALUE', 'Arguments', '')
|
|
CallBackType = SRP_JSON(MessageObj, 'GETVALUE', 'CallBackType', '')
|
|
CallBack = SRP_JSON(MessageObj, 'GETVALUE', 'CallBack', '')
|
|
DebugMode = SRP_JSON(MessageObj, 'GETVALUE', 'DebugMode', '')
|
|
If Type _EQC 'Response' then
|
|
MessageResponse = JSONMessage
|
|
If CallBack NE '' then
|
|
GoSub ProcessCallBack
|
|
end
|
|
end else
|
|
Messaging_Services(Message, Sender, Recipients, Arguments, CallBackType, CallBack, DebugMode)
|
|
end
|
|
end
|
|
end else
|
|
Error_Services('Add', 'Error parsing the JSON message in the ' : Service : ' service.')
|
|
end
|
|
end else
|
|
Error_Services('Add', 'B64Message argument was missing in the ' : Service : ' service.')
|
|
end
|
|
|
|
Response = MessageResponse
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// RunProcedure
|
|
//
|
|
// Message request to identify the owner of a lock for a specific Key ID and Table.
|
|
//
|
|
// Arguments<1> -- The name of the Table with the locked Key ID.
|
|
// Arguments<2> -- The the Key ID that is locked.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service RunProcedure(Sender, Recipients, Arguments, CallBackType, CallBack, DebugMode)
|
|
|
|
Convert ',' to @FM in Arguments ; // A comma might be used if the SRP Editor is used to test this service.
|
|
Procedure = Arguments<1>
|
|
Params = Arguments<2>
|
|
Dim ProcParams(10)
|
|
For each Param in Params using @VM setting pPos
|
|
ProcParams(pPos) = Param
|
|
Next Param
|
|
NumArguments = DCount(Params, @VM)
|
|
Begin Case
|
|
Case NumArguments EQ 0 ; Call @Procedure()
|
|
Case NumArguments EQ 1 ; Call @Procedure(ProcParams(1))
|
|
Case NumArguments EQ 2 ; Call @Procedure(ProcParams(1), ProcParams(2))
|
|
Case NumArguments EQ 3 ; Call @Procedure(ProcParams(1), ProcParams(2), ProcParams(3))
|
|
Case NumArguments EQ 4 ; Call @Procedure(ProcParams(1), ProcParams(2), ProcParams(3), ProcParams(4))
|
|
Case NumArguments EQ 5 ; Call @Procedure(ProcParams(1), ProcParams(2), ProcParams(3), ProcParams(4), ProcParams(5))
|
|
Case NumArguments EQ 6 ; Call @Procedure(ProcParams(1), ProcParams(2), ProcParams(3), ProcParams(4), ProcParams(5), ProcParams(6))
|
|
Case NumArguments EQ 7 ; Call @Procedure(ProcParams(1), ProcParams(2), ProcParams(3), ProcParams(4), ProcParams(5), ProcParams(6), ProcParams(7))
|
|
Case NumArguments EQ 8 ; Call @Procedure(ProcParams(1), ProcParams(2), ProcParams(3), ProcParams(4), ProcParams(5), ProcParams(6), ProcParams(7), ProcParams(8))
|
|
Case NumArguments EQ 9 ; Call @Procedure(ProcParams(1), ProcParams(2), ProcParams(3), ProcParams(4), ProcParams(5), ProcParams(6), ProcParams(7), ProcParams(8), ProcParams(9))
|
|
Case Otherwise$ ; Call @Procedure(ProcParams(1), ProcParams(2), ProcParams(3), ProcParams(4), ProcParams(5), ProcParams(6), ProcParams(7), ProcParams(8), ProcParams(9), ProcParams(10))
|
|
End Case
|
|
|
|
If Error_Services('NoError') then
|
|
Arguments = ''
|
|
Arguments := 'AtStation : ' : @Station : @FM
|
|
Arguments := 'AtUser4 : ' : @User4 : @FM
|
|
Arguments := 'AtUserName : ' : @UserName : @FM
|
|
Arguments := 'ProcessID : ' : GetCurrentProcessId()
|
|
Messaging_Services('SendMessage', Service, 'Response', @Station, Sender, Arguments, CallBackType, CallBack, DebugMode)
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetLockOwner
|
|
//
|
|
// Message request to identify the owner of a lock for a specific Key ID and Table.
|
|
//
|
|
// Arguments<1> -- The name of the Table with the locked Key ID.
|
|
// Arguments<2> -- The the Key ID that is locked.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetLockOwner(Sender, Recipients, Arguments, CallBackType, CallBack, DebugMode)
|
|
|
|
Convert ',' to @FM in Arguments ; // A comma might be used if the SRP Editor is used to test this service.
|
|
TableName = Arguments<1>
|
|
KeyID = Arguments<2>
|
|
IsKeyIDSelfLock = Database_Services('IsKeyIDSelfLocked', TableName, KeyID)
|
|
If IsKeyIDSelfLock EQ True$ then
|
|
Arguments = ''
|
|
Arguments := 'AtStation : ' : @Station : @FM
|
|
Arguments := 'AtUser4 : ' : @User4 : @FM
|
|
Arguments := 'AtUserName : ' : @UserName : @FM
|
|
Arguments := 'ProcessID : ' : GetCurrentProcessId() : @FM
|
|
Arguments := 'TableName : ' : TableName : @FM
|
|
Arguments := 'KeyID : ' : KeyID
|
|
Messaging_Services('SendMessage', Service, 'Response', @Station, Sender, Arguments, CallBackType, CallBack, DebugMode)
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// ReleaseLock
|
|
//
|
|
// Message request release the lock of a specific Key ID and Table.
|
|
//
|
|
// Arguments<1> -- The name of the Table with the locked Key ID.
|
|
// Arguments<2> -- The the Key ID that is locked.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service ReleaseLock(Sender, Recipients, Arguments, CallBackType, CallBack, DebugMode)
|
|
|
|
Convert ',' to @FM in Arguments ; // A comma might be used if the SRP Editor is used to test this service.
|
|
TableName = Arguments<1>
|
|
KeyID = Arguments<2>
|
|
KeyIDUnlocked = Database_Services('ReleaseKeyIDLock', TableName, KeyID)
|
|
If KeyIDUnlocked EQ True$ then
|
|
Arguments = ''
|
|
Arguments := 'AtStation : ' : @Station : @FM
|
|
Arguments := 'AtUser4 : ' : @User4 : @FM
|
|
Arguments := 'AtUserName : ' : @UserName : @FM
|
|
Arguments := 'ProcessID : ' : GetCurrentProcessId() : @FM
|
|
Arguments := 'TableName : ' : TableName : @FM
|
|
Arguments := 'KeyID : ' : KeyID
|
|
Messaging_Services('SendMessage', Service, 'Response', @Station, Sender, Arguments, CallBackType, CallBack, DebugMode)
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetLoggedInUsers
|
|
//
|
|
// Message request to returned logged in users.
|
|
//
|
|
// Arguments<1> -- An @VM array of users to be checked against. If empty, all logged in users will be returned.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetLoggedInUsers(Sender, Recipients, Arguments, CallBackType, CallBack, DebugMode)
|
|
|
|
Convert ',' to @VM in Arguments ; // A comma might be used if the SRP Editor is used to test this service.
|
|
If Arguments EQ '' then Arguments = @User4
|
|
Locate @User4 in Arguments using @VM setting vPos then
|
|
Arguments = ''
|
|
Arguments := 'AtStation' : @VM : @Station : @FM
|
|
Arguments := 'AtUser4' : @VM : @User4 : @FM
|
|
Arguments := 'AtUserName' : @VM : @UserName : @FM
|
|
Arguments := 'ProcessID' : @VM : GetCurrentProcessId() : @FM
|
|
Arguments := 'LSL2Version' : @VM : Xlate('LSL_USERS', @User4, 'LSL2_VERSION', 'X') : @FM
|
|
Arguments := 'OCXVersion' : @VM : Xlate('LSL_USERS', @User4, 'OCX_VERSION', 'X')
|
|
Messaging_Services('SendMessage', Service, 'Response', @Station, Sender, Arguments, CallBackType, CallBack, DebugMode)
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetPopupMessage
|
|
//
|
|
// Message request to see if the indicated user is logged in.
|
|
//
|
|
// Arguments<1> -- The message to display in the SRP Popup control. @TM delimiters will be used as linefeeds.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetPopupMessage(Sender, Recipients, Arguments, CallBackType, CallBack, DebugMode)
|
|
|
|
Transfer Arguments to Message
|
|
Convert @TM to @FM in Message
|
|
Swap \0D0A\ with @FM in Message
|
|
|
|
PopupCtrl = MessageProcessor$ : '.OLE_POPUP'
|
|
PopupVisible = Get_Property(PopupCtrl, 'OLE.Visible')
|
|
If PopupVisible EQ True$ then
|
|
Send_Message(PopupCtrl, 'OLE.Close')
|
|
end
|
|
// Set the Theme property to Custom so the special background settings will work as expected.
|
|
Set_Property(PopupCtrl, 'OLE.Theme', 'Custom')
|
|
Background = ''
|
|
Background<1> = 'Vertical(Gradient(RGB(241,241,241), RGB(241,241,241)), Border(RGB(28,28,28)))'
|
|
Background<2> = 'Vertical(Gradient(RGB(53,178,210) L=40, RGB(53,178,210) L=40))'
|
|
Background<3> = 'Vertical(Gradient(RGB(53,178,210) L=30, RGB(53,178,210) L=30))'
|
|
Set_Property(PopupCtrl, 'OLE.Background', Background)
|
|
// Set the ItemList property.
|
|
NumLines = Count(Message, @FM) + (Message NE '')
|
|
MessageFormatted = ''
|
|
LongLen = 0
|
|
MaxLen = 300
|
|
For ItemNo = 1 to NumLines
|
|
TextLine = Message<ItemNo>
|
|
TextLen = SRP_String('GetWidth', TextLine, 'Segoe UI' : @SVM : 10 : @SVM : 400)
|
|
If TextLen GT MaxLen then
|
|
// Wrap long text lines
|
|
NewTextLine = ''
|
|
For Each Word in TextLine using ' '
|
|
TextLen = SRP_String('GetWidth', NewTextLine : Word : ' ', 'Segoe UI' : @SVM : 10 : @SVM : 400)
|
|
If TextLen GT MaxLen then
|
|
// The current word will cause the current line to be too long. Add the line to the message and
|
|
// clear the current line.
|
|
MessageFormatted := NewTextLine : @FM
|
|
NewTextLine = ''
|
|
end
|
|
NewTextLine := Word : ' '
|
|
Next Word
|
|
// Add the last line to the message.
|
|
MessageFormatted := NewTextLine : @FM
|
|
end else
|
|
MessageFormatted := TextLine : @FM
|
|
end
|
|
Next ItemNo
|
|
MessageFormatted[-1, 1] = ''
|
|
Transfer MessageFormatted to Message
|
|
NumLines = Count(Message, @FM) + (Message NE '') ; // Recalculate this for popup display.
|
|
ItemWidth = MaxLen
|
|
FullWidth = ItemWidth + 40 ; // Add 10 to each side for margins.
|
|
ItemCnt = 0
|
|
LeftMarg = 20
|
|
ItemHeight = 18 ; // Standard height for a non-bold item.
|
|
VertPos = 0 ; // The first item will be 5 pixels from the top of the SRP Popup display.
|
|
// Create the items to be displayed in the SRP Popup control.
|
|
ItemList = ''
|
|
// Add the message header.
|
|
ItemCnt += 1
|
|
ItemList<ItemCnt, 1> = 0 : @SVM : VertPos : @SVM : FullWidth : @SVM : 41
|
|
ItemList<ItemCnt, 2> = ' System Notification'
|
|
ItemList<ItemCnt, 3> = 'RGB(252,252,252)' : @SVM : 'RGB(28,28,28))'
|
|
ItemList<ItemCnt, 4> = 'Segoe UI' : @SVM : 12 : @SVM : 700
|
|
ItemList<ItemCnt, 5> = 'Left' : @SVM : 'Center'
|
|
VertPos += 41
|
|
// Add the thin blue border between the header and the message body.
|
|
ItemCnt += 1
|
|
ItemList<ItemCnt, 1> = 1 : @SVM : VertPos : @SVM : FullWidth - 2 : @SVM : 3
|
|
ItemList<ItemCnt, 3> = 'RGB(252,252,252)' : @SVM : 'RGB(53,178,210))'
|
|
VertPos += 10
|
|
// Add the message lines.
|
|
For LineNo = 1 to NumLines
|
|
ItemCnt += 1
|
|
TextLine = Message<LineNo>
|
|
|
|
// Add the next line to the ItemList.
|
|
ItemList<ItemCnt, 1> = LeftMarg : @SVM : VertPos : @SVM : ItemWidth : @SVM : ItemHeight
|
|
ItemList<ItemCnt, 2> = TextLine
|
|
ItemList<ItemCnt, 3> = 'RGB(83,83,83)'
|
|
ItemList<ItemCnt, 4> = 'Segoe UI' : @SVM : 10 : @SVM : 400
|
|
ItemList<ItemCnt, 5> = 'Left' : @SVM : 'Center'
|
|
|
|
VertPos += ItemHeight ; // Add for height for the next item.
|
|
Next ItemNo
|
|
VertPos += 10
|
|
|
|
// Add the dismiss and reply buttons.
|
|
ItemCnt += 1
|
|
ItemList<ItemCnt, 1> = 60 : @SVM : VertPos : @SVM : 100 : @SVM : 38
|
|
ItemList<ItemCnt, 2> = 'Dismiss'
|
|
ItemList<ItemCnt, 3> = 'RGB(252,252,252)' : @SVM : 'RGB(53,178,210))'
|
|
ItemList<ItemCnt, 4> = 'Segoe UI' : @SVM : 12 : @SVM : 400
|
|
ItemList<ItemCnt, 5> = 'Center' : @SVM : 'Center'
|
|
ItemList<ItemCnt, 7> = True$
|
|
* ItemCnt += 1
|
|
* ItemList<ItemCnt, 1> = 180 : @SVM : VertPos : @SVM : 100 : @SVM : 38
|
|
* ItemList<ItemCnt, 2> = 'Reply'
|
|
* ItemList<ItemCnt, 3> = 'RGB(252,252,252)' : @SVM : 'RGB(53,178,210))'
|
|
* ItemList<ItemCnt, 4> = 'Segoe UI' : @SVM : 12 : @SVM : 400
|
|
* ItemList<ItemCnt, 5> = 'Center' : @SVM : 'Center'
|
|
* ItemList<ItemCnt, 7> = True$
|
|
VertPos += 48 ; // Increase the height of the button and the entire SRP Popup to create a bottom margin.
|
|
|
|
Set_Property(PopupCtrl, 'OLE.ItemList', ItemList)
|
|
// Set the Size of the SRP Popup display to be the full width and height needed to contain all items.
|
|
Set_Property(PopupCtrl, 'OLE.Size', 0 : @FM : 0 : @FM : FullWidth : @FM : VertPos)
|
|
// Finally, display the SRP Popup control.
|
|
Set_Property(PopupCtrl, 'OLE.AllowMove', True$)
|
|
Set_Property(PopupCtrl, 'OLE.ShowDelay', 0)
|
|
SystemSize = Get_Property('SYSTEM', 'SIZE')
|
|
AppMainSize = Get_Property(MessageProcessor$, 'SIZE')
|
|
ShowAtX = (SystemSize<1> - FullWidth) / 2
|
|
ShowAtY = (SystemSize<2> - VertPos) / 2
|
|
* Set_Property(PopupCtrl, 'OLE.Visible', True$)
|
|
Send_Message(PopupCtrl, 'OLE.ShowAt', ShowAtX, ShowAtY)
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// CloseSession
|
|
//
|
|
// Message request release the lock of a specific Key ID and Table.
|
|
//
|
|
// Arguments<1> -- An @VM array of sessions to be closed. If empty or if the keywork "All" is present, all sessions will
|
|
// be closed. Note, the Station ID, SSO Username, or the MES Username can be used to identify the
|
|
// session.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service CloseSession(Sender, Recipients, Arguments, CallBackType, CallBack, DebugMode)
|
|
|
|
Transfer Arguments to Sessions
|
|
Convert ',' to @FM in Sessions ; // A comma might be used if the SRP Editor is used to test this service.
|
|
|
|
IsSession = False$ ; // Assume not a session to be closed for now.
|
|
Locate 'ALL' in Sessions using @FM setting fPos then
|
|
IsSession = True$
|
|
end else
|
|
Locate @Station in Sessions using @FM setting fPos then
|
|
IsSession = True$
|
|
end else
|
|
Locate @User4 in Sessions using @FM setting fPos then
|
|
IsSession = True$
|
|
end else
|
|
Locate @Username in Sessions using @FM setting fPos then
|
|
IsSession = True$
|
|
end
|
|
end
|
|
end
|
|
end
|
|
|
|
If IsSession then
|
|
// This session needs to be closed.
|
|
Utility('DESTROY', 'SYSTEM')
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
// Internal GoSubs
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// ProcessCallBack
|
|
//
|
|
// Implements the indicated call back for the resonse. Call backs can either be a procedure or an event handler, which
|
|
// is specified by the CallBackType argument. Default value is Procedure. If call back type is a procedure, the CallBack
|
|
// argument is expected to have this format:
|
|
//
|
|
// RoutineName[,Arg1, Arg2...Arg10]
|
|
//
|
|
// If the call back type is an event handler, the CallBack argument is expected to have this format:
|
|
//
|
|
// FormName,Event[,Arg1, Arg2...Arg9]
|
|
//
|
|
// '@MESSAGE' and '@ARGUMENTS' are special placeholder values that will be swapped with the actual values returned by
|
|
// the response. All other values will be returned as is.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
ProcessCallBack:
|
|
|
|
If CallBackType EQ '' then CallBackType = 'Procedure'
|
|
|
|
If Index(CallBack, '(', 1) then
|
|
CallBack[-1, 1] = '' ; // Remove close parenthesis.
|
|
CallBackTarget = CallBack[1, '(']
|
|
end else
|
|
CallBackTarget = CallBack[1, ',']
|
|
end
|
|
CallBack = CallBack[Col2() + 1, 999999]
|
|
CallBack = Trim(CallBack)
|
|
Swap ', ' with @FM in CallBack
|
|
Swap ',' with @FM in CallBack
|
|
NumArguments = DCount(CallBack, @FM)
|
|
Dim CallBackArguments(10)
|
|
For Each CallBackArgument in CallBack using @FM setting ArgumentCnt
|
|
If CallBackArgument _EQC '@MESSAGE' then CallBackArgument = Message
|
|
If CallBackArgument _EQC '@ARGUMENTS' then CallBackArgument = Arguments
|
|
CallBackArguments(ArgumentCnt) = CallBackArgument
|
|
Until ArgumentCnt GE 10
|
|
Next CallBackArgument
|
|
|
|
Convert @Lower_Case to @Upper_Case in CallBackTarget
|
|
Begin Case
|
|
Case CallBackType _EQC 'Procedure'
|
|
Procedure = CallBackTarget
|
|
Begin Case
|
|
Case NumArguments EQ 0 ; Call @Procedure()
|
|
Case NumArguments EQ 1 ; Call @Procedure(CallBackArguments(1))
|
|
Case NumArguments EQ 2 ; Call @Procedure(CallBackArguments(1), CallBackArguments(2))
|
|
Case NumArguments EQ 3 ; Call @Procedure(CallBackArguments(1), CallBackArguments(2), CallBackArguments(3))
|
|
Case NumArguments EQ 4 ; Call @Procedure(CallBackArguments(1), CallBackArguments(2), CallBackArguments(3), CallBackArguments(4))
|
|
Case NumArguments EQ 5 ; Call @Procedure(CallBackArguments(1), CallBackArguments(2), CallBackArguments(3), CallBackArguments(4), CallBackArguments(5))
|
|
Case NumArguments EQ 6 ; Call @Procedure(CallBackArguments(1), CallBackArguments(2), CallBackArguments(3), CallBackArguments(4), CallBackArguments(5), CallBackArguments(6))
|
|
Case NumArguments EQ 7 ; Call @Procedure(CallBackArguments(1), CallBackArguments(2), CallBackArguments(3), CallBackArguments(4), CallBackArguments(5), CallBackArguments(6), CallBackArguments(7))
|
|
Case NumArguments EQ 8 ; Call @Procedure(CallBackArguments(1), CallBackArguments(2), CallBackArguments(3), CallBackArguments(4), CallBackArguments(5), CallBackArguments(6), CallBackArguments(7), CallBackArguments(8))
|
|
Case NumArguments EQ 9 ; Call @Procedure(CallBackArguments(1), CallBackArguments(2), CallBackArguments(3), CallBackArguments(4), CallBackArguments(5), CallBackArguments(6), CallBackArguments(7), CallBackArguments(8), CallBackArguments(9))
|
|
Case Otherwise$ ; Call @Procedure(CallBackArguments(1), CallBackArguments(2), CallBackArguments(3), CallBackArguments(4), CallBackArguments(5), CallBackArguments(6), CallBackArguments(7), CallBackArguments(8), CallBackArguments(9), CallBackArguments(10))
|
|
End Case
|
|
Case CallBackType _EQC 'EventHandler'
|
|
Form = CallBackTarget
|
|
Event = CallBackArguments(1)
|
|
Begin Case
|
|
Case NumArguments EQ 1 ; Send_Event(Form, Event)
|
|
Case NumArguments EQ 2 ; Send_Event(Form, Event, CallBackArguments(2))
|
|
Case NumArguments EQ 3 ; Send_Event(Form, Event, CallBackArguments(2), CallBackArguments(3))
|
|
Case NumArguments EQ 4 ; Send_Event(Form, Event, CallBackArguments(2), CallBackArguments(3), CallBackArguments(4))
|
|
Case NumArguments EQ 5 ; Send_Event(Form, Event, CallBackArguments(2), CallBackArguments(3), CallBackArguments(4), CallBackArguments(5))
|
|
Case NumArguments EQ 6 ; Send_Event(Form, Event, CallBackArguments(2), CallBackArguments(3), CallBackArguments(4), CallBackArguments(5), CallBackArguments(6))
|
|
Case NumArguments EQ 7 ; Send_Event(Form, Event, CallBackArguments(2), CallBackArguments(3), CallBackArguments(4), CallBackArguments(5), CallBackArguments(6), CallBackArguments(7))
|
|
Case NumArguments EQ 8 ; Send_Event(Form, Event, CallBackArguments(2), CallBackArguments(3), CallBackArguments(4), CallBackArguments(5), CallBackArguments(6), CallBackArguments(7), CallBackArguments(8))
|
|
Case NumArguments EQ 9 ; Send_Event(Form, Event, CallBackArguments(2), CallBackArguments(3), CallBackArguments(4), CallBackArguments(5), CallBackArguments(6), CallBackArguments(7), CallBackArguments(8), CallBackArguments(9))
|
|
Case Otherwise$ ; Send_Event(Form, Event, CallBackArguments(2), CallBackArguments(3), CallBackArguments(4), CallBackArguments(5), CallBackArguments(6), CallBackArguments(7), CallBackArguments(8), CallBackArguments(9), CallBackArguments(10))
|
|
End Case
|
|
End Case
|
|
|
|
return
|
|
|
|
|
|
|