RE:Ejecutar Programa del As/400 desde Visual Basic
En este programa se muestra como utilizar los objetos ActiveX para llamar a un programa del 400, pasarle parametros y que a su vez nos devuelva valores en los parametros de salida.
En este programa no realizamos un connect con el 400 ya que el mandato call lo realiza automaticamente, cuando el mandato call es ejecutado aparece en el wrkactjob del 400 como usuario QUSER y como trabajo QZSCSRVS.
Esta es la linea que aparece en el 400 en el wrkactjob:
QZSCSRVS QUSER BCI 0,0 TIMW
Si el programa llamado realiza un error y en la CL o en el RPG no esta contemplado monitorizar los mensajes de error se parara el programa de Visual Basic y en el 400 el proceso en el wrkactjob aparecera en estado de MSGW.
Codigo VB:
Option Explicit
'Este objeto contiene información relacionada con la conexión en un sistema AS/400.
Dim as400 As New cwbx.AS400System
'Conversiones de página de códigos entre series PC y matrices de bytes
Dim stringCvtr As New cwbx.StringConverter
'Objeto para llamar a cualquier API del sistema o programa de usuario en el AS/400.
Dim ProGraMa As New cwbx.Program
'Parametros a pasar al programa
Dim parms As New cwbx.ProgramParameters
'Objeto para la conversión entre series numéricas y matrices de bytes
'(necesarias en los métodos que pasan datos desde y hacia el AS/400). Los datos de la matriz
'de bytes están en formato decimal empaquetado AS/400.
Dim pckCvtr As New cwbx.PackedConverter
Dim CON_RegLog As New CON_Log 'Registro de errores
Private Sub Form_Load()
as400.Define "SYSTEMA" 'sistema contra el que atacamos
as400.UserID = "USUARIO" 'usuario
as400.Password = "PWRD" 'contraseña
as400.PromptMode = cwbcoPromptNever
as400.Signon 'firmamos
'as400.Connect cwbcoServiceDataQueues
End Sub
Private Sub Command2_Click()
On Error GoTo trat_err
Set ProGraMa.System = as400 'definimos el sistema del objeto programa al cual vamos a llamar
ProGraMa.LibraryName = "V0TRSER1" 'definimos la biblioteca donde se encuentra el programa
ProGraMa.ProgramName = "SUMACC" 'definimos el nombre de programa RPG o CL, en este caso es una CL
parms.Clear 'limpiamos los parametros
'***** Añadimos los parametros a la matriz parms *****
'parms.Append (añadir parametro) "RTPARM" (nombre del parametro), cwbrcInput (tipo de parametro), 1 (longitud)
parms.Append "RTPARM", cwbrcInput, 1
parms.Append "NUM1", cwbrcInput
parms.Append "NUM2", cwbrcInput
parms.Append "TOTAL", cwbrcInout
'***** Asignamos valores *****
'para asignar valores hay que transformar los valores que queremos asignar a tipo Bytes para el 400
parms("RTPARM") = stringCvtr.ToBytes("I")
'definicion de variables empaquetadas
pckCvtr.Digits = 15
pckCvtr.DecimalPosition = 5
'conversion de valores de packet a bytes
parms("NUM1") = pckCvtr.ToBytes("0000000007,00000")
parms("NUM2") = pckCvtr.ToBytes("6")
parms("TOTAL") = pckCvtr.ToBytes("0")
'llamada al programa pasandole los parametros
ProGraMa.Call parms
'transformamos el valor de bytes devuelto por el 400 a empaquetado y lo visulizamos
MsgBox pckCvtr.FromBytes(parms("TOTAL").Value)
salir:
Exit Sub
trat_err:
Dim msgerr As String
Dim index As Integer
Select Case Err.Number 'CONTROL DE ERRORES A NIVEL DE OBJETOS DE ACTIVEX/400
Case 0 'SIN ERROR
CON_RegLog.Log.Registrar "Llamada", "click", _
0, "llamada ok!!"
Case Is = -2147467259 'ERROR DE AUTOMATIZACION
Select Case ProGraMa.Errors.ReturnCode 'TRATAMIENTO A NIVEL DE COLA DE 400
Case Else
msgerr = ""
For index = 1 To ProGraMa.Errors.Count
CON_RegLog.Log.Registrar "Llamada", "click", ProGraMa.Errors.ReturnCode, "A NIVEL DE OBJETO Call: " & ProGraMa.Errors.Item(index).Text
msgerr = msgerr & ProGraMa.Errors.Item(index).Text & " ### " & ProGraMa.Errors.ReturnCode
Next index
End Select
End Select
'MsgBox Err.Number & " " & Err.Description
Resume salir
End Sub
Private Sub Form_Unload(Cancel As Integer)
as400.Disconnect cwbcoServiceAll 'desconectamos cualquier servicio que hayamos abierto en el 400
End Sub