开发环境：K/3 Wise 13.0、K/3 Bos开发平台、Visual Basic 6.0
===============================================
目录
一、二次开发插件编程 二、代码演示 三、配置插件 四、测试插件
五、插件配置后未生效 六、附SQLHelper
七、K3自带连接数据库的写法
八、源码下载
===============================================
一、二次开发插件编程
打开Visual Basic 6.0，新建工程ActiveX DLL:
命名为FirstPlugin.class:
引用类库如下：
已安装K/3 Wise，在VB 6.0菜单栏上会多出一个金蝶开发插件：
打开金蝶开发向导，创建工业单据客户端插件（工业单据俗称“老单”）：
点击“确定”，选择类“FirstPlugin”:
点击“下一步”，这里我们自定义一个菜单项“插件工具”：
点击“下一步”，选择事件“UserMenuClick”：
完成向导。
二、代码演示
代码编写如下：
'配置路径：供应链-外购入库单
'函数功能：插件工具--根据“长、宽、厚”自动计算批号
'定义插件对象接口. 必须具有的声明, 以此来获得事件
Private WithEvents m_BillTransfer As K3BillTransfer.Bill
Dim F55 As Long, F55Text As String '长
Dim F56 As Long, F56Text As String '宽
Dim F57 As Long, F57Text As String '高
Dim FDate As Long, FDateText As String '日期
Dim FBatchNo As String '批号
Dim FItemID As Long, FNumber As String '物料编码
Dim FBatchManager As Boolean '是否采用业务批号管理
Dim str As String
Dim RowCount As Integer
Public Sub Show(ByVal oBillTransfer As Object)
'接口实现
'注意: 此方法必须存在, 请勿修改
Set m_BillTransfer = oBillTransfer
End Sub
Private Sub Class_Terminate()
'释放接口对象
'注意: 此方法必须存在, 请勿修改
Set m_BillTransfer = Nothing
End Sub
Private Sub m_BillTransfer_BillInitialize()
'*************** 开始设置菜单 ***************
m_BillTransfer.AddUserMenuItem "自动批号", "插件工具"
'*************** 结束设置菜单 ***************
'TODO: 请在此处添加代码响应事件 BillInitialize, 下面True是表体，False是表头
F55 = GetCtlIndexByFld("FEntrySelfA0155", True)
F56 = GetCtlIndexByFld("FEntrySelfA0156", True)
F57 = GetCtlIndexByFld("FEntrySelfA0157", True)
FBatchNo = GetCtlIndexByFld("FBatchNo", True)
FDate = GetCtlIndexByFld("FDate", False)
FItemID = GetCtlIndexByFld("FItemID", True)
End Sub
Private Sub m_BillTransfer_UserMenuClick(ByVal Index As Long, ByVal Caption As String)
'TODO: 请在此处添加代码响应事件 UserMenuClick
Select Case Caption
Case "自动批号"
RowCount = m_BillTransfer.BillForm.get_MaxEntry
'此处添加处理 批号生成 菜单对象的 Click 事件
With m_BillTransfer
For i = 1 To RowCount
If .GetGridText(i, FItemID) = "" Then
Exit For
End If
'从物料表检测 是否采用业务批次管理
Dim strSQL As String '用于执行SQL
Dim rs As ADODB.Recordset
FNumber = ""
FNumber = .GetGridText(i, FItemID)
strSQL = ""
strSQL = "SELECT FBatchManager FROM t_ICItem WHERE FNumber='" & FNumber & "'"
Set rs = SQLHelper.ExecuteSQL(strSQL, "")
If rs.EOF = False Then
FBatchManager = rs.Fields("FBatchManager")
End If
Set rs = Nothing
F55Text = .GetGridText(i, F55)
F56Text = .GetGridText(i, F56)
F57Text = .GetGridText(i, F57)
If F55Text = "" Then F55Text = "0"
If F56Text = "" Then F56Text = "0"
If F57Text = "" Then F57Text = "0"
FDateText = Replace(.GetHeadText(FDate), "-", "")
If (FBatchManager = True) Then
.SetGridText i, FBatchNo, F55Text & "-" & F56Text & "-" & F57Text & "-" & FDateText
End If
Next
End With
Case Else
End Select
End Sub
'**********************************
'返回单据字段顺序(isEntry True是表体)
'**********************************
Public Function GetCtlIndexByFld(ByVal fldName As String, Optional ByVal isEntry As Boolean = False) As Long
Dim ctlIdx As Long
Dim i As Integer
Dim isFind As Boolean
Dim vValue As Variant
fldName = UCase(fldName)
isFind = False
With m_BillTransfer
If isEntry Then
For i = LBound(.EntryCtl) To UBound(.EntryCtl)
If UCase(.EntryCtl(i).FieldName) = fldName Then
ctlIdx = .EntryCtl(i).FCtlOrder
isFind = True
Exit For
End If
Next i
Else
For i = LBound(.HeadCtl) To UBound(.HeadCtl)
If UCase(.HeadCtl(i).FieldName) = fldName Then
ctlIdx = .HeadCtl(i).FCtlIndex
isFind = True
Exit For
End If
Next i
End If
End With
If isFind = True Then
GetCtlIndexByFld = ctlIdx
Else
GetCtlIndexByFld = 0
End If
End Function
三、配置插件
在Visual Basic 6.0生成DLL：
启动K/3 Wise BOS开发平台，打开外购入库单，并进行插件配置：
“插件配置管理”，配置客户端插件：
点击“浏览”，找到插件并勾选：
点击“确定”，并保存外购入库单。
四、测试插件
启动K/3 Wise，打开“供应链-仓存管理-外购入库单-新增”：
至此，插件开发和配置完成！
五、插件配置后未生效
1.在插件配置管理提示“没有找到文件，或文件没有正确注册”
解决方法：插件dll名称命名要和工程名称一致。
比如工程名称“aaaa”，其中有一个类“bbb”，dll命名为“aaa”，
配置插件后，显示完整名称“aaa.bbb”，提示aaaa“没有找到文件，或文件没有正确注册”。
修改dll名称“aaa”为“aaaa”，重新配置插件，即可修复问题。
六、附SqlHelper源码：
Attribute VB_Name = "SQLHelper"
'Public Function Conn() As ADODB.Connection
' Set Conn = New ADODB.Connection
' Conn.Open = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=AIS20140411200431;Data Source=."
'End Function
Public Function ConnectString() As String
'ConnectString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=AIS20140411200431;Data Source=."
ConnectString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;password=Ab123456;Initial Catalog=AIS20140508100349;Data Source=KDSERVER"
End Function
'传递参数SQL传递查询语句，MsgString传递查询信息。自身以一个数据集对象的形式返回
Public Function ExecuteSQL(ByVal SQL As String, MsgString As String) As ADODB.Recordset
Dim Cnn As ADODB.Connection '定义连接
Dim Rst As ADODB.Recordset
Dim sTokens() As String '定义字符串
On Error GoTo ExecuteSQL_Error '异常处理
sTokens = Split(SQL) '用Split函数产生一个包含各个子串的数组
Set Cnn = New ADODB.Connection '创建连接
Cnn.Open ConnectString
If InStr("INSERT,DELETE,UPDATE", UCase$(sTokens(0))) Then '判断字符串中是否含有指定内容
Cnn.Execute SQL '执行查询语句
MsgString = sTokens(0) & "query successful" '返回查询信息
Else
Set Rst = New ADODB.Recordset '闯将数据集对象
Rst.Open Trim$(SQL), Cnn, adOpenKeyset, adLockOptimistic '返回查询结果
Set ExecuteSQL = Rst '返回记录集对象
MsgString = "查询到" & Rst.RecordCount & " 条记录"
End If
ExecuteSQL_Exit:
Set Rst = Nothing '清空数据集对象
Set Cnn = Nothing '中断连接
Exit Function
ExecuteSQL_Error: '判断错误类型
MsgString = "查询错误:" & Err.Description
MsgBox MsgString
Resume ExecuteSQL_Exit
End Function
七、K3自带连接数据库的写法
'定义插件对象接口. 必须具有的声明, 以此来获得事件
Private WithEvents m_BillTransfer As k3BillTransfer.Bill
Private conn As New ADODB.Connection
Dim FEntrySelfS0170 As Long '库存量
Dim FItemID As Long '物料ID
Dim FItemIDText As String '物料ID取值：结果取到物料代码
Public Sub Show(ByVal oBillTransfer As Object)
'接口实现
'注意: 此方法必须存在, 请勿修改
Set m_BillTransfer = oBillTransfer
conn.ConnectionString = m_BillTransfer.Cnnstring
conn.Open
End Sub
Private Sub Class_Terminate()
'释放接口对象
'注意: 此方法必须存在, 请勿修改
Set m_BillTransfer = Nothing
End Sub
Private Sub m_BillTransfer_BillInitialize()
'TODO: 请在此处添加代码响应事件 BillInitialize
FEntrySelfS0170 = GetCtlIndexByFld("FEntrySelfS0170", True)
FItemID = GetCtlIndexByFld("FItemID", True)
End Sub
Private Sub m_BillTransfer_GridChange(ByVal Col As Long, ByVal Row As Long, ByVal Value As Variant, ByVal bNewBill As Boolean, Cancel As Boolean)
'TODO: 请在此处添加代码响应事件 GridChange
Dim strSQL As String '用于执行SQL
Dim rs As New ADODB.Recordset
rs.CursorLocation = adUseClient
Dim strXSZDL As Long '销售在订量临时赋值变量
With m_BillTransfer
If Col = FItemID Then
FItemIDText = .GetGridText(Row, FItemID) '取到物料代码FNumber
strSQL = ""
strSQL = "select t1.fitemid,t2.FQty " & _
"from t_ICItem t1 " & _
"left join ICInventory t2 on t1.FItemID =t2.FItemID " & _
"where t1.FNumber='" & FItemIDText & "' "
If rs.State = adStateOpen Then
rs.Close
End If
rs.Open strSQL, conn, adOpenStatic, adLockBatchOptimistic
If rs.RecordCount > 0 Then
strXSZDL = rs("FQty").Value
.SetGridText Row, FEntrySelfS0170, strXSZDL
End If
End If
End With
Set rs = Nothing
Exit Sub
End Sub
'**********************************
'返回单据字段顺序(isEntry True是表体)
'**********************************
Public Function GetCtlIndexByFld(ByVal fldName As String, Optional ByVal isEntry As Boolean = False) As Long
Dim ctlIdx As Long
Dim i As Integer
Dim isFind As Boolean
Dim vValue As Variant
fldName = UCase(fldName)
isFind = False
With m_BillTransfer
If isEntry Then
For i = LBound(.EntryCtl) To UBound(.EntryCtl)
If UCase(.EntryCtl(i).FieldName) = fldName Then
ctlIdx = .EntryCtl(i).FCtlOrder
isFind = True
Exit For
End If
Next i
Else
For i = LBound(.HeadCtl) To UBound(.HeadCtl)
If UCase(.HeadCtl(i).FieldName) = fldName Then
ctlIdx = .HeadCtl(i).FCtlIndex
isFind = True
Exit For
End If
Next i
End If
End With
If isFind = True Then
GetCtlIndexByFld = ctlIdx
Else
GetCtlIndexByFld = 0
End If
End Function