www.pudn.com > VB-KAOQINXITONG.zip > frmInnerTest.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 frmInnerTest
BorderStyle = 3 'Fixed Dialog
Caption = "内部测试"
ClientHeight = 8490
ClientLeft = 2760
ClientTop = 3750
ClientWidth = 12525
Icon = "frmInnerTest.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 8490
ScaleWidth = 12525
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin BNCtrlGroup.BNButton cmdGetDBase
Height = 345
Left = 10440
TabIndex = 22
Top = 2160
Width = 1695
_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 cmdTableStruct
Height = 315
Index = 1
Left = 3615
TabIndex = 21
Top = 7830
Width = 2130
_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 Command4
Height = 315
Left = 135
TabIndex = 20
Top = 7785
Width = 1455
_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 cmdGetAllIndexes
Height = 315
Left = 135
TabIndex = 19
Top = 7365
Width = 1455
_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 Command1
Height = 315
Left = 135
TabIndex = 18
Top = 6960
Width = 1455
_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 cmdSoftPwd
Height = 315
Left = 1860
TabIndex = 17
Top = 7800
Width = 1455
_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 cmdDBasePwd
Height = 315
Left = 1845
TabIndex = 16
Top = 6960
Width = 1455
_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.TextBox Text1
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
Height = 315
Left = 3600
TabIndex = 15
Top = 6990
Width = 2160
End
Begin BNCtrlGroup.BNButton cmdTableStruct
Height = 315
Index = 0
Left = 3615
TabIndex = 14
Top = 7455
Width = 2130
_ExtentX = 0
_ExtentY = 0
Caption = "查看表结构VB说明"
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 cmdCreateMenuStr
Height = 345
Index = 1
Left = 10425
TabIndex = 13
Top = 600
Width = 1695
_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 cmdListPics
Height = 345
Left = 10425
TabIndex = 12
Top = 6210
Width = 1695
_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 cmdRestore
Height = 345
Left = 10620
TabIndex = 11
Top = 5700
Width = 1695
_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.ProgressBar ProgressBar1
Align = 2 'Align Bottom
Height = 195
Left = 0
TabIndex = 10
Top = 8295
Width = 12525
_ExtentX = 22093
_ExtentY = 344
_Version = 393216
Appearance = 0
End
Begin BNCtrlGroup.BNButton cmdBackupAll
Height = 345
Left = 10425
TabIndex = 9
Top = 4665
Width = 1695
_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 cmdSort
Height = 345
Left = 10425
TabIndex = 8
Top = 4140
Width = 1695
_ExtentX = 0
_ExtentY = 0
Caption = "重排A0100"
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 Command2
Height = 345
Left = 10605
TabIndex = 7
Top = 3135
Width = 1695
_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 cmdAddField
Height = 345
Left = 10425
TabIndex = 6
Top = 3630
Width = 1695
_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 cmdGetDBCode
Height = 345
Left = 10425
TabIndex = 5
Top = 1635
Width = 1695
_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 cmdGetMenu
Height = 345
Left = 10425
TabIndex = 4
Top = 1125
Width = 1695
_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 cmdCopy
Height = 345
Left = 10425
TabIndex = 3
Top = 5175
Width = 1695
_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 CancelButton
Height = 345
Left = 10425
TabIndex = 1
Top = 6735
Width = 1695
_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 cmdCreateMenuStr
Height = 345
Index = 0
Left = 10440
TabIndex = 0
Top = 90
Width = 1695
_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.TextBox txtTest
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
Height = 6765
Left = 90
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 2
Top = 90
Width = 10230
End
End
Attribute VB_Name = "frmInnerTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub CancelButton_Click()
Unload Me
End Sub
Private Sub cmdAddField_Click()
gclsCommon.CBNAddFieldDesc True, True
End Sub
Private Sub cmdBackupAll_Click()
Dim sTables() As String
Dim sTablesList As String
Dim i As Integer
sTables = gclsDBFunc.dbTableDefs(, , True, gDBRecordConn)
For i = 1 To UBound(sTables)
If Left(sTables(i), 2) = "A0" Or sTables(i) = "T0015S001" Then
sTablesList = sTablesList & sTables(i) & 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
End If
Me.Show
End Sub
Private Sub cmdCopy_Click()
Clipboard.Clear
Clipboard.SetText txtTest.Text
If Len(Clipboard.GetText) > 0 Then
MsgBox "Copy OK"
End If
End Sub
Private Sub cmdCreateMenuStr_Click(Index As Integer)
If Index = 0 Then
txtTest = gclsCommon.CBNGetDBMenuString(MENU_FIELDS, frmMainMenu)
Else
txtTest = gclsCommon.CBNGetDBMenuString(MENU_FIELDS)
End If
End Sub
Private Sub cmdDBasePwd_Click()
Text1 = gTAppLicInfo.SoftDBPasswd
End Sub
Private Sub cmdGetDBase_Click()
Dim sFileName As String
Dim sConnect As String
Dim sVer As String
Dim sPwd As String
Dim oConnect As New ADODB.Connection
Dim sTbls() As String
Dim TField() As FieldRec
Dim eDAODataTypeEnum As DAODataTypeEnum
Dim i As Integer
Dim j As Integer
sFileName = gclsInclude.MyGetFileName(True, "mdb (*.mdb)|*.mdb", "MDB", , "请选择数据库文件", Me.hwnd)
If sFileName = "" Then Exit Sub
sConnect = gclsCommon.CBNGetAccessConnect(sFileName, sVer, sPwd, False)
oConnect.Open sConnect
sTbls = gclsDBFunc.dbTableDefs(, , True, oConnect)
sFileName = ""
For i = LBound(sTbls) To UBound(sTbls)
TField = gclsDBFunc.dbFields(sTbls(i), oConnect)
sFileName = sFileName & "Case " & Chr(34) & sTbls(i) & Chr(34) & vbCrLf
For j = LBound(TField) To UBound(TField)
sFileName = sFileName & " .dbCreateFieldItem " & _
Chr(34) & Chr(34) & ", " & _
Chr(34) & TField(j).FieldName & _
Chr(34) & ","
eDAODataTypeEnum = gclsDBFunc.dbAdo2DaoType(TField(j).FieldType)
sVer = ""
sPwd = gclsDBFunc.dbGetDAODesc(eDAODataTypeEnum)
If eDAODataTypeEnum = edbLong Then
sPwd = ""
ElseIf eDAODataTypeEnum = edbText Then
If TField(j).FieldSize <> 20 Then sVer = "," & TField(j).FieldSize
End If
sFileName = sFileName & sPwd & sVer & vbCrLf
Next j
sFileName = sFileName & vbCrLf
Next i
txtTest = sFileName
End Sub
Private Sub cmdGetMenu_Click()
' txtTest = gclsCommon.CBNGetMenuItem(frmMainMenu)'获取主菜单
gclsCommon.CBNCreateDBMenuEx MENU_FIELDS, GetMenuStr
MsgBox "OK"
End Sub
Private Sub cmdGetDBCode_Click()
If Text1 = "" Then Exit Sub
txtTest = gclsCommon.CBNGetCreateRecord(Text1)
End Sub
Private Sub cmdSoftPwd_Click()
Text1 = gTAppLicInfo.SoftPassword
End Sub
Private Sub cmdSort_Click()
Dim l As Long
Dim sOld As String
Dim sNew As String
Dim adoTempRS As New ADODB.Recordset
adoTempRS.Open "SELECT ID,A0100,A0101,A0107,A0111,A0177,A0189,A0195,A0197,A0199,B0110,E0122,W1119,W0075,W0076 FROM A001A001 ORDER BY A0189", gDBRecordConn, adOpenStatic, adLockOptimistic
adoTempRS.MoveFirst
ProgressBar1.Visible = True
ProgressBar1.Max = adoTempRS.RecordCount
Do While Not adoTempRS.EOF
sOld = adoTempRS!A0100
l = l + 1
ProgressBar1.Value = l
sNew = l
adoTempRS!A0100 = sNew
adoTempRS.Update
gclsCommon.CBNModifyBatch gDBRecordConn, "A0100", sNew, sOld, "A001A001"
adoTempRS.MoveNext
DoEvents
Loop
ProgressBar1.Visible = False
End Sub
Private Sub cmdTableStruct_Click(Index As Integer)
If Index = 0 Then
txtTest = gclsCommon.CBNGetTblStructNote(Text1, 4, True, , , True)
Else
txtTest = gclsCommon.CBNGetTblStructNote(Text1, 2, True, gclsCommon.CBNCSql("A0189 = '10002' AND E6600 = #" & gclsCommon.CBNGetStandDate(#10/9/2002#) & "#"))
End If
End Sub
Private Sub Command1_Click()
Dim sTables() As String
Dim i As Integer
Dim iMaxLen As Integer
sTables = GetAllTables
For i = 0 To UBound(sTables)
If Len(sTables(i)) > iMaxLen Then iMaxLen = Len(sTables(i))
Next i
gclsInclude.MyRemoveBlank sTables
gclsInclude.MyQuickSort sTables, 0, UBound(sTables)
txtTest = ""
txtTest = " Dim sTables(" & UBound(sTables) & ") As String" & vbCrLf & vbCrLf & " "
For i = 0 To UBound(sTables)
txtTest = txtTest & "sTables(" & i & ") = " & Chr(34) & sTables(i) & Chr(34) & _
String(iMaxLen + 7 - Len(CStr(i)) - Len(sTables(i)), " ") & "'" & _
gclsCommon.CBNGetTableDesc(sTables(i)) & vbCrLf & " "
Next i
txtTest = txtTest & vbCrLf & " GetAllTables = sTables"
End Sub
Private Sub cmdGetAllIndexes_Click()
Dim sIndexes() As String
Dim sTbls() As String
Dim i As Integer
Dim j As Integer
Dim iMaxLen As Integer
Dim bFlag As Boolean
sIndexes = GetAllIndexes
sTbls = GetAllTables
For i = 0 To UBound(sIndexes)
bFlag = False
For j = 0 To UBound(sTbls)
If InStr(1, sIndexes(i), sTbls(j)) Then
bFlag = True
Exit For
End If
Next j
If Not bFlag Then
sIndexes(i) = ""
End If
Next i
For i = 0 To UBound(sIndexes)
If UCase(Left(sIndexes(i), 3)) = "PK_" Then sIndexes(i) = Mid(sIndexes(i), 4) & " _" & Left(sIndexes(i), 2)
Next i
gclsInclude.MyRemoveBlank sIndexes
gclsInclude.MyQuickSort sIndexes, 0, UBound(sIndexes)
For i = 0 To UBound(sIndexes)
If UCase(Right(sIndexes(i), 4)) = " _PK" Then sIndexes(i) = Right(sIndexes(i), 2) & "_" & Left(sIndexes(i), Len(sIndexes(i)) - 4)
Next i
txtTest = ""
txtTest = " Dim sIndexes(" & UBound(sIndexes) & ") As String" & vbCrLf & vbCrLf & " "
For i = 0 To UBound(sIndexes)
txtTest = txtTest & "sIndexes(" & i & ") = " & Chr(34) & sIndexes(i) & Chr(34) & vbCrLf & " "
Next i
txtTest = txtTest & vbCrLf & " GetAllIndexes = sIndexes"
End Sub
Private Sub Command4_Click()
Dim sViews() As String
Dim sTbls() As String
Dim sQueryTbls() As String
Dim bIndex() As Boolean
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim bTemp As Boolean
Dim iMaxLen As Integer
sViews = GetAllViews
ReDim bIndex(UBound(sViews))
sTbls = GetAllTables
For i = 0 To UBound(sViews)
If sViews(i) <> "" Then
sQueryTbls = GetTblsInQuery(sViews(i))
If sQueryTbls(0) = "" Then
bIndex(i) = True
MsgBox "查询" & sViews(i) & "中未包含数据表!"
Else
For j = 0 To UBound(sQueryTbls)
bTemp = False
For k = 0 To UBound(sTbls)
If UCase(sQueryTbls(j)) = UCase(sTbls(k)) Then
bTemp = True
Exit For
End If
Next k
If Not bTemp Then
bIndex(i) = True
Exit For
End If
Next j
If Len(sViews(i)) > iMaxLen Then iMaxLen = Len(sViews(i))
End If
End If
Next i
gclsInclude.MyRemoveDupes sViews
gclsInclude.MyRemoveBlank sViews
gclsInclude.MyQuickSort sViews, 0, UBound(sViews)
txtTest = ""
txtTest = " Dim sViews(" & UBound(sViews) & ") As String" & vbCrLf & vbCrLf & " "
For i = 0 To UBound(sViews)
txtTest = txtTest & IIf(bIndex(i), "'", "") & "sViews(" & i & ") = " & Chr(34) & sViews(i) & Chr(34) & vbCrLf & " "
Next i
txtTest = txtTest & vbCrLf & " GetAllViews = sViews"
End Sub
Private Sub Form_Load()
txtTest = ""
End Sub
Private Sub cmdListPics_Click()
gclsCommon.CBNShowInnerPicture txtTest.Width * 1.3, 11000
End Sub