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