FrymasterVB/ClearBom.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClearBOM"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'**********************************************************************
' IBM grants you a nonexclusive license to use this as an example
' from which you can generate similar function tailored to your own
' specific needs. This sample is  provided in the form of source
' material which you may change and use.
' If you change the source, it is recommended that you first copy
' the source to a different directory.  This will ensure that your
' changes are preserved when the tool kit contents are changed by
' IBM.
'
'                             DISCLAIMER
'                           -------------
'
' This sample code is provided by IBM for illustrative purposes
' only. These examples have not been thoroughly tested under all
' conditions. IBM, therefore, cannot guarantee or imply reliability,
' serviceability, or function of these programs.  All programs
' contained herein are provided to you "AS IS" without any
' warranties of any kind.  ALL WARRANTIES, INCLUDING BUT NOT
' LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
' FOR A PARTICULAR PURPOSE, ARE EXPRESSLY DISCLAIMED.
'
' Your license to this sample code provides you no right or licenses
' to any IBM patents.  IBM has no obligation to defend or indemnify
' against any claim of infringement, including but not limited to:
' patents,  copyright, trade secret, or intellectual property rights
' of any kind.
'
'                             COPYRIGHT
'                            ---------
'            (C) Copyright IBM CORP. 1997, 1998
'            All rights reserved.
'            US Government Users Restricted Rights -
'            Use, duplication or disclosure restricted
'            by GSA ADP Schedule Contract with IBM Corp.
'            Licensed Material - Property of IBM
'*********************************************************************
Public cnRCHAS002 As New ADODB.Connection
Public cm_ACTIVEXSDK_CUSTINS As New ADODB.Command
Public Sub Connect()
Dim systemName As String
   systemName = "qhal"
   If systemName = "" Then
     MsgBox ("No system name entered.  Ending program.")
     End
   End If
   cnRCHAS002.Open "Provider=IBMDA400;Data Source=" & systemName & ";", "EGNETLINK", "DRAWINGS"
End Sub
Public Sub Prepare()
   Set cm_ACTIVEXSDK_CUSTINS.ActiveConnection = cnRCHAS002
   cm_ACTIVEXSDK_CUSTINS.CommandText = "{{call /QSYS.LIB/OBJLIB.LIB/EGR465.PGM(?,?,?)}}"
   cm_ACTIVEXSDK_CUSTINS.Prepared = True
   cm_ACTIVEXSDK_CUSTINS.Parameters.Append cm_ACTIVEXSDK_CUSTINS.CreateParameter("PN", adChar, adParamInputOutput, 15)
   cm_ACTIVEXSDK_CUSTINS.Parameters.Append cm_ACTIVEXSDK_CUSTINS.CreateParameter("RV", adChar, adParamInputOutput, 1)
   cm_ACTIVEXSDK_CUSTINS.Parameters.Append cm_ACTIVEXSDK_CUSTINS.CreateParameter("RC", adChar, adParamInputOutput, 2)
End Sub
Public Sub OpenLinks()
Dim Rcds As Variant
Dim Parms As Variant
   Const DBPROPVAL_UP_CHANGE = 1
   Const DBPROPVAL_UP_DELETE = 2
   Const DBPROPVAL_UP_INSERT = 4
End Sub
Public Sub Execute()
Dim Rcds As Variant
Dim Parms As Variant
   Parms = Array("", "", "")
   cm_ACTIVEXSDK_CUSTINS.Execute Rcds, Parms, adCmdText
   cnRCHAS002.Execute "{{CHGCURLIB CURLIB(ACTIVEXSDK)}}", Rcds, adCmdText
End Sub

Private Sub Class_Initialize()
   Call Connect
   Call Prepare
   Call OpenLinks
End Sub
Private Sub Class_Terminate()
   Set cm_ACTIVEXSDK_CUSTINS = Nothing
   If Not cnRCHAS002 Is Nothing Then cnRCHAS002.Close
End Sub