form1.frm

用友内部插件

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   8595
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   11880
   LinkTopic       =   "Form1"
   ScaleHeight     =   8595
   ScaleWidth      =   11880
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmd_APIXMLSchema 
      Caption         =   "APIXMLSchema"
      Enabled         =   0   'False
      Height          =   495
      Left            =   5280
      TabIndex        =   12
      Top             =   720
      Width           =   1575
   End
   Begin VB.TextBox txt_schema 
      Height          =   3015
      Left            =   6960
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   11
      Top             =   120
      Width           =   5175
   End
   Begin VB.CommandButton cmd_Delete 
      Caption         =   "DeleteVoucher"
      Enabled         =   0   'False
      Height          =   495
      Left            =   4920
      TabIndex        =   10
      Top             =   2640
      Width           =   1815
   End
   Begin VB.CommandButton cmd_Update 
      Caption         =   "UpdateVoucher"
      Enabled         =   0   'False
      Height          =   495
      Left            =   2640
      TabIndex        =   9
      Top             =   2640
      Width           =   2175
   End
   Begin VB.CommandButton cmd_CancelAudit 
      Caption         =   "CancelAudit"
      Enabled         =   0   'False
      Height          =   495
      Left            =   360
      TabIndex        =   8
      Top             =   2640
      Width           =   2175
   End
   Begin VB.TextBox txt_TimeStamp 
      Height          =   375
      Left            =   3840
      TabIndex        =   7
      Top             =   2160
      Width           =   2895
   End
   Begin VB.TextBox txt_VoucherId 
      Height          =   375
      Left            =   2760
      TabIndex        =   6
      Top             =   2160
      Width           =   975
   End
   Begin VB.CommandButton cmd_Audit 
      Caption         =   "AuditVoucher"
      Enabled         =   0   'False
      Height          =   495
      Left            =   360
      TabIndex        =   5
      Top             =   2040
      Width           =   2175
   End
   Begin VB.TextBox txt_Body 
      Height          =   5175
      Left            =   6600
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   4
      Top             =   3240
      Width           =   5415
   End
   Begin VB.TextBox txt_Header 
      Height          =   5175
      Left            =   600
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   3
      Top             =   3240
      Width           =   5775
   End
   Begin VB.CommandButton cmd_AddVoucher 
      Caption         =   "AddVoucher"
      Enabled         =   0   'False
      Height          =   495
      Left            =   360
      TabIndex        =   2
      Top             =   1440
      Width           =   2175
   End
   Begin VB.CommandButton cmd_LoadVoucher 
      Caption         =   "LoadVoucher"
      Enabled         =   0   'False
      Height          =   495
      Left            =   360
      TabIndex        =   1
      Top             =   840
      Width           =   2175
   End
   Begin VB.CommandButton cmd_Login 
      Caption         =   "Login"
      Height          =   495
      Left            =   360
      TabIndex        =   0
      Top             =   240
      Width           =   2175
   End
   Begin VB.Label Label2 
      Caption         =   "TimeStamp:"
      Height          =   255
      Left            =   3960
      TabIndex        =   14
      Top             =   1800
      Width           =   2295
   End
   Begin VB.Label Label1 
      Caption         =   "VoucherId:"
      Height          =   375
      Left            =   2760
      TabIndex        =   13
      Top             =   1800
      Width           =   975
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmd_AddVoucher_Click()
    Dim o_api As BizAPI
    Dim o_adaptersvr As BizAdapterService
    
    Dim o_header As New DOMDocument, o_body As New DOMDocument
    Dim sHeadId As String
    
    On Error GoTo ErrHanlde
    
    Set o_adaptersvr = New BizAdapterService
    
    'o_adaptersvr.ConfigFile = "F:\zsf\二次开发\Document\ConfigFile\UFSoft.U8.Business.Interface.config"
    
    Set o_api = o_adaptersvr.GetBizAPI("SCMPU/PU/Add", "860")
    
    If o_api Is Nothing Then
        MsgBox "Get API SCMPU/PU/Add not Success!"
        Exit Sub
    End If
    
    If Not o_header.loadXML(txt_Header.Text) Then
        Err.Raise -1, "", o_header.parseError.reason
    End If
    If Not o_body.loadXML(txt_Body.Text) Then
        Err.Raise -1, "", o_header.parseError.reason
    End If
    
    '更新单据表头表体[测试工程使用]
    'Call SetHeadItemValue(o_header, "ddate", g_oLogin.CurDate)
    Call SetBodyItemValue(o_body, "editprop", "A") '注意：表体的editprop=A 才能新增保存
    
    Call o_api.Parameters("domHead").setValue(o_header)
    Call o_api.Parameters("domBody").setValue(o_body)
    Call o_api.Parameters("VoucherState").setValue(2)
    
    'sHeadId = ""
    'Call o_api.Parameters("curID").setValue(sHeadId)
    
    Call o_api.Parameters("VoucherType").setValue(1)
'    Call o_api.Parameters("sBillType").setValue("purbill")
'    Call o_api.Parameters("bPositive").setValue(True)
    
    Dim sRev As String
    sRev = o_api.Execute(g_oLogin, g_oConnection)
    
    If sRev = "" Then
        sHeadId = o_api.Parameters("curID").getValue
        MsgBox "OK" & "  " & sHeadId
    Else
        MsgBox "Error in Adding a new vouch." & vbCrLf & sRev
    End If
    
    Exit Sub
ErrHanlde:
    MsgBox Err.Description
End Sub

Private Sub cmd_APIXMLSchema_Click()
    Dim o_header As DOMDocument, o_body As DOMDocument, str_error As String
    
    Dim o_api As BizAPI
    Dim o_adaptersvr As BizAdapterService
    
    Dim s_Success As String
    
    Set o_adaptersvr = New BizAdapterService
    
    'o_adaptersvr.ConfigFile = "F:\zsf\二次开发\Document\ConfigFile\UFSoft.U8.Business.Interface.config"
    
    Set o_api = o_adaptersvr.GetBizAPI("SCMPU/PU/Load", "860")
    
    If o_api Is Nothing Then
        MsgBox "Get API SCMPU/PU/Load not Success!"
        Exit Sub
    End If
    
    Call o_api.Parameters("VoucherType").setValue(1)
    

    If txt_VoucherId.Text <> "" Then
        Call o_api.Parameters("varVoucherID").setValue(txt_VoucherId.Text)
    End If
    
    
    s_Success = o_api.Execute(g_oLogin, g_oConnection)
    
    If s_Success = "" Then
        Me.txt_schema.Text = o_api.Parameters.ToXml()
    Else
        MsgBox s_Success
    End If
End Sub

Private Sub cmd_Audit_Click()
    Dim o_api As BizAPI
    Dim o_adaptersvr As BizAdapterService
    
    Dim o_errMsg As New DOMDocument
    Dim o_header As New DOMDocument
    
    On Error GoTo ErrHanlde
    
    Set o_adaptersvr = New BizAdapterService
    
    'o_adaptersvr.ConfigFile = "F:\zsf\二次开发\Document\ConfigFile\UFSoft.U8.Business.Interface.config"
    
    Set o_api = o_adaptersvr.GetBizAPI("SCMPU/PU/ConfirmPO", "860")
    
    If o_api Is Nothing Then
        MsgBox "Get API SCMPU/PU/Audit not Success!"
        Exit Sub
    End If
    
    If Not o_header.loadXML(txt_Header.Text) Then
        Err.Raise -1, "", o_header.parseError.reason
    End If
    
    Call o_api.Parameters("VoucherType").setValue(1)
    Call o_api.Parameters("domHead").setValue(o_header)
    

    Dim sRev As String
    sRev = o_api.Execute(g_oLogin, g_oConnection)

    If sRev = "" Then
        MsgBox "OK"
    Else
        MsgBox "Error in Auditting a new vouch." & vbCrLf & sRev
    End If
    
    Exit Sub
ErrHanlde: