博客园  :: 首页  :: 新随笔  :: 联系 :: 订阅 订阅  :: 管理

常用VB脚本语句

Posted on 2006-05-28 19:19  智岛软件  阅读(2245)  评论(0编辑  收藏  举报

'改变标题:
DBEngine.SetFormTitle ("标题")
'---------------------------------------------------------------------------------------------------------------------
'全部控件只读:
      Call DBEngine.SetAllCtrlPro("EditBox", "ReadOnly", 1)
      Call DBEngine.SetAllCtrlPro("DateTimeCtrl", "ReadOnly", 1) 
      Call DBEngine.SetAllCtrlPro("ComboBox", "ReadOnly", 1)
      Call DBEngine.SetAllCtrlPro("OptionGroup", "ReadOnly", "1")
      Call DBEngine.SetAllCtrlPro("CheckBox", "ReadOnly", "1")
 '---------------------------------------------------------------------------------------------------------------------  
 '调用窗体并传递参数
 
 '调用窗体的代码:
  RowIndex = DBGrid.GetCurRecordIndex
  sInitData = "<InitData><KeyValue>" & DBGrid.GetFieldStringValue("订单号",RowIndex)& "</KeyValue><ID>序号</ID><Action>ViewRecord</Action></InitData>"
  strRet = DBEngine.OpenForm("IntoSchReq_Info",sInitData,"")
  nCloseType = DBEngine.GetElemData(strRet, "CloseType")
  If nCloseType = 1 Then
     Call RetrvData()
  End If

'被调用窗体代码:
  gAction = DBEngine.GetElemData(strInitData, "Action")
  gKey = DBEngine.GetElemData(strInitData, "KeyValue")
  gID = DBEngine.GetElemData(strInitData, "ID")
 
    If strAction = "NewRecord" then '新增记录
       DBEngine.NewRecord g_strSourceName
       ebCode.Text = gKey
    Else      
       If gID <> "" Then
          DBEngine.LocateRecordBySQLWhere (g_strSourceName, "ID = "+gID)
       end if
       If strAction = "ViewRecord" then '浏览记录
          btn_Save.Enabled = False
          btn_New.Enabled = False
          Call DBEngine.SetAllCtrlPro("EditBox", "ReadOnly", 1)
          Call DBEngine.SetAllCtrlPro("DateTimeCtrl", "ReadOnly", 1)
          Call DBEngine.SetAllCtrlPro("ComboBox", "ReadOnly", 1)
       end if
    End if
'---------------------------------------------------------------------------------------------------------------------
'退出窗体时的检查修改动作
Sub DBEngine_EventBeforeCloseWindow(bOK)
   If DBEngine.GetElemData(DBEngine.InitType, "Action") = "EditRecord" Then
      If DBEngine.IsModified(g_strSourceName) Then
         ret = DBEngine.MsgBox1("数据发生改变是否保存?",3)
         if ret = 1 then DBEngine.Continue = false   '取消
         if ret = 6 then
            lb_Ret = DBEngine.SaveRecord(g_strSourceName)
            If not lb_Ret Then
                DBEngine.Continue = false
            End If            
         End If         
      End If
   End If

   '新增状态  
   If DBEngine.IsNewRecord(g_strSourceName) Then
      ret = DBEngine.MsgBox1("是否保存新增的数据?",3)
      if ret = 1 then DBEngine.Continue = false   '取消
      if ret = 6 then
         lb_Ret = DBEngine.SaveRecord(g_strSourceName)
         If not lb_Ret Then
             DBEngine.Continue = false
         End If            
      End If         
   End If
End Sub
'-----------------------------------------------------------------------------------------------------------------
'注释:调用区域式报表,并打印条件查询的结果行
Sub Print_Click()
  RowIndex = MainGrid.GetCurRecordIndex
  If RowIndex = -1 then
    Msgbox "没有数据可打印!"
    Exit sub
  Else
   strsql = "SELECT ReportName AS 报表名称,'区域式报表' AS 报表格式 FROM sysORepTemplate WHERE TableName='" &_
           strTableName + "' "

   strRet = DBEngine.WebFunction("SqlQuery", strsql , "")
   ReportName = DBEngine.GetElemData(strRet, "报表名称")
   strType = "<Int><SQLWhere>" + strSqlWhere + "</SQLWhere></Int>" ?传送条件

   strInit = "<Int><ReportName>" + ReportName + "</ReportName></Int>"
 
   DBEngine.OpenForm "区域式报表窗体" ,strInit,strType
  End If
End Sub
'---------------------------------------------------------------------------------------------------------------------
'切换选项卡页面事件
Sub DBEngine_EventUserEvent(strEventName, strInputXML)
   if strEventName = "TabCtrlCanChange" And strInputXML = "基本情况" then
    if DBEngine.IsNewRecord = true then
      MsgBox("请先保存“基本情况”的数据")
      DBEngine.SetUserEventReturnValue("0")
    End if
  End if
End Sub

'---------------------------------------------------------------------------------------------------------------------
'删除网格数据
Sub btn_StudyExp_Del_Click()
  nCurRecord = grd_StudyExp.GetCurRecordIndex()
  if nCurRecord = -1 then exit sub
  strSqlWhere = "StudyID=" & grd_StudyExp.GetFieldStringValue("StudyID", nCurRecord)
  ret = DBEngine.MsgBox1("确定要删除记录?",1)
  If ret = 2 then Exit Sub
  strInitdata = "DELETE FROM t_b_rs_StudyExp WHERE " + strSqlWhere
  strRet = DBEngine.WebFunction("SqlNonQuery", strInitData, "")
  strError = DBEngine.GetNodeText(strRet, "Error")
  If strError <> "" then '如返回字符串包含了Error节点,则表明出错了
      DBEngine.MsgBox(strError)
      Exit Sub
  End if
  grd_StudyExp.UpdateFromDataSourceUrl("") '更新网格数据
  call SetParenValue_StudyExp()
End Sub

'---------------------------------------------------------------------------------------------------------------------

'目录树代码:
'检索 First data
Sub RetrieveTreeFirst()
  TreeCatalog.InsertItem "全部",-1
  dim Arr,Dic
  strInitdata = " Select name from sysDepartment where supDepartment = '学校' ORDER BY name ASC"
  strRet = DBEngine.WebFunction("SqlQuery", strInitData, "") 
  GetArrFromXML Dic,Arr,strRet  

  FOR i=0 TO UBound(Arr,2)
    TreeCatalog.InsertItem Arr(0,i),-1
    TreeCatalog.SelectItem (0)
  NEXT
End Sub

'注释:取得所选节点值
Sub TreeCatalog_EventTreeSelchanged(nItemID, strItemText)
   strSch = strItemText
End Sub

'---------------------------------------------------------------------------------------------------------------------
'自定义多层目录树:
Sub InitTree()
    strTreeXml = strTreeXml&"<TreeXml>"
      strTreeXml = strTreeXml&"<TreeItem Name=""全部""Image=""0"" SelectedImage=""1"">"     
        strTreeXml = strTreeXml&"<TreeItem Name=""教育组1"" Image=""0"" SelectedImage=""1"">"
                  strTreeXml = strTreeXml&"<TreeItem Name=""学校1"" Image=""2""></TreeItem>"
                  strTreeXml = strTreeXml&"<TreeItem Name=""学校2"" Image=""2""></TreeItem>"
                  strTreeXml = strTreeXml&"<TreeItem Name=""学校3"" Image=""2""></TreeItem>"
            strTreeXml = strTreeXml&"</TreeItem>"
        strTreeXml = strTreeXml&"<TreeItem Name=""教育组2"" Image=""0"" SelectedImage=""1"">"
                  strTreeXml = strTreeXml&"<TreeItem Name=""学校4"" Image=""2""></TreeItem>"
                  strTreeXml = strTreeXml&"<TreeItem Name=""学校5"" Image=""2""></TreeItem>"
                  strTreeXml = strTreeXml&"<TreeItem Name=""学校6"" Image=""2""></TreeItem>"
                  strTreeXml = strTreeXml&"<TreeItem Name=""学校7"" Image=""2""></TreeItem>"
                  strTreeXml = strTreeXml&"<TreeItem Name=""学校8"" Image=""2""></TreeItem>"
                  strTreeXml = strTreeXml&"<TreeItem Name=""学校9"" Image=""2""></TreeItem>"
            strTreeXml = strTreeXml&"</TreeItem>"
      strTreeXml = strTreeXml&"</TreeItem>"
    strTreeXml = strTreeXml&"</TreeXml>"

   'DBEngine.MsgBox(strTreeXml)

   Tree.SetTreeXml(strTreeXml)

   call Tree.Expand(0, 2)'展开0节点

End Sub
Sub InitField()

  dim Arr,Dic
  strInitdata = "SELECT  DeptCode, DeptName, ParentCode,ID FROM _SysDept WHERE ParentCode='" + strParentCode + "'"
  strRet = DBEngine.WebFunction("SqlQuery", strInitData, "") 
  GetArrFromXML Dic,Arr,strRet 

  Tree.DeleteAllItems


  FOR i=0 TO UBound(Arr,2)
     ID = Tree.InsertItem( Arr(0,i) + "-" + Arr(1,i),-1)
     Tree.SetItemData ID,Arr(3,i)
     RetrieveTreeSecond ID,Arr(0,i)      
     Tree.Expand 0,2
  NEXT
End Sub

'---------------------------------------------------------------------------------------------------------------------
'取字段的扩展属性(字段描述信息)
SELECT   *
FROM   ::fn_listextendedproperty (NULL, 'user', 'dbo', 'table', 't_intosch_baseinfo', 'column', default) Order by objname

'---------------------------------------------------------------------------------------------------------------------
'取部门用户信息

返回当前用户名称 GetCurUserName
返回当前用户的登陆名称 GetCurLoginName
返回当前用户的UserID GetCurUserID
返回当前用户的departmentID GetCurUserDepartmentID

*传入用户ID和权限ID,判断用户是否有相应权限 JudgeUserPermission 参数:(Input><UserID></UserID><PrivilegeID></PrivilegeID></Input>
*根据名称(SessionName)返回Session值字符串 GetSessionValue 参数:(Input><SessionName></SessionName></Input>
*根据名称设置Session值字符串 SetSessionValue 参数:(Input><SessionName></SessionName><SessionValue></SessionValue></Input> 

   '取得部门ID
   CurDeptID = DBEngine.WebFunction("GetCurUserDepartmentID", "", "")

   '取得部门名称 
  StrInput = "<priMag><methodKey>getOrganName</methodKey><param id=""1"">"&CurDeptID&"</param></priMag>"
   strRet = DBEngine.WebFunction("", strInput, "&PFKey=Privilege:1.0")
   CurDeptName = DBEngine.GetNodeText(strRet,"organName")

    '取得机构ID和名称
   StrInput = "<priMag><methodKey>getOrganID</methodKey><param id=""1"">"&CurDeptID&"</param></priMag>"
   strRet = DBEngine.WebFunction("", strInput, "&PFKey=Privilege:1.0")

   CurOrgID = DBEngine.GetNodeAttribText(strRet,"Organ","ID")
   CurOrgName = DBEngine.GetNodeAttribText(strRet,"Organ","Name")

  '取得当前学校学段列表,并赋给组合框
  strInputXml = "<priMag><methodKey>getSchoolQuality</methodKey><param id=""1"">"&CurSchoolID&"</param></priMag>"
  strXmlRet = DBEngine.WebFunction("", strInputXML, "&PFKey=Privilege:1.0")

  If Instr(strXmlRet,"&lt;Error&gt;") <> 0 Then
    strInputXml = "<priMag><methodKey>getSchoolQuality</methodKey><param id=""1"">root</param></priMag>"
    strXmlRet = DBEngine.WebFunction("", strInputXML, "&PFKey=Privilege:1.0")
    strWaitSelValue = ConvertToTableDataXml(strXmlRet, "schTypeList", "schType")
    call cmbGradePhase.SetTrueDataMapXml(strWaitSelValue, "schquavalue", "schqua")
  Else
    dim ArrList
    strStart = "<schQua>"
    strEnd = "<schQua>"
    cmbStudyPhase.Clear
    GetArrFromXML arrList,strStart,strEnd,strXmlRet

    FOR i=0 TO UBound(ArrList)

      cmbStudyPhase.AddItem ArrList(i)

    NEXT
  End If
'---------------------------------------------------------------------------------------------------------------------  
'取网格中日期字段值:
strdtcFrom = DBEngine.ToDateString(DBGrid14.GetFieldStringValue("起始时间",nRowIndex))

'-------调用存储过程----------
Function RequBillNo()
   strInputXML = "<Input><ProcName>RequestBillNo</ProcName><InputList>" &_                
                 "</InputList><OutputList><OutputName>Result</OutputName></OutputList></Input>"
   strRetXML = DBEngine.WebFunction("DoProcedure", strInputXML, "")
   strError = DBEngine.GetNodeText(strRetXML, "Error")
   If strError <> "" Then '如返回字符串包含了Error节点,则表明出错了
      DBEngine.MsgBox (strError)
   Else
      RequBillNo = strRetXML
   End If
End Function

'向调用窗体返回值
'==================================================================
'被调用窗体
  RowIndex = MainGrid.GetCurRecordIndex
  DBEngine.SetReturnValue (MainGrid.GetRowDataXML(RowIndex)) 
  DBEngine.CloseWindow(1)

'调用窗体
       strRet = DBEngine.OpenForm("被调用窗体", "", "")     
       nCloseType = DBEngine.GetElemData(strRet,"CloseType")
       If nCloseType   Then    
          ebCode.text = DBEngine.GetElemData(strRet,"ReturnValue")
       End If

'取年级列表--将年级列表分组赋值给组合框
  cmbGrade.Clear

  StrInput = "<Input><TableName>T_ClassInfo</TableName><FieldName>Grade</FieldName>" &_
              "<SQLWhere>SchoolID = '"+CurSchoolID+"'</SQLWhere></Input>"
  StrRet = DBEngine.WebFunction("GetGroupFieldValue",strInput,"")

  arrList = Split(StrRet,"|",-1)  '将列表组成数据数组

  cmbGrade.AddItem ("全部")
  FOR i=0 TO UBound(arrList)
    If ArrList(i)<> "" Then
      cmbGrade.AddItem ArrList(i)
    End If
  NEXT
  cmbGrade.Text = "全部"

'取TableDataXml节点值<NAME>
  ReDim arrList(0)
  strStart = "<NAME>"
  strEnd = "</NAME>"
  cmbStudyType.Clear
  StrSql = "Select Name From T_A_STUDYTYPE Where StudyPhase = '"+cmbStudyPhase.Text+"'"
  StrRet = DBEngine.WebFunction("SqlQuery",StrSql,"")
  GetArrFromXML arrList,strStart,strEnd,StrRet             '调用GetArrFromXML函数

  FOR i=0 TO UBound(arrList)

    cmbStudyType.AddItem ArrList(i)
      If UBound(ArrList) = 0 Then
        cmbStudyType.SelectString 0,ArrList(0)
        cmbStudyType_CloseUp()
      End If
  NEXT

'函数:将FieldInfo节点值组成数组 ---白肖峰
Function GetArrFromXML(ByRef FieldArr, ByRef Arr1, Xml1)
    Dim i, j, lsXml, lsChar, liStar, liEnd, lsStar, lsEnd, liLen,Dic1

    lsStar = "<FieldName>"
    lsEnd = "</FieldName>"
    liLen = Len(lsStar)
    i = InStr(1,Xml1, "<FieldInfoArray>",1)
    If i <> 0 Then
      lsXml = Mid(Xml1, i, Len(Xml1))
    Else
      Exit Function
    End If

    liStar = InStr(1, lsXml, lsStar, 1)
    liEnd = InStr(1, lsXml, lsEnd, 1)
    Do While liEnd > 0
        If IsArray(FieldArr) Then
           ReDim Preserve FieldArr(UBound(FieldArr) + 1)
        Else
           ReDim FieldArr(0)
        End If

        FieldArr(UBound(FieldArr)) = Mid(lsXml, liStar + liLen, liEnd - liStar - liLen)
        liStar = InStr(liEnd+1, lsXml, lsStar, 1)
        liEnd = InStr(liEnd+1, lsXml, lsEnd, 1)
    Loop
  
    Set Dic1 = CreateObject("Scripting.Dictionary")
    For i = 0 To UBound(FieldArr, 1)
       Dic1.Add FieldArr(i), CStr(i)
    Next
    '
    liStar = InStr(1, lsXml, "<RowNum>", 1)
    liEnd = InStr(1, lsXml, "</RowNum>", 1)
    i = Int(Mid(lsXml,  liStar + Len("<RowNum>"), liEnd - liStar - Len("<RowNum>")))

    ReDim Arr1(UBound(FieldArr, 1), i - 1)    

    tmpStartPos = InStr(1, lsXml, "<Row>", 1)
    lsXml = Right(lsXml,Len(lsXml) - tmpStartPos + 1)
    For i = 0 To UBound(Arr1,2)
        tmpInt = InStr(1, lsXml, "</Row>", 1)
        tmpXml = Left(lsXml,tmpInt + Len("</Row>") - 1)
        lsXml = Right(lsXml,Len(lsXml) - tmpInt - Len("</Row>") + 1)

        For j = 0 To UBound(FieldArr, 1) 

            lsStar = "<" & FieldArr(j) & ">"
            lsEnd = "</" & FieldArr(j) & ">"
            liLen = Len(lsStar)
            liStar = InStr(1, tmpXml, lsStar, 1)
            liEnd = InStr(1, tmpXml, lsEnd, 1)

            If liStar = 0 Or liEnd = 0 Then
               Arr1(j,i) = ""
            Else
               Arr1(j, i) = Mid(tmpXml, liStar + liLen, liEnd - liStar - liLen) 
            End If
        Next      
    Next
    '修改结束 bxf
End Function

'函数:将XML节点值组成数组 ---杨庚
Function GetNodeTextFromXml(arrList,strStart,strEnd,strXml)
 lenXml = Len(strXml)
 lStart = Len(strStart)
 lEnd = Len(strEnd)

 StartNum = 1
        EndNum  = 1
        i = 0
 Do While InStr(StartNum,strXml,strStart) > 0
  StartNum = InStr(StartNum,strXml,strStart) + lStart
  EndNum = InStr(EndNum,strXml,strEnd) + lEnd

                If i > 0 Then
                  ReDim Preserve arrList(UBound(arrList)+i)
                End If
                i = i+1

  arrlist(UBound(arrList)) = Mid(strXml,StartNum,EndNum-lEnd-StartNum)

 Loop
 End Function

'函数:将XML整个节点组成数组 ---杨庚

Function GetNodeFromXML(arrList,strStart,strEnd,strXml)
 lenXml = Len(strXml)
 lStart = Len(strStart)
 lEnd = Len(strEnd)

 StartNum = 1
 EndNum  = 1
 i = 0
 Do While InStr(StartNum,strXml,strStart) > 0
  StartNum = InStr(StartNum,strXml,strStart)
  EndNum = InStr(EndNum,strXml,strEnd) + lEnd

                If i > 0 Then
                  ReDim Preserve arrList(UBound(arrList)+i)
                End If
                i = i+1

  arrlist(UBound(arrList)) = Mid(strXml,StartNum,EndNum-StartNum)
  StartNum = StartNum + lStart
 Loop
 End Function