Private Sub Command1_Click()
Set tdconnction = CreateObject("TDApiOle80.TDConnection")
tdconnction.InitConnectionEx "lab11:8888/qcbin"
tdconnction.ConnectProjectEx "AAA", "bbb", "孙东峰", ""
Set aSet = tdconnction.UserSettings
'方法一：
Text2.Text = aSet.Value("")
'方法二：
Set setItems = aSet.EnumItems
For Each aSetItem In setItems
ItemName = aSetItem
Text3.Text = aSet.Value(ItemName)
Next aSetItem
Label1.Caption = "end"
End Sub
Private Sub Command10_Click()
Set tdconnction = CreateObject("TDApiOle80.TDConnection")
tdconnction.InitConnectionEx "lab11:8888/qcbin"
tdconnction.ConnectProjectEx "DEFAULT", "QualityCenter_Demo", "alex_qc", "123"
End Sub
Private Sub Command11_Click()
Set tdconnction = CreateObject("TDApiOle80.TDConnection")
tdconnction.InitConnectionEx "lab11:8888/qcbin"
tdconnction.ConnectProjectEx "DEFAULT", "QualityCenter_Demo", "alex_qc", "123"
Set BugFact = tdconnction.BugFactory
'根据ID返回需要的附件
Set attachmentXml = CreateObject("Microsoft.XMLDOM")
Set pi = ateProcessingInstruction("xml", "version='1.0'  encoding='utf-8'")
Call attachmentXml.insertBefore(pi, attachmentXml.childNodes(0))
Set attachmentRows = ateNode(1, "Row", "")
attachmentXml.appendChild (attachmentRows)
'For j = 1 To length
Set attachmentId = ateNode(1, "attachment", "")
Set NewAttribute = ateNode("attribute", "id", "")
NewAttribute.Text = 2
attachmentId.SetAttributeNode NewAttribute
Set bugObj = BugFact.Item(2)
Set attachFact = bugObj.Attachments
Set attachList = attachFact.NewList("")
For Each attachObj In attachList
k = k + 1
Set attachmentName = ateNode(1, "attribute" & k, "")
attachmentName.Text = attachObj.Name
attachmentId.appendChild (attachmentName)
'Next
attachmentRows.appendChild (attachmentId)
Next
attachmentXml.save ("f:\\a\\a.xml") '将xml文件保存
Label2.Caption = "end"
End Sub
Private Sub Command12_Click()
Set tdc = CreateObject("TDApiOle80.TDConnection")
tdc.InitConnectionEx "lab11:8888/qcbin"
tdc.ConnectProjectEx "DEFAULT", "QualityCenter_Demo", "alex_qc", "123"
Dim bugF
Dim bug
Dim fieldList
Set bugF = tdc.BugFactory
Set fieldList = bugF.Fields
Set bugFilter = bugF.Filter
'读取xml文件
Set xmldom = CreateObject("Microsoft.XMLDOM")
xmldom.Load ("f:\\a\\a.xml")
Set docroot = xmldom.documentElement
'Set filter = ElementsByTagName("filter")
Set FilterXml = docroot.selectSingleNode("filter").childNodes
'设置过滤
For Each suite In FilterXml
bugFilter.deName) = suite.Text
Next
Set Sort = docroot.selectSingleNode("sort").childNodes
'设置排序
For Each suite In Sort
bugFilter.deName) = suite.Text
bugFilter.deName) = 0
Next
If Sort.length = 0 Then
bugFilter.Order("bg_bug_id") = 1
bugFilter.OrderDirection("bg_bug_id") = 0
End If
'创建xml文件
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Set xnRows = ateNode(1, "Rows", "")
xmlDoc.appendChild (xnRows)
Set BugList = bugFilter.NewList
For Each theBug In BugList
Set xnRow = ateNode(1, "Row", "")
xnRows.appendChild (xnRow)
For Each aField In fieldList
With aField
Set xnCell = ateNode(1, aField.Name, "") '取得列名
xnCell.Text = theBug.Field(aField.Name) '将列的值加到xnCell上或者说是直接给列赋值
xnRow.appendChild (xnCell)
End With
Next
Next
Set pi = ateProcessingInstruction("xml", "version='1.0'  encoding='utf-8'")
Call xmlDoc.insertBefore(pi, xmlDoc.childNodes(0))
'将xml文件保存
xmlDoc.save ("f:\\a\\b.xml")
'释放连接
Call tdc.DisconnectProject
Call tdc.ReleaseConnection
End Sub
Private Sub Command13_Click()
Set tdconnction = CreateObject("TDApiOle80.TDConnection")
tdconnction.InitConnectionEx "lab11:8888/qcbin"
tdconnction.Login "alex_qc", "123"
Label5.Caption = "end"
End Sub
Private Sub Command14_Click()
Set tdconnction = CreateObject("TDApiOle80.TDConnection")
tdconnction.InitConnectionEx "lab11:8888/qcbin"
tdconnction.Login "alex_qc", "123"
Set docmains = tdconnction.VisibleDomains
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Set xnRows = ateNode(1, "GetAllDomains", "")
xmlDoc.appendChild (xnRows)
For Each docmain In docmains
Set docmainNodes = ateNode(1, "TDXItem", "")  'DOMAIN_NAME
Set docmainNode = ateNode(1, "DOMAIN_NAME", "")
docmainNode.Text = docmain
docmainNodes.appendChild (docmainNode)
Set projects = ateNode(1, "PROJECTS_LIST", "")
Set projectNodes = ateNode(1, "TDXItem", "")
For Each project In tdconnction.VisibleProjects(docmain)
Set projectNode = ateNode(1, "PROJECT_NAME", "")
projectNode.Text = project
projectNodes.appendChild (projectNode)
Next
projects.appendChild (projectNodes)
docmainNodes.appendChild (projects)
xnRows.appendChild (docmainNodes)
Next
Set pi = ateProcessingInstruction("xml", "version='1.0'  encoding='utf-8'")
Call xmlDoc.insertBefore(pi, xmlDoc.childNodes(0))
xmlDoc.save ("f:\\a\\b.xml")
End Sub
Private Sub Command15_Click()
Set tdc = CreateObject("TDApiOle80.TDConnection")
tdc.InitConnectionEx "lab11:8888/qcbi
n"
tdc.ConnectProjectEx "DEFAULT", "QualityCenter_Demo", "刘香平", ""
Set TreeMgr = tdc.TreeManager
Set Trees = TreeMgr.RootList(TDOLE_NOT_SUBJECT)
RootName = Trees.Item(1)
Set SubjRoot = TreeMgr.TreeRoot(RootName)
For i = 1 To SubjRoot.Count
Set ChildNode = SubjRoot.Child(i)
Text7 = Text7 & ChildNode.Name & ":"
For j = 1 To ChildNode.Count
Text7 = Text7 & "," & ChildNode.Child(j).Name
Next j
Text7 = Text7 & ";" & Chr(10)
Next i
End Sub
Private Sub Command16_Click()
Set tdc = CreateObject("TDApiOle80.TDConnection")
tdc.InitConnectionEx "192.168.1.12:9000/qcbin"
tdc.ConnectProjectEx "TEST_NEW", "DrDMS", "刘香平", ""
Set TreeMgr = tdc.TreeManager
Set tree = TreeMgr.NodeById(1411)
For i = 1 To tree.Count
Text9 = Text9 & "," & tree.Child(i).Name
Next i
End Sub
Private Sub Command17_Click()
Set tdc = CreateObject("TDApiOle80.TDConnection")
tdc.InitConnectionEx "lab11:8888/qcbin"
tdc.ConnectProjectEx "DEFAULT", "QualityCenter_Demo", "alex_qc", "123"
Set custom = tdc.Customization
Set User = custom.Users
Set userlist = User.Users
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Set xnRows = ateNode(1, "Rows", "")
xmlDoc.appendChild (xnRows)
For Each use In userlist
With use
Set xnRow = ateNode(1, "Row", "")
xnRow.Text = use.Name
xnRows.appendChild (xnRow)
Text10.Text = use.Name & "," & Text10.Text
End With
Next use
Set pi = ateProcessingInstruction("xml", "version='1.0'  encoding='utf-8'")
Call xmlDoc.insertBefore(pi, xmlDoc.childNodes(0))
xmlDoc.save ("F:\\a\\l")
Call tdc.DisconnectProject
Call tdc.ReleaseConnection
End Sub
Private Sub Command18_Click()
Set tdc = CreateObject("TDApiOle80.TDConnection")
tdc.InitConnectionEx "lab11:8888/qcbin"
tdc.ConnectProjectEx "DEFAULT", "QualityCenter_Demo", "刘香平", ""
Set cust = tdc.Customization
Set custUsers = cust.Users
Set custUser = custUsers.User("刘香平")
'Text11 = custUser.Name
Set List = custUser.GroupsList
'Set a = cust.UsersGroups
List2.Clear
For Each aList In List
List2.AddItem (aList.Name & "    " & aList.IsSystem)
'Set b = a.Group(aList.Name)
'Text11 = Text11 & "," & b.Name
Next
Label6 = "end"
End Sub
Private Sub Command19_Click()
createprocessaSet tdc = CreateObject("TDApiOle80.TDConnection")
tdc.InitConnectionEx "lab11:8888/qcbin"
tdc.ConnectProjectEx "DEFAULT", "vb儿童噶人", "alex_qc", "123"
Dim bugF
Dim bug
Set bugF = tdc.BugFactory
' bug.field("bg_status") = Text3.Text
Set bug = bugF.AddItem(Null)
'读取xml文件
Set xmldom = CreateObject("Microsoft.XMLDOM")
xmldom.Load ("F:\\a\\l")
Set docroot = xmldom.documentElement
Set suites = docroot.childNodes
For Each suite In suites
bug.deName) = suit
e.Text
Next
bug.Post
'释放连接
Call tdc.DisconnectProject
Call tdc.ReleaseConnection
Label7.Caption = "end"
End Sub
Private Sub Command2_Click()
Set tdconnction = CreateObject("TDApiOle80.TDConnection")
tdconnction.InitConnectionEx "lab11:8888/qcbin"
tdconnction.ConnectProjectEx "DEFAULT", "QualityCenter_Demo", "alex_qc", "123"
Set aSet = tdconnction.UserSettings
Set setItems = aSet.EnumItems
For Each aSetItem In setItems
ItemName = aSetItem
Text1.Text = aSet.IsSystem(ItemName) & ","
aSet.Open (ItemName)
'aSet.IsSystem(ItemName) = True
aSet.Value(ItemName) = Text4.Text
aSet.Post
aSet.Refresh ItemName
aSet.Close
Text1.Text = Text1.Text & aSet.Value(ItemName)
Next aSetItem
Label2.Caption = "end"
End Sub
Private Sub Command3_Click()
Set tdconnction = CreateObject("TDApiOle80.TDConnection")
tdconnction.InitConnectionEx "lab11:8888/qcbin"
tdconnction.ConnectProjectEx "DEFAULT", "QualityCenter_Demo", "alex_qc", "123"
' 查询操作
Set cmd = tdconnction.Command
cmd.CommandText = "SELECT AC_ACTION_NAME FROM ACTIONS"
Set RecSet = cmd.Execute
' 填充组合框
Combo1.Clear
For i = 1 To RecSet.RecordCount
Combo1.AddItem (RecSet.FieldValue(0))
RecSet.Next
Next
Combo1.ListIndex = 0
End Sub
Private Sub Command4_Click()
Set tdconnction = CreateObject("TDApiOle80.TDConnection")
tdconnction.InitConnectionEx "lab11:8888/qcbin"
tdconnction.ConnectProjectEx "DEFAULT", "QualityCenter_Demo", "刘香平", ""
Set ActPer = tdconnction.ActionPermission
If ActPer.ActionEnabled(Combo1.Text) Then
Label3.Caption = "Permitted"
Else
Label3.Caption = "Not Permitted"
End If
End Sub
Private Sub Command5_Click()
Set tdconnction = CreateObject("TDApiOle80.TDConnection")
tdconnction.InitConnectionEx "lab11:8888/qcbin"
tdconnction.ConnectProjectEx "DEFAULT", "QualityCenter_Demo", "alex_qc", "123"
Set fieldList = tdconnction.Fields("BUG")
List1.Clear
For Each aField In fieldList
List1.AddItem (aField.Name & ":" & aField.Property)
Next
End Sub
Private Sub Command6_Click()
Set tdconnction = CreateObject("TDApiOle80.TDConnection")
tdconnction.InitConnectionEx "lab11:8888/qcbin"
tdconnction.ConnectProjectEx "DEFAULT", "QualityCenter_Demo", "alex_qc", "123"
Set fieldList = tdconnction.Fields("BUG")
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Set xnRows = ateNode(1, "Row", "")
xmlDoc.appendChild (xnRows)
For Each aField In fieldList
Set xnCell = ateNode(1, aField.Name, "") '取得列名
xnCell.Text = aField.Property '将列的值加到xnCell上或者说是直接给列赋值
xnRows.appendChild (xnCell)
Next
xmlDoc.save ("F:\\a\\2.xml") '将xml文件保存
Label4.Caption = "end"
End Sub
Private Sub Command7_Click()
'On Error Resume Next
Set tdconnction = CreateObject("SAClient.SAapi")
tdconnction.Login "lab11:8888/sabin", "alex_qc", "123"
sReply = tdconnction.GetAllDomains
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.opentextfile("F:/l", 2, True)
f.writeline Mid(sReply, 1, Len(sReply) - 1)
Text6.Text = sReply
'If Err = 0 Then
'Label5.Caption = "true"
'Else
'Label5.Caption = "false"
'End If
Label5.Caption = "end"
End Sub
Private Sub Command8_Click()
Set tdconnction = CreateObject("TDApiOle80.TDConnection")
tdconnction.InitConnectionEx "lab11:8888/qcbin"
tdconnction.ConnectProjectEx "DEFAULT", "dddd", "alex_qc", "123"
Label5.Caption = "end"
End Sub
Private Sub Command9_Click()
Set tdc = CreateObject("TDApiOle80.TDConnection")
tdc.InitConnectionEx "lab11:8888/qcbin"
tdc.ConnectProjectEx "DEFAULT", "QualityCenter_Demo", "alex_qc", "123"
Set cust = tdc.Customization
Set custFields = cust.Fields
Set fieldXml = CreateObject("Microsoft.XMLDOM")
Set fieldRows = ateNode(1, "Row", "")
fieldXml.appendChild (fieldRows)
For Each aCustField In custFields.Fields("BUG")
If aCustField.IsActive Then
Set rootRows = ateNode(1, aCustField.ColumnName, "")
Set UserLabel = ateNode(1, "UserLabel", "")
UserLabel.Text = aCustField.UserLabel
rootRows.appendChild (UserLabel)
Set ColumnType = ateNode(1, "ColumnType", "")
ColumnType.Text = aCustField.ColumnType
rootRows.appendChild (ColumnType)
Set IsRequired = ateNode(1, "IsRequired", "")
IsRequired.Text = aCustField.IsRequired
rootRows.appendChild (IsRequired)
Set RootId = ateNode(1, "RootId", "")
If aCustField.RootId <> "" Then
Set com = tdc.Command
com.CommandText = "select * from all_lists where al_father_id = " & aCustField.RootId
Set RecSet = com.Execute
For i = 1 To RecSet.RecordCount
Set Child = ateNode(1, "Child" & i, "")
Set NewAttribute = ateNode("attribute", "id", "")
NewAttribute.Text = RecSet.FieldValue(0)
Child.SetAttributeNode NewAttribute
Child.Text = RecSet.FieldValue(2)
Text8.Text = Text8.Text & "," & RecSet.FieldValue(0)
RootId.appendChild (Child)
RecSet.Next
Next
End If
rootRows.appendChild (RootId)
fieldRows.appendChild (rootRows)
End If
Next
fieldXml.save ("F:\\a\\l") '将xml文件保存
Label5.Caption = "end"
End Sub

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。