金蝶K3工业老单中间层开发示例

Dim rsBill As ADODB.Recordset 
Dim lBillInterID As Long '当前单据内码 
Dim lRtnBillInterID As Long 
Dim strRtnMsg As String 
Dim lCheckID As Long 
Dim StrSql As String 
Dim strsql2 As String 
Dim strsql3 As String 
Dim sCurrZhangTaoTag As String 
Dim sCurrSupply As String 
Dim bIsOKTransBill As Boolean 
Dim cn As ADODB.Connection 
'定义插件对象接口. 必须具有的声明, 以此来获得事件 
'注意: 此方法必须存在, 请勿修改 
On Error GoTo doerr 
If dctParams.Value("TranType") <> 71 And dctParams.Value("TranType") <> 81 Then 
HookInvoke = 1 
Exit Function 
End If 
sDsn = dctParams.Value("sDsn") 
InitDataEnv sDsn 
Set cn = datasource.Connection 
sOtherZhangTaoDsn = GetOtherZhangTaoDsn() 
lBillInterID = dctParams.Value("InterID") 

Select Case EventID 
Case 200001 '操作前 
lBillInterID = dctParams.Value("InterID") 
If CheckIsExist(lBillInterID, dctParams.Value("TranType"), sOtherZhangTaoDsn) Then 
HookInvoke = -1 
GoTo ReAprov 
End If 
Case 200003 '审核退出前事件 
GetObjectContext.SetAbort 
lCheckID = dctParams.Value("OperateCode") 

If lCheckID = 1 Then '审核 
sCurrZhangTaoTag = GetCurrZhangTaoTag() 

If dctParams.Value("TranType") = POBill_FID And sCurrZhangTaoTag = "S" Then 
sCurrSupply = GetCurrBillSupplyName(lBillInterID) 
If sCurrSupply = DG_WATSON Then 
bIsOKTransBill = TransSingaporePOToDongguanSO(lBillInterID) 
If Not bIsOKTransBill Then 
HookInvoke = -1 
Exit Function 
End If 
End If 
End If 
End If 

If lCheckID = 2 Then '反审核 
lBillInterID = dctParams.Value("InterID") 
If CheckIsExist(lBillInterID, dctParams.Value("TranType"), sOtherZhangTaoDsn) Then 
HookInvoke = -1 
GoTo ReAprov 
End If 
End If 

Case Else 
End Select 

GetObjectContext.SetComplete 
HookInvoke = 1 
Exit Function 
doerr: 
err.Raise -1, , "中间层调用失败，原因可能是:" & err.Description, "金蝶提示" 
HookInvoke = -1 
Exit Function 
ReAprov: 
err.Raise -1, , "反审核失败，该单据已经传递，不能进行反审核", "金蝶提示" 
HookInvoke = -1 
Exit Function 
End Function