m1.bas

办公自动化 vb+server2

Attribute VB_Name = "权限和结算"
Public cat As New ADOX.Catalog   '不用cat用另外一个名字也可以
Public conn As New ADODB.Connection '连接data数据库
Public cmd As New ADODB.Command
Public rs As New ADODB.Recordset

Public gcat As New ADOX.Catalog   '不用cat用另外一个名字也可以
Public gconn As New ADODB.Connection '连接money数据库
Public gcmd As New ADODB.Command
Public grs As New ADODB.Recordset

Public hcat As New ADOX.Catalog   '不用cat用另外一个名字也可以
Public hconn As New ADODB.Connection '连接权限设置数据库
Public hcmd As New ADODB.Command
Public hrs As New ADODB.Recordset

Public zcat As New ADOX.Catalog   '不用cat用另外一个名字也可以
Public zconn As New ADODB.Connection '保存数据库
Public zcmd As New ADODB.Command
Public zrs As New ADODB.Recordset

Public ghrs As New ADODB.Recordset

Public gzcat As New ADOX.Catalog   '不用cat用另外一个名字也可以
Public gzconn As New ADODB.Connection '连接money数据库
Public gzcmd As New ADODB.Command
Public gzrs As New ADODB.Recordset

Public hzcat As New ADOX.Catalog   '不用cat用另外一个名字也可以
Public hzconn As New ADODB.Connection '连接money数据库
Public hzcmd As New ADODB.Command
Public hzrs As New ADODB.Recordset

Public mytab As New ADOX.Table

Public department As String
Public username As String
Public leibie As String
Public shujuku As String
Public biaoming As String
Public qxz As String
Public lty11, lty12, lty13, lty14, lty15, lty16, lty17, lty18, lty19 As String
Public bianhao As String

Public aa(30) As String
Public bb(30) As String
Public cc(100) As Integer
Public dd(100) As String
Public ee(100) As String
Public ff(100) As String
Public gg(100) As String
Public hh(100) As String
Public ii(100) As String
Public jj(100) As String
Public kk(100) As String
Public ll(20) As String
Public mm(100) As Single

Public normal_id As String
Public ghz As Integer
Public mc_cN As cNeoCaption
Public tystring1, tystring2, tystring3, tystring4, tystring5, tystring6 As String
Public Sub connectdata1()
'conn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=gis8;password=gis8;Initial Catalog=院领导;Data Source=hym1"
'conn.Open "PROVIDER=SQLOLEDB;DATA   SOURCE=;UID=sa;PWD=sa;DATABASE=院领导"
hconn.Open "PROVIDER=SQLOLEDB;DATA   SOURCE=;UID=sa;PWD=sa;DATABASE=院领导"
With hcmd
    .ActiveConnection = hconn
    .CommandType = adCmdTable
    End With
  hcat.ActiveConnection = hconn
End Sub
Public Sub connectdata2()
'conn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=gis8;password=gis8;Initial Catalog=data;Data Source=hym1"
'conn.Open "PROVIDER=SQLOLEDB;DATA   SOURCE=;UID=sa;PWD=sa;DATABASE=data"
conn.Open "PROVIDER=SQLOLEDB;DATA   SOURCE=;UID=sa;PWD=sa;DATABASE=data"
With cmd
    .ActiveConnection = conn
    .CommandType = adCmdTable
    End With
  cat.ActiveConnection = conn
End Sub
Public Sub connectdata3()
'conn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=gis8;password=gis8;Initial Catalog=money;Data Source=hym1"
'conn.Open "PROVIDER=SQLOLEDB;DATA   SOURCE=;UID=sa;PWD=sa;DATABASE=money"
gconn.Open "PROVIDER=SQLOLEDB;DATA   SOURCE=;UID=sa;PWD=sa;DATABASE=money"
With gcmd
    .ActiveConnection = gconn
    .CommandType = adCmdTable
    End With
  gcat.ActiveConnection = gconn
End Sub
Public Sub connectdata4()
'conn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=gis8;password=gis8;Initial Catalog=出图;Data Source=hym1"
'conn.Open "PROVIDER=SQLOLEDB;DATA   SOURCE=;UID=sa;PWD=sa;DATABASE=出图"
gzconn.Open "PROVIDER=SQLOLEDB;DATA   SOURCE=;UID=sa;PWD=sa;DATABASE=出图"
With gzcmd
    .ActiveConnection = gzconn
    .CommandType = adCmdTable
    End With
  gzcat.ActiveConnection = gzconn
End Sub
Public Sub connectdata5()
'conn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=gis8;password=gis8;Initial Catalog=勘察工程;Data Source=hym1"
'conn.Open "PROVIDER=SQLOLEDB;DATA   SOURCE=;UID=sa;PWD=sa;DATABASE=勘察工程"
hzconn.Open "PROVIDER=SQLOLEDB;DATA   SOURCE=;UID=sa;PWD=sa;DATABASE=勘察工程"
With hzcmd
    .ActiveConnection = hzconn
    .CommandType = adCmdTable
    End With
  hzcat.ActiveConnection = hzconn
End Sub

Public Sub connectdata6()
hconn.Close
conn.Close
gconn.Close
gzconn.Close
hzconn.Close
End Sub


Public Sub quanxian1(username As String, MenuItem As Long)
 Select Case MenuItem
       Case 1
        hrs.CursorLocation = adUseClient
        hrs.Open "权限设置", hconn, adOpenKeyset, adLockPessimistic
          For j = 1 To hrs.RecordCount
               If hrs.Fields(0).Value = username Then
               If biaoming = "定线" Then
                  qxz = hrs.Fields(4).Value
                  Else
                  qxz = hrs.Fields(16).Value
               End If
                 If qxz = "1" Then
                 rs.CursorLocation = adUseClient
                 rs.Open "select * from " & biaoming & " order by 工程编号", conn, adOpenKeyset, adLockPessimistic
                     For i = 1 To rs.RecordCount
                           Form7.ListView1.ListItems.Add , , rs.Fields(0).Value
                           For m = 1 To 16
                            Form7.ListView1.ListItems.Item(i).SubItems(m) = rs.Fields(m).Value
                           Next
                             If biaoming <> "定线" Then
                             Form7.ListView1.ListItems.Item(i).SubItems(18) = rs.Fields(17).Value
                             Form7.ListView1.ListItems.Item(i).SubItems(19) = rs.Fields(18).Value
                            End If
                            If biaoming = "定线" Then
                             Form7.ListView1.ListItems.Item(i).SubItems(17) = rs.Fields(17).Value
                             Form7.ListView1.ListItems.Item(i).SubItems(18) = rs.Fields(18).Value
                             Form7.ListView1.ListItems.Item(i).SubItems(19) = rs.Fields(19).Value
                            End If
                      rs.MoveNext
                     Next
                  rs.Close
                 Form7.ListView1.ListItems(Form7.ListView1.ListItems.Count).Selected = True
                 Form7.ListView1.SelectedItem.EnsureVisible
                 Form7.ListView1.Refresh
                 Form7.Show vbModal
                  Else
                  MsgBox "没有权限进行该项操作！", vbInformation, "提示"
               End If
               End If
             hrs.MoveNext
           Next
         hrs.Close
       Case 2
        hrs.CursorLocation = adUseClient
        hrs.Open "权限设置", hconn, adOpenKeyset, adLockPessimistic
          For j = 1 To hrs.RecordCount
               If hrs.Fields(0).Value = username Then
               If biaoming = "定线" Then
                  qxz = hrs.Fields(5).Value
                  Else
                  qxz = hrs.Fields(17).Value
               End If
               If qxz = "1" Then
                 rs.CursorLocation = adUseClient
                 rs.Open "select * from " & biaoming & " order by 工程编号", conn, adOpenKeyset, adLockPessimistic
                       For i = 0 To rs.Fields.Count - 1
                            Form8.Combo1.AddItem (rs.Fields(i).Name)
                       Next i
                     For i = 1 To rs.RecordCount
                           Form8.ListView1.ListItems.Add , , rs.Fields(0).Value
                            For m = 1 To 16
                            Form8.ListView1.ListItems.Item(i).SubItems(m) = rs.Fields(m).Value
                             Next
                            If biaoming <> "定线" Then
                             Form8.ListView1.ListItems.Item(i).SubItems(18) = rs.Fields(17).Value
                             Form8.ListView1.ListItems.Item(i).SubItems(19) = rs.Fields(18).Value

                            End If
                            If biaoming = "定线" Then
                             Form8.ListView1.ListItems.Item(i).SubItems(17) = rs.Fields(17).Value
                             Form8.ListView1.ListItems.Item(i).SubItems(18) = rs.Fields(18).Value
                             Form8.ListView1.ListItems.Item(i).SubItems(19) = rs.Fields(19).Value
                            End If
                      rs.MoveNext
                     Next
                 rs.Close
                 Form8.ListView1.ListItems(Form8.ListView1.ListItems.Count).Selected = True
                 Form8.ListView1.SelectedItem.EnsureVisible
                 Form8.ListView1.Refresh
                 Form8.Show vbModal
                  Else
                  MsgBox "没有权限进行该项操作！", vbInformation, "提示"
               End If
               End If
             hrs.MoveNext
           Next
         hrs.Close
        Case 3
        hrs.CursorLocation = adUseClient
        hrs.Open "权限设置", hconn, adOpenKeyset, adLockPessimistic
          For j = 1 To hrs.RecordCount
               If hrs.Fields(0).Value = username Then
               If biaoming = "定线" Then
                  qxz = hrs.Fields(6).Value
                  Else
                  qxz = hrs.Fields(18).Value
               End If
               If qxz = "1" Then
                 rs.CursorLocation = adUseClient
                 rs.Open "select * from " & biaoming & " order by 工程编号", conn, adOpenKeyset, adLockPessimistic
                    For i = 0 To rs.Fields.Count - 1
                        Form9.Combo1.AddItem (rs.Fields(i).Name)
                    Next i
                     For i = 1 To rs.RecordCount
                           Form9.ListView1.ListItems.Add , , rs.Fields(0).Value
                            For m = 1 To 16
                            Form9.ListView1.ListItems.Item(i).SubItems(m) = rs.Fields(m).Value
                             Next
                            If biaoming <> "定线" Then
                             Form9.ListView1.ListItems.Item(i).SubItems(18) = rs.Fields(17).Value
                             Form9.ListView1.ListItems.Item(i).SubItems(19) = rs.Fields(18).Value
                            End If
                            If biaoming = "定线" Then
                             Form9.ListView1.ListItems.Item(i).SubItems(16) = rs.Fields(16).Value
                             Form9.ListView1.ListItems.Item(i).SubItems(17) = rs.Fields(17).Value
                             Form9.ListView1.ListItems.Item(i).SubItems(18) = rs.Fields(18).Value
                             Form9.ListView1.ListItems.Item(i).SubItems(19) = rs.Fields(19).Value
                            End If
                      rs.MoveNext
                     Next
                  rs.Close
                 Form9.ListView1.ListItems(Form9.ListView1.ListItems.Count).Selected = True
                 Form9.ListView1.SelectedItem.EnsureVisible
                 Form9.ListView1.Refresh
                 Form9.Show vbModal
                  Else
                  MsgBox "没有权限进行该项操作！", vbInformation, "提示"
               End If
               End If
             hrs.MoveNext
           Next
         hrs.Close
        Case 4
        Form2.VerticalMenu2(1).Visible = False
    End Select
End Sub
Public Sub quanxian2(username As String, MenuItem As Long)
 Select Case MenuItem
       Case 1
        hrs.CursorLocation = adUseClient
        hrs.Open "权限设置", hconn, adOpenKeyset, adLockPessimistic
          For j = 1 To hrs.RecordCount
               If hrs.Fields(0).Value = username Then
               If biaoming = "竣工" Then
                  qxz = hrs.Fields(7).Value
               End If
               If biaoming = "零星验字工程" Then
                  qxz = hrs.Fields(10).Value
               End If
               If biaoming = "建筑物位置测定" Then
                  qxz = hrs.Fields(13).Value
               End If
                 If qxz = "1" Then
                 rs.CursorLocation = adUseClient
                 rs.Open "select * from " & biaoming & " order by 工程编号", conn, adOpenKeyset, adLockPessimistic
                     For i = 1 To rs.RecordCount
                           Form12.ListView1.ListItems.Add , , rs.Fields(0).Value
                            For m = 1 To 17
                            Form12.ListView1.ListItems.Item(i).SubItems(m) = rs.Fields(m).Value
                             Next
                            If biaoming <> "零星验字工程" Then
                              Form12.ListView1.ListItems.Item(i).SubItems(18) = rs.Fields(18).Value
                              Form12.ListView1.ListItems.Item(i).SubItems(19) = rs.Fields(19).Value
                              Form12.ListView1.ListItems.Item(i).SubItems(20) = rs.Fields(20).Value
                             Else
                              Form12.ListView1.ListItems.Item(i).SubItems(19) = rs.Fields(18).Value
                              Form12.ListView1.ListItems.Item(i).SubItems(20) = rs.Fields(19).Value
                            End If
                      rs.MoveNext
                     Next
                  rs.Close
                 Form12.ListView1.ListItems(Form12.ListView1.ListItems.Count).Selected = True
                 Form12.ListView1.SelectedItem.EnsureVisible
                 Form12.ListView1.Refresh
                 Form12.Show vbModal
                  Else
                  MsgBox "没有权限进行该项操作！", vbInformation, "提示"
               End If
               End If
             hrs.MoveNext
           Next
         hrs.Close
       Case 2
        hrs.CursorLocation = adUseClient
        hrs.Open "权限设置", hconn, adOpenKeyset, adLockPessimistic
          For j = 1 To hrs.RecordCount
               If hrs.Fields(0).Value = username Then
               If biaoming = "竣工" Then
                  qxz = hrs.Fields(8).Value
               End If
               If biaoming = "零星验字工程" Then
                  qxz = hrs.Fields(11).Value
               End If
               If biaoming = "建筑物位置测定" Then
                  qxz = hrs.Fields(14).Value