Skip to main content
Hi.

I have this coding who do not work anymore on 10.1 BlueZone new release from current 7.1.

It says can't ActiveX component can't create object on line 3

Function getAuthenticator
Dim objAuthenticator as Object
SET objAuthenticator = createObject("SSOCom.SSOHelper")
SET getAuthenticator = objAuthenticator

End Function


---------------------------
There is the full Script
----------------------------
Sub Main
Dim Sessions As Object
Dim System As Object
Set System = CreateObject("BlueZone.System") ' Gets the system object 'modified by BlueZone Script Converter 6/4/2018 4:05:45 PM
Set Sessions = System.Sessions

if System.ActiveSession Is Nothing then
MsgBox "You must have an open session to run the macro."
EXIT SUB
end if

'create the necessary Session and Authenticator objects
Dim sess as Object, objAuthenticator as Object

Set sess = System.ActiveSession

SET objAuthenticator = getAuthenticator()
IF objAuthenticator IS NOTHING THEN
handleError(2)
EXIT SUB
END IF

sess.Screen.WaitForString "Entry Validation", 1, 33

sess.Screen.SendKeys "<Pf3>"

sess.Screen.WaitHostQuiet(100)

sess.Screen.MoveTo 1, 2
sess.Screen.PutString "PESN"

sess.Screen.SendKeys "<Enter>"

sess.Screen.WaitForString "STATUS:", 1, 2

IF not performAuthentication ( System, sess, objAuthenticator) THEN
handleError (3)
end if

End Sub

Function getAuthenticator
Dim objAuthenticator as Object
SET objAuthenticator = createObject("SSOCom.SSOHelper")
SET getAuthenticator = objAuthenticator

End Function

FUNCTION performAuthentication(objSys as Object, objSession as Object, objAuthenticator as Object)
Dim objScreen as Object
Set objScreen = objSession.Screen
'call objScreen.WaitHostQuiet(100)

Dim tok, pagetok, subtok, fldbuffer
Dim fldvalue As String

'lire valeur dans l'écran
fldbuffer=60
fldvalue = Trim(objSession.Screen.GetString(1,18,fldbuffer))
'fldvalue = "RestrictedKrbHost/ldapwp"
'MsgBox "fldvalue is <" &fldvalue & ">"

tok = objAuthenticator.GenerateInitialContext (fldvalue)

Dim i,j,start, lineno, length, linesperpage, pageCount

length = 78
linesperpage = 20
pageCount = Int(Len(tok)/length/linesperpage) + 1

'MsgBox "Len(tok):" & Len(tok) & " pageCount:" & pageCount

'MsgBox "tok:" & tok

'if (0=1) then

for j=0 to pageCount-1

pagestart = 1 + (j * linesperpage * length)
pagelength = linesperpage * length
pageleft = (pageCount - j - 1)
pagetok = Mid (tok, pagestart , pagelength )

objScreen.MoveTo 2, 8
objScreen.PutString pageleft

'MsgBox "Current Page: " & (j + 1) & " Page(s) left: " & pageleft

for i=0 to Int(Len(pagetok)/length)
start = 1 + i * length
lineno = 3 + i
subtok = Mid (pagetok, start, length)
objScreen.MoveTo lineno, 2
'MsgBox lineno & "|" & start & "|" & subtok
objScreen.PutString subtok
next

objScreen.SendKeys "<Enter>"

' if (pageleft>0) THEN
'
'
' 'retrieve a new instance of a Waits collection object
' Dim waits as Object
' Set waits = objSys.Waits
'
' 'declare several object variables
' Dim w1 as Object
'
' 'Call methods to retrieve wait-type objects.
'
' 'Note that it is crucial to use the "Set obj = " syntax
' 'when making these calls otherwise wait-type objects
' 'will not be returned, and the methods will wait synchronously,
' 'in the order in which they were called
' Set w1 = objSession.Screen.WaitForString(" ", 2, 8)
'
' 'add the wait-type objects to the Waits collection object
' id1 = waits.Add(w1)
'
' 'Wait for up to a minute to see which event occurs first
' retval = waits.Wait(100)
'
' 'Figure out which wait-type object fired its event,
' 'causing the Wait method to return
'
' Select Case retval
' case id1
' 'MsgBox "String we waited for was found!"
' case 0
' 'MsgBox "Timed-out while waiting for an event!"
' End Select
'
' END IF


next


' END IF


performAuthentication = true
END FUNCTION

SUB handleError(errno)
MsgBox "Error # " & CStr(errno)
END SUB

------------------------------
Richard Guimond
Team Lead
CGI Group Inc
Montreal QC CA
------------------------------
Hi.

I have this coding who do not work anymore on 10.1 BlueZone new release from current 7.1.

It says can't ActiveX component can't create object on line 3

Function getAuthenticator
Dim objAuthenticator as Object
SET objAuthenticator = createObject("SSOCom.SSOHelper")
SET getAuthenticator = objAuthenticator

End Function


---------------------------
There is the full Script
----------------------------
Sub Main
Dim Sessions As Object
Dim System As Object
Set System = CreateObject("BlueZone.System") ' Gets the system object 'modified by BlueZone Script Converter 6/4/2018 4:05:45 PM
Set Sessions = System.Sessions

if System.ActiveSession Is Nothing then
MsgBox "You must have an open session to run the macro."
EXIT SUB
end if

'create the necessary Session and Authenticator objects
Dim sess as Object, objAuthenticator as Object

Set sess = System.ActiveSession

SET objAuthenticator = getAuthenticator()
IF objAuthenticator IS NOTHING THEN
handleError(2)
EXIT SUB
END IF

sess.Screen.WaitForString "Entry Validation", 1, 33

sess.Screen.SendKeys "<Pf3>"

sess.Screen.WaitHostQuiet(100)

sess.Screen.MoveTo 1, 2
sess.Screen.PutString "PESN"

sess.Screen.SendKeys "<Enter>"

sess.Screen.WaitForString "STATUS:", 1, 2

IF not performAuthentication ( System, sess, objAuthenticator) THEN
handleError (3)
end if

End Sub

Function getAuthenticator
Dim objAuthenticator as Object
SET objAuthenticator = createObject("SSOCom.SSOHelper")
SET getAuthenticator = objAuthenticator

End Function

FUNCTION performAuthentication(objSys as Object, objSession as Object, objAuthenticator as Object)
Dim objScreen as Object
Set objScreen = objSession.Screen
'call objScreen.WaitHostQuiet(100)

Dim tok, pagetok, subtok, fldbuffer
Dim fldvalue As String

'lire valeur dans l'écran
fldbuffer=60
fldvalue = Trim(objSession.Screen.GetString(1,18,fldbuffer))
'fldvalue = "RestrictedKrbHost/ldapwp"
'MsgBox "fldvalue is <" &fldvalue & ">"

tok = objAuthenticator.GenerateInitialContext (fldvalue)

Dim i,j,start, lineno, length, linesperpage, pageCount

length = 78
linesperpage = 20
pageCount = Int(Len(tok)/length/linesperpage) + 1

'MsgBox "Len(tok):" & Len(tok) & " pageCount:" & pageCount

'MsgBox "tok:" & tok

'if (0=1) then

for j=0 to pageCount-1

pagestart = 1 + (j * linesperpage * length)
pagelength = linesperpage * length
pageleft = (pageCount - j - 1)
pagetok = Mid (tok, pagestart , pagelength )

objScreen.MoveTo 2, 8
objScreen.PutString pageleft

'MsgBox "Current Page: " & (j + 1) & " Page(s) left: " & pageleft

for i=0 to Int(Len(pagetok)/length)
start = 1 + i * length
lineno = 3 + i
subtok = Mid (pagetok, start, length)
objScreen.MoveTo lineno, 2
'MsgBox lineno & "|" & start & "|" & subtok
objScreen.PutString subtok
next

objScreen.SendKeys "<Enter>"

' if (pageleft>0) THEN
'
'
' 'retrieve a new instance of a Waits collection object
' Dim waits as Object
' Set waits = objSys.Waits
'
' 'declare several object variables
' Dim w1 as Object
'
' 'Call methods to retrieve wait-type objects.
'
' 'Note that it is crucial to use the "Set obj = " syntax
' 'when making these calls otherwise wait-type objects
' 'will not be returned, and the methods will wait synchronously,
' 'in the order in which they were called
' Set w1 = objSession.Screen.WaitForString(" ", 2, 8)
'
' 'add the wait-type objects to the Waits collection object
' id1 = waits.Add(w1)
'
' 'Wait for up to a minute to see which event occurs first
' retval = waits.Wait(100)
'
' 'Figure out which wait-type object fired its event,
' 'causing the Wait method to return
'
' Select Case retval
' case id1
' 'MsgBox "String we waited for was found!"
' case 0
' 'MsgBox "Timed-out while waiting for an event!"
' End Select
'
' END IF


next


' END IF


performAuthentication = true
END FUNCTION

SUB handleError(errno)
MsgBox "Error # " & CStr(errno)
END SUB

------------------------------
Richard Guimond
Team Lead
CGI Group Inc
Montreal QC CA
------------------------------
I've found that I've installed X(64) instead of X(86).

The script is made for 32 bits

------------------------------
Richard Guimond
Team Lead
CGI Group Inc
Montreal QC CA
------------------------------