www.pudn.com > VB-KAOQINXITONG.zip > frmInnerTools.frm
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{B9D938CE-50EE-40B2-9FA2-79A3112F4788}#4.2#0"; "BNCtrlGroup.ocx"
Begin VB.Form frmInnerTools
Caption = "内部工具"
ClientHeight = 6030
ClientLeft = 60
ClientTop = 345
ClientWidth = 8475
Icon = "frmInnerTools.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 6030
ScaleWidth = 8475
StartUpPosition = 2 '屏幕中心
Begin BNCtrlGroup.BNButton Command2
Height = 360
Left = 7080
TabIndex = 12
Top = 3375
Width = 1305
_ExtentX = 0
_ExtentY = 0
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 225
Left = 4980
TabIndex = 11
Top = 5670
Width = 2655
_ExtentX = 4683
_ExtentY = 397
_Version = 393216
Appearance = 0
End
Begin BNCtrlGroup.BNButton Command1
Height = 360
Left = 7065
TabIndex = 10
Top = 2025
Width = 1305
_ExtentX = 0
_ExtentY = 0
Caption = "数据库整理"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin BNCtrlGroup.BNButton cmdLoadDepartment
Height = 345
Left = 5940
TabIndex = 9
Top = 2940
Width = 2445
_ExtentX = 0
_ExtentY = 0
Caption = "整理单位部门编码"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin BNCtrlGroup.BNComboBox Combo1
Height = 300
Left = 270
TabIndex = 8
Top = 2445
Width = 3195
_ExtentX = 0
_ExtentY = 0
BackColor = 14737632
BackColor = 14737632
BackColor = 14737632
End
Begin BNCtrlGroup.BNButton cmdCode
Height = 360
Left = 3600
TabIndex = 7
Top = 2430
Width = 1275
_ExtentX = 0
_ExtentY = 0
Caption = "查看代码"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin MSComctlLib.TreeView TreeView1
Height = 3060
Left = 255
TabIndex = 6
Top = 2865
Width = 4605
_ExtentX = 8123
_ExtentY = 5398
_Version = 393217
Style = 7
BorderStyle = 1
Appearance = 0
End
Begin BNCtrlGroup.BNButton cmdSelect
Height = 360
Index = 1
Left = 7035
TabIndex = 5
Top = 105
Width = 1305
_ExtentX = 0
_ExtentY = 0
Caption = "全 选"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin BNCtrlGroup.BNButton cmdSelect
Height = 360
Index = 0
Left = 7035
TabIndex = 4
Top = 510
Width = 1305
_ExtentX = 0
_ExtentY = 0
Caption = "全不选"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin BNCtrlGroup.BNButton cmdExit
Height = 360
Left = 7065
TabIndex = 3
Top = 2490
Width = 1305
_ExtentX = 0
_ExtentY = 0
Caption = "退出(&E)"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin BNCtrlGroup.BNButton cmdLoadTable
Height = 360
Left = 7065
TabIndex = 2
Top = 1215
Width = 1305
_ExtentX = 0
_ExtentY = 0
Caption = "加载数据表"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin BNCtrlGroup.BNButton cmdSave
Height = 360
Left = 7065
TabIndex = 1
Top = 1605
Width = 1305
_ExtentX = 0
_ExtentY = 0
Caption = "保存数据表"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin VB.ListBox List1
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
Columns = 3
Height = 2130
Left = 255
Style = 1 'Checkbox
TabIndex = 0
Top = 135
Width = 4620
End
Begin BNCtrlGroup.BNButton BNButton1
Cancel = -1 'True
Height = 360
Left = 7095
TabIndex = 13
Top = 3840
Width = 1305
_ExtentX = 0
_ExtentY = 0
Caption = "修改姓名"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
End
Attribute VB_Name = "frmInnerTools"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim msString() As String
Private Sub BNButton1_Click()
Dim adoTempRS As ADODB.Recordset
Set adoTempRS = New ADODB.Recordset
Dim sName() As String
Dim lMaxIndex() As Long
Dim l As Long
Dim m As Long
Dim n As Long
Dim bFlag As Boolean
Dim sOldName As String
adoTempRS.Open "SELECT * FROM A001A001", gDBRecordConn, adOpenStatic, adLockOptimistic
ReDim sName(0)
ReDim lMaxIndex(0)
adoTempRS.MoveFirst
For l = 1 To adoTempRS.RecordCount
sOldName = adoTempRS!A0101
bFlag = False
For m = 0 To UBound(sName)
If sName(m) = Left(sOldName, 1) Then
bFlag = True
Exit For
End If
Next m
If bFlag Then
lMaxIndex(m) = lMaxIndex(m) + 1
n = lMaxIndex(m)
Else
ReDim Preserve sName(UBound(sName) + 1)
ReDim Preserve lMaxIndex(UBound(lMaxIndex) + 1)
sName(UBound(sName)) = Left(sOldName, 1)
n = 0
End If
sOldName = Left(sOldName, 1) & Format(n + 1, "000")
adoTempRS!A0101 = sOldName
adoTempRS.Update
adoTempRS.MoveNext
Next l
End Sub
Private Sub cmdCode_Click()
gclsCommon.CBNFillCodeTree TreeView1, gclsCommon.CBNGetFirstData(Combo1.Text)
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdLoadDepartment_Click()
Dim adoTempRS As ADODB.Recordset
Dim i As Integer
Dim sParentCode As String
Dim sOldValue As String
Dim sNewValue As String
Dim Node As MSComctlLib.Node
Dim sCode As String
gclsCommon.CBNFillDeptListTree TreeView1
Exit Sub
Set Node = TreeView1.Nodes(1)
Node.Tag = Node.Key & Node.Tag
LoSetNodeCode Node
Set adoTempRS = New ADODB.Recordset
adoTempRS.Open "SELECT * FROM T0015S001", gDBRecordConn, adOpenStatic, adLockOptimistic
ProgressBar1.Max = TreeView1.Nodes.Count
ProgressBar1.Visible = True
For Each Node In TreeView1.Nodes
i = i + 1
ProgressBar1.Value = i
adoTempRS.Filter = "W0096 ='" & gclsCommon.CBNGetFirstData(Node.Text) & "'"
If adoTempRS.RecordCount = 0 Then
Else
sCode = gclsInclude.MyGetSerialStr(Node.Tag, 1)
If sCode = gclsCommon.CBNGetFirstData(TreeView1.Nodes(1)) Then
adoTempRS!W0090 = "UN"
Else
adoTempRS!W0090 = Left(sCode, Len(sCode) - 3)
End If
sOldValue = adoTempRS!W0096
If Not gclsCommon.CBNModifyBatch(gDBRecordConn, "E0122", sCode, sOldValue) Then GoTo ExitSub
adoTempRS!W0096 = sCode & "^"
adoTempRS.Update
End If
Next
adoTempRS.Filter = 0
adoTempRS.MoveFirst
i = 0
Do While Not adoTempRS.EOF
i = i + 1
ProgressBar1.Value = i
adoTempRS!W0096 = Left(adoTempRS!W0096, Len(adoTempRS!W0096) - 1)
adoTempRS.Update
adoTempRS.MoveNext
Loop
ExitSub:
ProgressBar1.Visible = False
End Sub
Private Sub LoSetNodeCode(Node As MSComctlLib.Node)
Dim i As Integer
Dim n As Integer
Dim sParentCode As String
Dim NewNode As MSComctlLib.Node
i = 1
If gclsInclude.MyGetSerialStr(Node.Tag, 1) <> "UN" And gclsInclude.MyGetSerialStr(Node.Tag, 1) <> "UM" Then
sParentCode = gclsInclude.MyGetSerialStr(Node.Tag, 1)
Else
sParentCode = gclsInclude.MyGetSerialStr(Node.Tag, 3)
End If
n = Node.Children
If n > 0 Then Set NewNode = Node.Child
Do While i <= n
NewNode.Tag = sParentCode & Format(i, "000") & "_" & NewNode.Tag
If NewNode.Children > 0 Then
LoSetNodeCode NewNode
End If
If Not NewNode.Next Is Nothing Then
Set NewNode = NewNode.Next
End If
i = i + 1
Loop
End Sub
Private Sub cmdLoadTable_Click()
Dim sTables() As String
Dim i As Integer
List1.Columns = 3
' 置鼠标忙标志
Screen.MousePointer = vbHourglass
List1.Clear
sTables = gclsDBFunc.dbTableDefs(, , True, gDBRecordConn)
gclsInclude.MyQuickSort sTables, 1, UBound(sTables)
For i = 1 To UBound(sTables)
List1.AddItem sTables(i)
Next i
Screen.MousePointer = vbDefault
End Sub
Private Sub cmdSave_Click()
Dim sTablesList As String
Dim i As Integer
If List1.SelCount = 0 Then Exit Sub
For i = 1 To List1.ListCount
If List1.Selected(i - 1) Then
sTablesList = sTablesList & List1.List(i - 1) & SPLIT_SYMBOL
End If
Next i
If Right(sTablesList, Len(SPLIT_SYMBOL)) = SPLIT_SYMBOL Then sTablesList = Left(sTablesList, Len(sTablesList) - Len(SPLIT_SYMBOL))
Me.Hide
If Not gclsCommon.CBNSaveMilieu(sTablesList, False) Then
Me.Show
MsgBox "未成功保存数据!", vbExclamation
Else
gclsCommon.CBNSaveEvents OET_BACKUP_DATA, sTablesList
End If
Me.Show
End Sub
Private Sub cmdSelect_Click(Index As Integer)
If List1.ListCount = 0 Then Exit Sub
Dim i As Integer
For i = 0 To List1.ListCount - 1
List1.Selected(i) = IIf(Index = 0, False, True)
Next i
List1.ListIndex = 0
End Sub
Private Sub Command1_Click()
Dim sSQL As String
Dim i As Integer
Dim sTablesList As String
If List1.SelCount = 0 Then Exit Sub
ProgressBar1.Visible = True
ProgressBar1.Max = List1.ListCount
For i = 1 To List1.ListCount
ProgressBar1 = i
If List1.Selected(i - 1) Then
sTablesList = List1.List(i - 1)
If gclsDBFunc.dbFieldExists(sTablesList, "A0100", gDBRecordConn) Then
sSQL = "UPDATE " & sTablesList & " SET A0100 = SUBSTRING('000000000000000010220000000000', LEN(A0100), 30 - LEN(A0100)) + A0100"
gDBRecordConn.Execute sSQL
DoEvents
End If
End If
Next i
ProgressBar1.Visible = False
End Sub
Private Sub Command2_Click()
Dim sSQL As String
Dim i As Integer
Dim sTablesList As String
If List1.SelCount = 0 Then Exit Sub
ProgressBar1.Visible = True
ProgressBar1.Max = List1.ListCount
For i = 1 To List1.ListCount
ProgressBar1 = i
If List1.Selected(i - 1) Then
sTablesList = List1.List(i - 1)
If gclsDBFunc.dbFieldExists(sTablesList, "B0110", gDBRecordConn) Then
sSQL = "UPDATE " & sTablesList & " SET B0110 = '00'"
gDBRecordConn.Execute sSQL
DoEvents
End If
End If
Next i
ProgressBar1.Visible = False
End Sub
Private Sub Form_Load()
Dim adoTempRS As ADODB.Recordset
Set adoTempRS = New ADODB.Recordset
SetIcon Me
With adoTempRS
.Open "SELECT * FROM T0010S001 ORDER BY W0093", gDBRecordConn, adOpenStatic, adLockReadOnly
Do While Not .EOF
Combo1.AddItem !W0093 & SPLIT_SYMBOL & !W0094
.MoveNext
Loop
End With
Combo1.ListIndex = 0
End Sub