4、K3 WISE 開發插件《工業單據老單插件開發新手指導》

開發環境：K/3 Wise 13.0、K/3 Bos開發平臺、Visual Basic 6.0

===============================================

目錄

1、二次開發插件編程
2、代碼演示
3、配置插件
4、測試插件

5、插件配置後未生效
6、附SQLHelper

7、K3自帶鏈接數據庫的寫法

8、源碼下載

===============================================

1、二次開發插件編程

　　打開Visual Basic 6.0，新建工程ActiveX DLL:

　　

　　命名爲FirstPlugin.class:

　　

　　引用類庫以下：

　　

　　已安裝K/3 Wise，在VB 6.0菜單欄上會多出一個金蝶開發插件：

　　

　　打開金蝶開發嚮導，建立工業單據客戶端插件（工業單據俗稱「老單」）：

　　

　　點擊「肯定」，選擇類「FirstPlugin」:

　　

　　點擊「下一步」，這裏咱們自定義一個菜單項「插件工具」：

　　

　　點擊「下一步」，選擇事件「UserMenuClick」：

　　

　　完成嚮導。

2、代碼演示

　　代碼編寫以下：

'配置路徑：供應鏈-外購入庫單
'函數功能：插件工具--根據「長、寬、厚」自動計算批號
'定義插件對象接口. 必須具備的聲明, 以此來得到事件
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

3、配置插件

　　在Visual Basic 6.0生成DLL：

　　

　　啓動K/3 Wise BOS開發平臺，打開外購入庫單，並進行插件配置：

　　

　　點擊「插件配置管理」，配置客戶端插件：

　　

　　點擊「瀏覽」，找到插件並勾選：

　　

　　點擊「肯定」，並保存外購入庫單。

4、測試插件

　　啓動K/3 Wise，打開「供應鏈-倉存管理-外購入庫單-新增」：

　　　　

　　至此，插件開發和配置完成！

5、插件配置後未生效

      1.在插件配置管理提示「沒有找到文件，或文件沒有正確註冊」

         解決方法：插件dll名稱命名要和工程名稱一致。

                       好比工程名稱「aaaa」，其中有一個類「bbb」，dll命名爲「aaa」，

                       配置插件後，顯示完整名稱「aaa.bbb」，提示aaaa「沒有找到文件，或文件沒有正確註冊」。

                       修改dll名稱「aaa」爲「aaaa」，從新配置插件，便可修復問題。

 6、附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

 7、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

 

8、源碼下載

源碼下載連接