VB Scripts accessing WX- Common buffer 1

[gbell]

I have a script I'm working on to amend Vendor details and because of SOx I have a need to log the transactions and include the sign-on User Id. In RDL's you can reference the WX- data items from the common area, is this possible with VB scripts?

TIA

 

[Drw]

Use the GetParameter method of the MIMSXServer Class (mimsx.dll) to retrieve the constant MIMSX_PARAM_MIMS_USER from the MIMSX_PARAMATER_CONSTANT module.
e.g.
MsgBox MIMSXServer.GetParameter(MIMSX_PARAM_MIMS_USER)

You can use the syntax:
MsgBox MIMSXServer. GetParameter("mimsuser")

Drew

 

[gbell]

Thanks Drew,

I'm new to scripting and VB, I grew up with COBOL. Could you please post with all the VB code needed to retrieve the User Id. I tried inserting MsgBox MIMSXServer.GetParameter("mimsuser") and get the error:
Microsoft VBScript runtime error Object required: 'MIMSXServer' Line 32. Column 8

Many thanks

 

[gbell]

I should have added that it is not a Connector script. It's a script that interacts with the screens, like the old Mint scripts.

 

[PhantomPhil]

I did some experimentation with the Ellipse VBS scripting (msq000 scripting) (which appears to only be available for the MSO screens) and was trying to determine whether it could call the MSK ellipse objects (like connector does), and created an example - see code below.

However, for what you are trying to achieve, perhaps have a look at the Ellipse Audit facility. eg. turn auditing on for MSF200/MSF203. The audit records in MSF034 automatically capture the user id.
There was a recent thread on Audit thread725-1310001 - Audit Ellipse's table

Scripting example of code:

DESC = "MSM877A Who Am I"

' This is a sample script to demonstrate how to use Connector
' from within a script.
' Using Connector (rather than using MSQ000 scripting) will
' allow the user to stay on this screen, but call the
' Ellipse Objects (MSKs), or even other Online programs (MSOs).


Dim oMimsx
Dim bMimsxConnected
Dim sEmployeeId
Dim sEmployeeName
Dim sDistrictId
Dim sDistrictName
Dim sPositionId
Dim sPositionName
Dim sDisplayString

Sub Main()

  Call MIMS_Connect()
  Call DisplaySomeStuff()
  Call MIMS_Disconnect()

End Sub



Sub MIMS_Connect()
  
  If bMimsxConnected Then                  'Check if we are already connected.
     'MsgBox "Already Connected."
     oMimsx.Disconnect
     bMimsxConnected = False
     Set oMimsx = Nothing
  End If
  
  Set oMimsx = CreateObject("MIMSX.MIMSXServer")      'Create the MIMSXObject
  If Not oMimsx.Initialise(0, msq000.hMims) Then      'Initialise the MIMSX object.
     MsgBox "Unable to initialise the Ellipse Server"
     bMimsxConnected = False
     Exit Sub
  End If
  
  If Not oMimsx.Connect(True) Then                    'Silent login
     MsgBox "Unable to Connect to the Ellipse Server"
     bMimsxConnected = False
     Set oMimsx = Nothing
     Exit Sub
  End If

  bMimsxConnected = True
  
End Sub


Sub MIMS_Disconnect()
   
  If bMimsxConnected Then                  ' Disconnect from the Server
    oMimsx.Disconnect
    bMimsxConnected = False
    Set oMimsx = Nothing
  End If
  
End Sub


Sub DisplaySomeStuff()

  sDistrictId = Trim(oMimsx.GetParameter("mimsdistrict"))
  sPositionId = Trim(oMimsx.GetParameter("mimsposition"))

  bResult = MIMS_Get_Context()  
  If sEmployeeId <> "" Then
    sEmployeeName = MIMS_Get_EmployeeName(sEmployeeId)   
  End If
  If sPositionId <> "" Then
    sPositionName = MIMS_Get_PositionName(sPositionId)   
  End If

  sDisplayString = _
    " Current Credentials: " & vbCR & vbCR & _
    " Host: """ & Trim(oMimsx.GetParameter("host")) & """" & vbCR & _
    " Port: """ & Trim(oMimsx.GetParameter("port")) & """" & vbCR & _
    " User: """ & Trim(oMimsx.GetParameter("mimsuser")) & """" & vbCR & _
    " Employee: """ & Trim(sEmployeeId) & " - " & _
                      Trim(sEmployeeName) & """" & vbCR & _
    " Position: """ & Trim(sPositionId) & " - " & _
                      Trim(sPositionName) & """" & vbCR & _
    " District: """ & Trim(sDistrictId) & " - " & _
                      Trim(sDistrictName) & """" & vbCR 

  sDisplayString = sDisplayString & vbCR & _
    " Current Display: " & vbCR & vbCR & _
    " Position: """ & Trim(msq000.Field("POSITION_ID1I")) & " - " & _
                      Trim(msq000.Field("POS_TITLE1I")) & """" & vbCR & _
    " District: """ & Trim(msq000.Field("DISTRICT1I")) & " - " & _
                      Trim(msq000.Field("DISTNAME1I")) & """"

  MsgBox sDisplayString, vbOkOnly + vbInformation, DESC

End Sub



Function MIMS_Get_Context()

  On Error Resume Next

  Set Block = oMimsx.Blocks.New(1)
  Block.Requests.New (1)
  Block.Requests(1).AddFieldNameValue _
    "_Service", "CONTEXT.FetchContext"
  Block.Requests(1).AddFieldNameValue _
    "_ReplyList", "EmployeeId,DistrictName"
  Block.Requests(1).Instances.New (1)
  Block.Requests(1).Instances(1).AddFieldNameValue _
    "District", sDistrictId
  
  Set Reply = Block.Send

  If Not (Reply Is Nothing) Then
    sEmployeeId = _
      Trim(Reply.Requests(1).Instances(1).Fields("EmployeeId").Value)
    sDistrictName = _
      Trim(Reply.Requests(1).Instances(1).Fields("DistrictName").Value)
    MIMS_Get_Context = True
  Else
    sEmployeeId = ""
    sDistrictName = ""
    MIMS_Get_Context = False
  End If
  
  oMimsx.Blocks.Remove (1)
  
End Function


Function MIMS_Get_EmployeeName(strEmployeeId)

  On Error Resume Next

  Set Block = oMimsx.Blocks.New(1)
  Block.Requests.New (1)
  Block.Requests(1).AddFieldNameValue _
    "_Service", "EMPLOYEE.Fetch"
  Block.Requests(1).AddFieldNameValue _
    "_ReplyList", "EmployeeFormattedName"
  Block.Requests(1).Instances.New (1)
  Block.Requests(1).Instances(1).AddFieldNameValue _
    "Employee", strEmployeeId
  
  Set Reply = Block.Send

  If Not (Reply Is Nothing) Then
    MIMS_Get_EmployeeName = _
      Trim(Reply.Requests(1).Instances(1).Fields("EmployeeFormattedName").Value)
  Else
    MIMS_Get_EmployeeName = ""
  End If
  
  oMimsx.Blocks.Remove (1)

End Function


Function MIMS_Get_PositionName(strPositionId)

  On Error Resume Next

  Set Block = oMimsx.Blocks.New(1)
  Block.Requests.New (1)
  Block.Requests(1).AddFieldNameValue _
    "_Service", "POSITION.Fetch"
  Block.Requests(1).AddFieldNameValue _
    "_ReplyList", "PositionTitle"
  Block.Requests(1).Instances.New (1)
  Block.Requests(1).Instances(1).AddFieldNameValue _
    "Position", strPositionId

  Set Reply = Block.Send

  If Not (Reply Is Nothing) Then
    MIMS_Get_PositionName = _
      Trim(Reply.Requests(1).Instances(1).Fields("PositionTitle").Value)
  Else
    MIMS_Get_PositionName = ""
  End If

  oMimsx.Blocks.Remove (1)
  
End Function

 

[gbell]

Thanks for the post. A good point about auditing, I'd forgotten about that. We have auditing turned on but as far as I know no-one looks at it.

Many thanks.