96 lines
3.7 KiB
OpenEdge ABL
96 lines
3.7 KiB
OpenEdge ABL
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
|
|
|
|
|