www.pudn.com > VB-KAOQINXITONG.zip > modPubDBMaker.bas
Attribute VB_Name = "modDBMaker"
'Type常数
Option Explicit
'考勤-66,巡更-30,停车-40
Private madoFillRS As ADODB.Recordset
'以下是关于表 T0114S001(系统菜单) 中的字段定义
'W1110: 菜单操作权限 W1124: 按纽是否可见 W1130: 菜单编号 W1159: 菜单工具条
'W1121: 菜单标题 W1125: 菜单层次 W1131: 图形关键字
'W1122: 菜单缺省权限 W1126: 菜单名 W1132: 系统有效菜单
'W1123: 按纽标题 W1127: 是否可执行项 W1158: 菜单应用类别
Public Const MENU_FIELDS As String = "W1110,W1122,W1124,W0090,W1121,W1123,W1126,W1127,W1131"
Public Function CreateRecords() As Boolean
10 On Error GoTo ErrLabel
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim sIndex() As String
Dim sStr As String
Dim lMaxID As Long
Dim sSplit1
Dim sSplit2
20 If gclsDBFunc.dbGetConnString(False) = "" Then
30 If (gDBRecordConn Is Nothing) Or (giUpdate > 0) Then
ConnectLabel:
40 Set gDBRecordConn = New ADODB.Connection
50 With gDBRecordConn
60 .CursorLocation = adUseClient
70 .Open gTAppLicInfo.SysDBRecordConn
80 End With
90 ElseIf gDBRecordConn.State = 0 Then
100 GoTo ConnectLabel
110 End If
120 Else
130 Set gDBRecordConn = gclsDBFunc.dbGetConnect(False)
140 End If
150 gclsCommon.CommonConnect = gDBRecordConn
' #If APPLICATION_TYPE = 1 Then '考勤
' #ElseIf APPLICATION_TYPE = 2 Then '门禁
' #ElseIf APPLICATION_TYPE = 3 Then '巡更
' #ElseIf APPLICATION_TYPE = 4 Then '停车
' #ElseIf APPLICATION_TYPE = 5 Then '售饭
' #ElseIf APPLICATION_TYPE = 6 Then '消费
' #ElseIf APPLICATION_TYPE = 7 Then '发卡
' #ElseIf APPLICATION_TYPE = 8 Then '自动采集
' #ElseIf APPLICATION_TYPE = 10 Then '工资系统
' #ElseIf APPLICATION_TYPE = 11 Then '衡重
' #ElseIf APPLICATION_TYPE = 12 Then 'VMS
' #ElseIf APPLICATION_TYPE = 13 Then '超限收费
' #End If
Dim adoTempRS As ADODB.Recordset
160 Set adoTempRS = New ADODB.Recordset
170 With adoTempRS
180 .Open "SELECT W1101,W1102 FROM T0101S001", gDBRecordConn, adOpenStatic, adLockOptimistic
'通用设置01
190 .Filter = "W1101 = 'W010A'": If .EOF Then .AddNew: !W1101 = "W010A": !W1102 = gclsCommon.CBNGetCommPwd(gTAppLicInfo.FileEncrypt) '通讯密码
200 .Filter = "W1101 = 'W010B'": If .EOF Then .AddNew: !W1101 = "W010B": !W1102 = 10 'glMsgAdd
210 .Filter = "W1101 = 'W010C'": If .EOF Then .AddNew: !W1101 = "W010C": !W1102 = gTAppLicInfo.SoftOwnerName '用户公司名
'其他设置03
220 .Filter = "W1101 = 'W030A'": If .EOF Then .AddNew: !W1101 = "W030A": !W1102 = "8" '人员编号长度
230 .Filter = "W1101 = 'W030B'": If .EOF Then .AddNew: !W1101 = "W030B": !W1102 = "4" '部门最小编码长度
240 .Filter = "W1101 = 'W030C'": If .EOF Then .AddNew: !W1101 = "W030C": !W1102 = "0" '部门是否层次编码
250 .Filter = "W1101 = 'W" & gTAppLicInfo.SoftNumber & "BA'": If .EOF Then .AddNew: !W1101 = "W" & gTAppLicInfo.SoftNumber & "BA": !W1102 = gTAppLicInfo.SoftLevel '软件版本级别
260 .Filter = "W1101 = 'W" & gTAppLicInfo.SoftNumber & "BB'": If .EOF Then .AddNew: !W1101 = "W" & gTAppLicInfo.SoftNumber & "BB": !W1102 = "" '安装程序路径
270 .Filter = "W1101 = 'W" & gTAppLicInfo.SoftNumber & "BC'": If .EOF Then .AddNew: !W1101 = "W" & gTAppLicInfo.SoftNumber & "BC": !W1102 = gTAppLicInfo.SoftVersion '软件版本
280 .Filter = "W1101 = 'W" & gTAppLicInfo.SoftNumber & "BD'": If .EOF Then .AddNew: !W1101 = "W" & gTAppLicInfo.SoftNumber & "BD": !W1102 = DFNLoadResString(112) '运行次数
290 .Filter = "W1101 = 'W" & gTAppLicInfo.SoftNumber & "BE'": If .EOF Then .AddNew: !W1101 = "W" & gTAppLicInfo.SoftNumber & "BE": !W1102 = #1/1/2001# '升级的开始日期
300 .Filter = "W1101 = 'W" & gTAppLicInfo.SoftNumber & "BG'": If .EOF Then .AddNew: !W1101 = "W" & gTAppLicInfo.SoftNumber & "BG": !W1102 = IIf(gTAppLicInfo.SysLockCal, 1, 0) '计算锁定
310 .Filter = "W1101 = 'W" & gTAppLicInfo.SoftNumber & "BH'": If .EOF Then .AddNew: !W1101 = "W" & gTAppLicInfo.SoftNumber & "BH": !W1102 = "西格数据科技有限公司版权所有" '安装提示
#If APPLICATION_TYPE = 4 Then '停车40
'停车设置40
320 .Filter = "W1101 = 'W400A'": If .EOF Then .AddNew: !W1101 = "W400A": !W1102 = "60" '收费粒度
330 .Filter = "W1101 = 'W400B'": If .EOF Then .AddNew: !W1101 = "W400B": !W1102 = "5" '时租收费
340 .Filter = "W1101 = 'W400C'": If .EOF Then .AddNew: !W1101 = "W400C": !W1102 = "5" '包租收费
350 .Filter = "W1101 = 'W400D'": If .EOF Then .AddNew: !W1101 = "W400D": !W1102 = "0" '减免时间
360 .Filter = "W1101 = 'W400E'": If .EOF Then .AddNew: !W1101 = "W400E": !W1102 = "0" '减免比例
370 .Filter = "W1101 = 'W400F'": If .EOF Then .AddNew: !W1101 = "W400F": !W1102 = "0" '允许透支
380 .Filter = "W1101 = 'W400G'": If .EOF Then .AddNew: !W1101 = "W400G": !W1102 = "30" '免费时间
#ElseIf APPLICATION_TYPE = 3 Then '巡更30
390 .Filter = "W1101 = 'W300A'": If .EOF Then .AddNew: !W1101 = "W300A": !W1102 = glErrPatrol
#ElseIf APPLICATION_TYPE = 2 Then '门禁50
'门禁设置50
#ElseIf APPLICATION_TYPE = 1 Then '考勤66
'考勤设置66
400 .Filter = "W1101 = 'W660A'": If .EOF Then .AddNew: !W1101 = "W660A": !W1102 = IIf(gTAttendCtl.Need30Rnd, 1, 0) '对实际的打卡数据按30分钟进行修正
410 .Filter = "W1101 = 'W660B'": If .EOF Then .AddNew: !W1101 = "W660B": !W1102 = "1" '考勤开始日期
420 .Filter = "W1101 = 'W660C'": If .EOF Then .AddNew: !W1101 = "W660C": !W1102 = "1" '旷工是否计入日工时
430 .Filter = "W1101 = 'W660D'": If .EOF Then .AddNew: !W1101 = "W660D": !W1102 = IIf(gTAttendCtl.HaveLate, 1, 0) '迟到早退是否计入日工时
440 .Filter = "W1101 = 'W660E'": If .EOF Then .AddNew: !W1101 = "W660E": !W1102 = "0.25" '早班统计时刻
450 .Filter = "W1101 = 'W660F'": If .EOF Then .AddNew: !W1101 = "W660F": !W1102 = ".9583333333" '夜班统计时刻
460 .Filter = "W1101 = 'W660G'": If .EOF Then .AddNew: !W1101 = "W660G": !W1102 = IIf(gTAttendCtl.ELStandard, 1, 0) '迟到早退标准
470 .Filter = "W1101 = 'W660H'": If .EOF Then .AddNew: !W1101 = "W660H": !W1102 = "1" '法定假加班与平日等同否
480 .Filter = "W1101 = 'W660I'": If .EOF Then .AddNew: !W1101 = "W660I": !W1102 = "1" '是否只使用一个打卡范围
490 .Filter = "W1101 = 'W660J'": If .EOF Then .AddNew: !W1101 = "W660J": !W1102 = "0" '额定加班的工时
500 .Filter = "W1101 = 'W660K'": If .EOF Then .AddNew: !W1101 = "W660K": !W1102 = ".75" '休日的夜班时刻
510 .Filter = "W1101 = 'W660L'": If .EOF Then .AddNew: !W1101 = "W660L": !W1102 = IIf(gTAttendCtl.FeastRestToDay, 1, 0) '节假日及休日是否计入日工时
520 .Filter = "W1101 = 'W660M'": If .EOF Then .AddNew: !W1101 = "W660M": !W1102 = IIf(gTAttendCtl.HaveAdd, 1, 0) '加班是否计入日工时
530 .Filter = "W1101 = 'W660N'": If .EOF Then .AddNew: !W1101 = "W660N": !W1102 = IIf(gTAttendCtl.NeedAddSheet, 1, 0) '
540 .Filter = "W1101 = 'W660O'": If .EOF Then .AddNew: !W1101 = "W660O": !W1102 = IIf(gTAttendCtl.MustOver8, 1, 0)
'特卡工时，如果每天的上班工时超过该工时时，则将超过的工时设置为特卡工时，当值为0时，将不起作用
'当打卡界于该工时之中时，系统自动将该时刻补上特卡的上班和下班卡。
'规定：在T0109A001中，当W1113=1或当W1113=3时为计算机自动加入的特卡，但当W1113=1时是需要显示的；当W1113=3时，表示被设置为特卡，不需要显示。
'当W1113=4时，为原始的打卡记录，但被标记为特卡，不显示。
550 .Filter = "W1101 = 'W660P'": If .EOF Then .AddNew: !W1101 = "W660P": !W1102 = IIf(gTAttendCtl.AttRptGroup, 1, 0) '报表按人员分页打印
560 .Filter = "W1101 = 'W660Q'": If .EOF Then .AddNew: !W1101 = "W660Q": !W1102 = "1" '为特卡显示，如果为1，则当显示原始的打卡数据时将不显示标记为特卡的打卡数据
570 .Filter = "W1101 = 'W660R'": If .EOF Then .AddNew: !W1101 = "W660R": !W1102 = "0" '加班是否记缺勤
'考勤其它设置66
580 .Filter = "W1101 = 'W66BF'": If .EOF Then .AddNew: !W1101 = "W66BF": !W1102 = IIf(gTAttendCtl.DistinctCard, 1, 0) '是否合并相同的打卡数据
#End If
'其他设置99
590 .Filter = "W1101 = 'W990A'": If .EOF Then .AddNew: !W1101 = "W990A": !W1102 = gclsInclude.MyGetFirstDay(gclsCommon.CBNGetNow) '统计起始时间
600 .Filter = "W1101 = 'W990B'": If .EOF Then .AddNew: !W1101 = "W990B": !W1102 = gclsInclude.MyDateOf(gclsCommon.CBNGetNow) '统计终止时间
610 .Update
620 .Filter = 0
630 .Close
640 End With
650 CreateAppRecords
660 Set madoFillRS = New ADODB.Recordset
670 madoFillRS.Open "SELECT W1161,W0094,W0078 FROM T0014S001", gDBRecordConn, adOpenStatic, adLockOptimistic
680 n = 6
690 If madoFillRS.RecordCount < n Then
700 ReDim sIndex(1 To madoFillRS.Fields.Count, 1 To n)
710 sIndex(1, 1) = "A001": sIndex(2, 1) = "在职人员"
720 sIndex(1, 2) = "A002": sIndex(2, 2) = "离退人员"
730 sIndex(1, 3) = "C001": sIndex(2, 3) = "机关单位"
740 sIndex(1, 4) = "C002": sIndex(2, 4) = "事业单位"
750 sIndex(1, 5) = "C004": sIndex(2, 5) = "企业单位"
760 sIndex(1, n) = "P001": sIndex(2, n) = "在编车辆"
770 For i = 1 To n
780 sIndex(3, i) = 1
790 Next i
800 gclsCommon.CBNFillTable madoFillRS, sIndex
810 End If
820 madoFillRS.Close
830 Set madoFillRS = New ADODB.Recordset
840 madoFillRS.Open "SELECT W1182,W1178,W1104 FROM T0006S001", gDBRecordConn, adOpenStatic, adLockOptimistic
850 n = 1
860 If madoFillRS.RecordCount < n Then
870 ReDim sIndex(1 To madoFillRS.Fields.Count, 1 To n)
880 sIndex(1, 1) = "SA": sIndex(2, 1) = 1
890 gclsCommon.CBNFillTable madoFillRS, sIndex
900 End If
910 madoFillRS.Close
920 Set madoFillRS = New ADODB.Recordset
930 madoFillRS.Open "SELECT W1105,W1106,W1100 FROM T0110S001", gDBRecordConn, adOpenStatic, adLockOptimistic
940 If madoFillRS.RecordCount <= 0 Then
950 j = 0
960 For i = 1 To 500
sStr = gclsInclude.MyGetOETDef(i)
970 If (sStr = NO_DEFINE) Or (sStr = "") Then
980 j = i - 1
990 Exit For
1000 End If
1010 Next i
1020 If j > 0 Then
1030 ReDim sIndex(1 To 3, 1 To j)
1040 For i = 1 To j
1050 sIndex(1, i) = i
1060 sIndex(2, i) = gclsInclude.MyGetOETDef(i)
1070 sIndex(3, i) = 0
1080 Next i
1090 gclsCommon.CBNFillTable madoFillRS, sIndex
1100 End If
1110 End If
1120 madoFillRS.Close
1122 Set madoFillRS = New ADODB.Recordset
1124 madoFillRS.Open "SELECT ID,W1158,W1162,W1163 FROM T0103S001 WHERE W1158 =" & giAppUser, gDBRecordConn, adOpenStatic, adLockOptimistic
1126 If madoFillRS.RecordCount <= 0 Then
1128 madoFillRS.AddNew
1130 End If
With madoFillRS
!W1158 = giAppUser
!W1162 = GetMyEvents
!W1163 = !W1162 '开始的时候，屏蔽所有信号
.Update
End With
1132 madoFillRS.Close
1138 Set madoFillRS = Nothing
1140 With gclsCommon
1150 .CBNAddFieldDesc True, True
1160 .CBNAddTableDesc True, True
1170 gbFirstLogin = True
1180 .CBNCreateDBMenuEx MENU_FIELDS, GetMenuStr
1190 gbFirstLogin = False
1200 End With
CreateRecords = True
1210 Exit Function
ErrLabel:
gclsCommon.CBNSaveLogFile "CreateRecords:" & Err.Description & " Pos:" & Erl, True
If Erl = 70 Then
If Err = -2147024769 Then '自动化错误，可能表示ADODB的版本有问题。
Exit Function
End If
End If
End Function
Public Function CreateBackupDB(PathFileName As String, fsPasswd As String) As Boolean
' 置鼠标忙标志
Screen.MousePointer = vbHourglass
Dim sDatebase As String
' fsPasswd = "xx"
With gclsDBFunc
If .dbCreateDBItem(PathFileName, fsPasswd) Then
.dbCreateTableItem "BackupOle"
.dbCreateFieldItem "", "ID"
.dbCreateFieldItem "", "OLE1", edbLongBinary
.dbCreateTableOver "BackupOle"
.dbCreateIndexItem "BackupOle"
CreateSysTable "T0109A001"
.dbCloseDBItem
Else
MsgBox "建立备份数据库：" & PathFileName & "失败!", vbCritical
End If
End With
Screen.MousePointer = vbDefault
End Function
Public Function CreateDB(ByVal PathFileName As String, ByVal fsPasswd As String) As Boolean
' 置鼠标忙标志
Screen.MousePointer = vbHourglass
Dim sNewDBase As String
Dim sReWriteTbl As String
Dim sSplit
Dim i As Integer
Dim bError As Boolean
On Error GoTo ExitFunction
#If APPLICATION_TYPE = 1 Then '考勤
gTHoliSystem = gclsCommon.CBNGetHolidayInfo(True And (giUpdate > 0))
#End If
With gclsCommon
If giUpdate = 0 Or giUpdate = 3 Or giUpdate = 4 Then
If gclsDBFunc.dbCreateDBItem(PathFileName, fsPasswd, sNewDBase, True) = False Then GoTo ExitFunction
Else
gclsDBFunc.dbOpenDateBase PathFileName, ";pwd=" & fsPasswd
If funcGetSystemData("Update", "0") = 2 Then
.CommonAppInfo = gTAppLicInfo
.CBNDataUpdate gTAppLicInfo.FilePathApp & "Update.upt", gTAppLicInfo.SysDBRecordConn
CreateDB = True
Exit Function
End If
sReWriteTbl = funcGetSystemData("ReWriteTbl", "")
If sReWriteTbl <> "" Then
sSplit = Split(sReWriteTbl, ",")
For i = 0 To UBound(sSplit)
If UCase(sSplit(i)) <> UCase("T0111S001") Then
If gclsDBFunc.dbTableExists(sSplit(i), gDBRecordConn) Then
.CBNSplashSetNotes "删除表" & sSplit(i)
If gclsDBFunc.dbRemoveTableItem(sSplit(i)) Then
.CBNSaveLogFile "删除表" & sSplit(i)
.CBNSaveEvents OET_DEL_TABLE, sSplit(i), "成功"
Else
.CBNSaveEvents OET_DEL_TABLE, sSplit(i), "失败"
End If
End If
End If
Next i
End If
End If
bError = True
.CBNSplashSetNotes "建立数据库及基本结构"
If Not CreateTables Then GoTo ExitFunction
.CBNSplashSetNotes "建立数据库索引"
bError = bError And CreateIndexes
.CBNSplashSetNotes "建立数据库查询"
bError = bError And CreateQueries
gclsDBFunc.dbCloseDBItem
If sNewDBase = "" Then sNewDBase = PathFileName
.CBNSplashSetNotes "建立数据库基本记录"
bError = bError And CreateRecords
.CBNSplashSetNotes "设置数据库权限"
SetAllTableRight 3
.CBNSplashSetNotes "建立代码集"
CreateCollect True
CreateDB = bError
ExitFunction:
.CBNSplashSetNotes ""
End With
Screen.MousePointer = vbDefault
End Function
Public Function CreateSQLDBase(Optional PathFileName As String, _
Optional ByVal fsPasswd As String) As Boolean
On Error GoTo ErrLabel
Dim sTemp As String
Dim sNewDBase As String
Dim sNewDBPath As String
Dim sReWriteTbl As String
Dim i As Integer
Dim sSplit
#If APPLICATION_TYPE = 1 Then '考勤
gTHoliSystem = gclsCommon.CBNGetHolidayInfo(True And (giUpdate > 0))
#End If
'对SQL SERVER 进行改造时,不需要建立联接表
If giUpdate = 4 Then
If MsgBox("正准备建立新的数据库,继续吗?" & vbCrLf & _
"注意:此操作将删除现有的名字为" & "数据库,在进行之前,请先备份数据!", vbOKCancel + vbQuestion + vbDefaultButton2) = vbCancel Then Exit Function
' If InStr(PathFileName, " ") Then
'ReSelectLabel:
' MsgBox "当前默认的数据库路径" & Chr(34) & PathFileName & Chr(34) & "中不能包含空格，请重新选定数据库路径", vbCritical
' sNewDBPath = gclsInclude.MyRegGetStringValue("HKEY_LOCAL_MACHINE\Software\Microsoft\MSSQLServer\Setup", "SQLPath")
' If sNewDBPath <> "" Then sNewDBPath = gclsInclude.MyAddBackslash(sNewDBPath) & "Data\"
' PathFileName = gclsInclude.MyAddBackslash(gclsInclude.MyGetFilePath("选定数据库路径", sNewDBPath)) & gTAppLicInfo.SoftSQLDBase & ".mdf"
' If InStr(PathFileName, " ") Then GoTo ReSelectLabel
' If PathFileName = gTAppLicInfo.SoftSQLDBase & ".mdf" Then Exit Function
' End If
sNewDBPath = gclsInclude.MyFilePath(PathFileName)
If Not gclsInclude.MyPathExists(sNewDBPath) Then gclsInclude.MyMkDir sNewDBPath
If gclsDBFunc.dbCreateDBItem(PathFileName, fsPasswd, sNewDBase, True, True, gTAppLicInfo.SysLoginUser, gTAppLicInfo.SoftSQLServer, gTAppLicInfo.SoftSQLDBase) = False Then
Exit Function
End If
End If
' 置鼠标忙标志
Screen.MousePointer = vbHourglass
gclsDBFunc.dbSetConnect gTAppLicInfo.SysDBRecordConn, True
If giUpdate > 0 Then
'当Update=2时,根据文件 Update.upt 中说明的字段进行升级
If funcGetSystemData("Update", "0") = 2 Then
gclsCommon.CommonAppInfo = gTAppLicInfo
sTemp = gTAppLicInfo.FilePathApp & "Update.upt"
If Not gclsInclude.MyFileExists(sTemp) Then
sTemp = gclsInclude.MyGetFileName(True, "upt (*.upt)|*.upt", "upt", , "请选择数据库升级文件")
End If
If sTemp <> "" Then
gclsCommon.CBNDataUpdate sTemp, gTAppLicInfo.SysDBRecordConn
CreateSQLDBase = True
Else
CreateSQLDBase = False
End If
Exit Function
End If
If giUpdate <> 4 Then
sReWriteTbl = funcGetSystemData("ReWriteTbl", "")
If sReWriteTbl <> "" Then
sSplit = Split(sReWriteTbl, ",")
For i = 0 To UBound(sSplit)
If UCase(sSplit(i)) <> UCase("T0111S001") Then
If gclsDBFunc.dbTableExists(sSplit(i), gDBRecordConn) Then
gclsCommon.CBNSplashSetNotes "删除表" & sSplit(i)
If gclsDBFunc.dbRemoveTableItem(sSplit(i)) Then
gclsCommon.CBNSaveLogFile "删除表" & sSplit(i)
gclsCommon.CBNSaveEvents OET_DEL_TABLE, "成功" & ":" & sSplit(i)
Else
gclsCommon.CBNSaveEvents OET_DEL_TABLE, "失败" & ":" & sSplit(i)
End If
End If
End If
Next i
End If
End If
Else
gclsCommon.CommonConnect = gDBRecordConn
End If
gclsCommon.CBNSplashSetNotes "建立数据库及基本结构"
CreateTables
If giUpdate = 4 Then GoTo CreateIndexesLabel
If MsgBox("重新建立索引吗?此操作将花费较长时间,请耐心等待", vbInformation + vbOKCancel) = vbOK Then
CreateIndexesLabel:
gclsCommon.CBNSplashSetNotes "建立数据库索引"
CreateIndexes
End If
gclsCommon.CBNSplashSetNotes "建立数据库查询"
CreateQueries
gclsCommon.CBNSplashSetNotes "设置数据库权限"
SetAllTableRight 3
gclsDBFunc.dbCloseConnect True
gclsDBFunc.dbCloseConnect False
If giUpdate = 4 Then GoTo CreateRecordsLabel
If MsgBox("建立数据库基本记录吗?", vbInformation + vbOKCancel) = vbOK Then
CreateRecordsLabel:
gclsCommon.CBNSplashSetNotes "建立数据库基本记录"
CreateRecords
End If
If giUpdate = 4 Then GoTo CreateCollectLabel
If MsgBox("建立新的代码集吗?此操作将花费较长时间,请耐心等待", vbInformation + vbOKCancel) = vbOK Then
CreateCollectLabel:
gclsCommon.CBNSplashSetNotes "建立代码集"
CreateCollect
End If
CreateSQLDBase = True
Screen.MousePointer = vbDefault
gclsCommon.CBNSplashSetNotes ""
Exit Function
ErrLabel:
gclsCommon.CBNSplashSetNotes ""
Screen.MousePointer = vbDefault
Resume Next
End Function
Private Function CreateTables() As Boolean
Dim i As Integer
Dim sTblName() As String
On Error GoTo ErrLabel
sTblName = GetAllTables
For i = 0 To UBound(sTblName)
' If sTblName(i) = "V5502A001" Then Stop
CreateSysTable sTblName(i)
Next i
CreateTables = True
ErrLabel:
End Function
Private Function CreateSysTable(ByVal fsTblName As String) As Boolean
Dim i As Integer
If fsTblName = "" Then Exit Function
With gclsDBFunc
' If .dbTableExists(fsTblName) Then Exit Sub
.dbCreateTableItem fsTblName
'如果不指明edbText的长度,缺省为20
#If Not IS_RUN Then
DebugErr fsTblName & "_gclsDBFunc.dbCreateTableItem"
#End If
Select Case fsTblName
Case "A001A001" '人员基本情况子集
.dbCreateFieldItem "", "ID", , , , , , False, True '人员索引
.dbCreateFieldItem "", "A0100", edbText, 30, , , , False, True '人员内部编号
.dbCreateFieldItem "", "A0101", edbText, 30 '人员姓名
.dbCreateFieldItem "", "A0107", edbText, 1 '性别
.dbCreateFieldItem "", "A0111", edbDate '出生日期
.dbCreateFieldItem "", "A0177", edbText, 18 '身份证号
.dbCreateFieldItem "", "A0188", edbText, 1 '是否离职
.dbCreateFieldItem "", "A0189", edbText '人员编号
.dbCreateFieldItem "", "A0191", edbText, 1 '临时卡标志
.dbCreateFieldItem "", "A0195", edbText, 1 '是否发卡
.dbCreateFieldItem "", "A0197", edbText, 1 '是否黑名单
.dbCreateFieldItem "", "A0199", edbText, 20 '卡管理号
.dbCreateFieldItem "", "B0110", edbText, , , , , False, True '单位编号
.dbCreateFieldItem "", "E0122", edbText '部门编号
.dbCreateFieldItem "", "W0030", edbMemo '备注
.dbCreateFieldItem "", "W1119", edbText, 1 '是否选择
.dbCreateFieldItem "", "W4001", edbText '车号
.dbCreateFieldItem "", "W0075", edbText, 10, , "1000000000" '状态
.dbCreateFieldItem "", "W0076", edbText, 255 '状态2
'对其进行补充
CreateAppTable fsTblName
Case Else
If Not CreateAppTable(fsTblName) Then
gclsCommon.CBNBuiltFixTable fsTblName, gclsDBFunc
End If
End Select
#If Not IS_RUN Then
DebugErr fsTblName & "_gclsDBFunc.dbCreateFieldItem"
#End If
If Not gclsDBFunc.dbTableExists(fsTblName) Then
CreateSysTable = gclsDBFunc.dbCreateTableOver(fsTblName)
Else
CreateSysTable = True
End If
End With
' If Not CreateSysTable Then Err = -100000
#If Not IS_RUN Then
DebugErr fsTblName & "_gclsDBFunc.dbCreateTableOver"
#End If
End Function
Public Function GetQueriyItem(ByVal fsQryName As String) As String
Dim TotalOverHours As String
If fsQryName = "" Then Exit Function
GetQueriyItem = gclsCommon.CBNGetQueriyItem(fsQryName)
End Function
Private Sub CreateQuerieyItem(ByVal fsQryName As String)
Dim sSQL As String
If fsQryName = "" Then Exit Sub
With gclsDBFunc
If .dbQueryExists(fsQryName, , gTAppLicInfo.SoftNetwork) Then
.dbRemoveQueryItem fsQryName, gTAppLicInfo.SoftNetwork
End If
sSQL = gclsCommon.CBNCSql(GetQueriyItem(fsQryName))
If sSQL <> "" Then
If Not .dbCreateQueryItem(fsQryName, sSQL, gTAppLicInfo.SoftNetwork) Then _
gclsCommon.CBNSaveLogFile .dbGetLastError.Description
End If
End With
End Sub
Private Function CreateQueries() As Boolean
Dim i As Integer
Dim sViewName() As String
On Error GoTo ErrLabel
sViewName = GetAllViews
For i = 0 To UBound(sViewName)
CreateQuerieyItem sViewName(i)
Next i
CreateQueries = True
ErrLabel:
End Function
Private Function CreateIndexes() As Boolean
Dim i As Integer
Dim sIndexes() As String
Dim bFlag As Boolean
On Error GoTo ErrLabel
sIndexes = GetAllIndexes
For i = 0 To UBound(sIndexes)
If sIndexes(i) <> "" Then
bFlag = True
If giUpdate <> 4 Then
If InStr(sIndexes(i), "T0109A001") Or InStr(sIndexes(i), "T6621A001") Or InStr(sIndexes(i), "T0111S001") Then
If MsgBox("是否重建" & gclsCommon.CBNGetIndexDesc(sIndexes(i)) & "?这将花费较长的时间.", vbQuestion + vbOKCancel) = vbCancel Then
bFlag = False
End If
End If
End If
If bFlag Then
gclsCommon.CBNSplashSetNotes "正在重新建立" & gclsCommon.CBNGetIndexDesc(sIndexes(i))
DoEvents
'创建固定的索引，即系统内建的索引信息
If LoIsIndexInTbls(sIndexes(i)) Then
gclsCommon.CBNBuiltFixIndex sIndexes(i)
End If
End If
ElseIf gTAppLicInfo.SysDebugLevel Then
'MsgBox "No Value Index:" & i
End If
Next i
CreateIndexes = True
Exit Function
ErrLabel:
End Function
Private Function LoIsIndexInTbls(fsIndex As String) As Boolean
Dim sAllTables() As String
Dim i As Integer
sAllTables = GetAllTables
For i = LBound(sAllTables) To UBound(sAllTables)
If sAllTables(i) <> "" Then
If InStr(fsIndex, sAllTables(i)) Then
LoIsIndexInTbls = True
Exit Function
End If
End If
Next i
End Function
Private Sub CreateCollect(Optional ByVal fbDescOverlap As Boolean)
Dim sExplain As String
Dim lType As Long
Dim sCode As String
Dim sTbls() As String
With gclsCommon
If gclsDBFunc.dbGetConnString(False) = "" Then
If (gDBRecordConn Is Nothing) Or (giUpdate > 0) Then
ConnectLabel:
Set gDBRecordConn = New ADODB.Connection
With gDBRecordConn
.CursorLocation = adUseClient
.Open gTAppLicInfo.SysDBRecordConn
End With
ElseIf gDBRecordConn.State = 0 Then
GoTo ConnectLabel
End If
Else
Set gDBRecordConn = gclsDBFunc.dbGetConnect(False)
End If
.CommonConnect = gDBRecordConn
sTbls = GetAllTables
For lType = LBound(sTbls) To UBound(sTbls)
'将本系统使用过的标准表纳入系统之中
LoBuiltSetCollect sTbls(lType), _
.CBNGetTableDesc(sTbls(lType), _
, , , , , False), fbDescOverlap
Next
Set madoFillRS = Nothing
sCode = "AX"
If .CBNNewCodeCollect(gDBRecordConn, sCode, "性别(GB/T 2261-80)") Then
.CBNNewCodeItem gDBRecordConn, sCode, "0", NO_DEFINE
.CBNNewCodeItem gDBRecordConn, sCode, "1", "男"
.CBNNewCodeItem gDBRecordConn, sCode, "2", "女"
.CBNNewCodeItem gDBRecordConn, sCode, "9", "未说明"
End If
sCode = "CO"
If .CBNNewCodeCollect(gDBRecordConn, sCode, "公司") Then
.CBNNewCodeItem gDBRecordConn, sCode, "0", "公司1"
.CBNNewCodeItem gDBRecordConn, sCode, "1", "公司2"
End If
sCode = "UE"
If .CBNNewCodeCollect(gDBRecordConn, sCode, "是否(用于录入)") Then
.CBNNewCodeItem gDBRecordConn, sCode, "0", "否"
.CBNNewCodeItem gDBRecordConn, sCode, "1", "是"
End If
sCode = "UF"
If .CBNNewCodeCollect(gDBRecordConn, sCode, "加班类型") Then
.CBNNewCodeItem gDBRecordConn, sCode, "0", "无加班" ' 既无平日加班又无休日加班
.CBNNewCodeItem gDBRecordConn, sCode, "1", "加班类型1" ' 平日加班及休日加班全计薪,但只计算超出应上工时的部分计加班
.CBNNewCodeItem gDBRecordConn, sCode, "2", "加班类型2" ' 平日加班全计薪,休日加班全计薪
.CBNNewCodeItem gDBRecordConn, sCode, "3", "加班类型3" ' 无平日加班,休日加班全计薪
.CBNNewCodeItem gDBRecordConn, sCode, "4", "加班类型4" ' 无平日加班,休日加班全计补休
.CBNNewCodeItem gDBRecordConn, sCode, "5", "加班类型5" ' 平日加班全计薪,无休日加班
.CBNNewCodeItem gDBRecordConn, sCode, "6", "加班类型6" ' 平日加班全计薪,休日加班全部算补休
.CBNNewCodeItem gDBRecordConn, sCode, "7", "加班类型7" ' 平日加班全计薪,休日加班8小时内算补休,超过8小时的部分计薪
.CBNNewCodeItem gDBRecordConn, sCode, "8", "加班类型8" ' 平日加班和休日加班全计补休
.CBNNewCodeItem gDBRecordConn, sCode, "9", "加班类型9" ' 正班段加班算加班,加班段加班算补休
End If
sCode = "UG"
If .CBNNewCodeCollect(gDBRecordConn, sCode, "开锁类别") Then
.CBNNewCodeItem gDBRecordConn, sCode, "0", "指令开门" ' 使用计算机指令开启门禁
.CBNNewCodeItem gDBRecordConn, sCode, "1", "手动开门" ' 推开或强行开启门禁
.CBNNewCodeItem gDBRecordConn, sCode, "2", "IC卡开门" ' 使用IC卡开启门禁
End If
sCode = "UH"
If .CBNNewCodeCollect(gDBRecordConn, sCode, "车辆类别") Then
.CBNNewCodeItem gDBRecordConn, sCode, "0", NO_DEFINE
.CBNNewCodeItem gDBRecordConn, sCode, 1, "二吨加盖"
.CBNNewCodeItem gDBRecordConn, sCode, 2, "二吨平板"
.CBNNewCodeItem gDBRecordConn, sCode, 3, "二吨压缩"
.CBNNewCodeItem gDBRecordConn, sCode, 4, "二吨圆桶"
.CBNNewCodeItem gDBRecordConn, sCode, 5, "三吨拉臂"
.CBNNewCodeItem gDBRecordConn, sCode, 6, "三吨平板"
.CBNNewCodeItem gDBRecordConn, sCode, 7, "三吨压缩"
.CBNNewCodeItem gDBRecordConn, sCode, 8, "五吨加盖"
.CBNNewCodeItem gDBRecordConn, sCode, 9, "五吨拉臂"
.CBNNewCodeItem gDBRecordConn, sCode, 10, "五吨平板"
.CBNNewCodeItem gDBRecordConn, sCode, 11, "五吨压缩"
.CBNNewCodeItem gDBRecordConn, sCode, 12, "五吨圆桶"
.CBNNewCodeItem gDBRecordConn, sCode, 13, "五吨自卸"
.CBNNewCodeItem gDBRecordConn, sCode, 14, "七吨拉臂"
.CBNNewCodeItem gDBRecordConn, sCode, 15, "八吨加盖"
.CBNNewCodeItem gDBRecordConn, sCode, 16, "八吨拉臂"
.CBNNewCodeItem gDBRecordConn, sCode, 17, "八吨平板"
.CBNNewCodeItem gDBRecordConn, sCode, 18, "八吨压缩"
.CBNNewCodeItem gDBRecordConn, sCode, 19, "八吨自卸"
.CBNNewCodeItem gDBRecordConn, sCode, 20, "十五吨平板"
.CBNNewCodeItem gDBRecordConn, sCode, 21, "十五吨压缩"
.CBNNewCodeItem gDBRecordConn, sCode, 22, "二十吨平板"
End If
sCode = "UI"
If .CBNNewCodeCollect(gDBRecordConn, sCode, "邮件短信文件夹") Then
.CBNNewCodeItem gDBRecordConn, sCode, "0", "邮件", , , 1
.CBNNewCodeItem gDBRecordConn, sCode, "100", "邮件收件箱", , 0
.CBNNewCodeItem gDBRecordConn, sCode, "110", "邮件发件箱", , 0
.CBNNewCodeItem gDBRecordConn, sCode, "120", "未确认邮件", , 0
.CBNNewCodeItem gDBRecordConn, sCode, "130", "已发送的邮件", , 0
.CBNNewCodeItem gDBRecordConn, sCode, "140", "已删除的邮件", , 0
.CBNNewCodeItem gDBRecordConn, sCode, "150", "邮件草稿", , 0
.CBNNewCodeItem gDBRecordConn, sCode, "1", "短信", , , 1
.CBNNewCodeItem gDBRecordConn, sCode, "160", "短信收件箱", , 1
.CBNNewCodeItem gDBRecordConn, sCode, "170", "短信发件箱", , 1
.CBNNewCodeItem gDBRecordConn, sCode, "180", "未确认短信", , 1
.CBNNewCodeItem gDBRecordConn, sCode, "190", "已发送的短信", , 1
.CBNNewCodeItem gDBRecordConn, sCode, "200", "已删除的短信", , 1
.CBNNewCodeItem gDBRecordConn, sCode, "210", "短信草稿", , 1
End If
sCode = "VA"
If .CBNNewCodeCollect(gDBRecordConn, sCode, "出运单类别") Then
.CBNNewCodeItem gDBRecordConn, sCode, "0", "类别1"
.CBNNewCodeItem gDBRecordConn, sCode, "1", "类别2"
End If
sCode = "VB"
If .CBNNewCodeCollect(gDBRecordConn, sCode, "检验单类别") Then
.CBNNewCodeItem gDBRecordConn, sCode, "0", "类别1"
.CBNNewCodeItem gDBRecordConn, sCode, "1", "类别2"
End If
sCode = "VC"
If .CBNNewCodeCollect(gDBRecordConn, sCode, "物料移动凭证类别") Then
.CBNNewCodeItem gDBRecordConn, sCode, "0", "类别1"
.CBNNewCodeItem gDBRecordConn, sCode, "1", "类别2"
End If
sCode = "VD"
If .CBNNewCodeCollect(gDBRecordConn, sCode, "采购订单类别") Then
.CBNNewCodeItem gDBRecordConn, sCode, "0", "类别1"
.CBNNewCodeItem gDBRecordConn, sCode, "NB", "NB"
End If
sCode = "VE"
If .CBNNewCodeCollect(gDBRecordConn, sCode, "厂商") Then
.CBNNewCodeItem gDBRecordConn, sCode, "0", "厂商1"
.CBNNewCodeItem gDBRecordConn, sCode, "1", "厂商2"
End If
sCode = "VY"
If .CBNNewCodeCollect(gDBRecordConn, sCode, "年度") Then
For lType = 0 To 7
.CBNNewCodeItem gDBRecordConn, sCode, CStr(1999 + lType), CStr(1999 + lType)
Next
End If
End With
Set madoFillRS = Nothing
End Sub
Private Function LoBuiltSetCollect(fsSetCollect As String, _
fsDesc As String, _
fbDescOverlap As Boolean) As Boolean
Dim i As Integer
Dim sUnSet As String
Dim TFieldRecs() As FieldRec
Dim sPara() As String
Dim bFlag As Boolean
Dim sSetID As String
If fsSetCollect Like FLAG_LIKE2 Then
sSetID = Left(fsSetCollect, 4)
bFlag = gclsCommon.CBNNewSetCollect(gDBRecordConn, sSetID, fsDesc)
End If
If bFlag Then
'子集中除了A0100,B0110,ID外,其余的全部放在子集中
TFieldRecs = gclsCommon.CBNGetFieldRec(fsSetCollect)
If gclsCommon.CBNIsEmpty(VarPtrArray(TFieldRecs)) Then Exit Function
sUnSet = "A0100,B0110,ID,W0075,W0076"
For i = LBound(TFieldRecs) To UBound(TFieldRecs)
With TFieldRecs(i)
If .FieldDesc <> NO_DEFINE Then
If Not gclsInclude.MyIsInList(sUnSet, .FieldName, True) Then
sPara = LoGetDefSetInfo(.FieldName)
gclsCommon.CBNNewSetItem gDBRecordConn, _
sSetID, _
.FieldName, _
gclsDBFunc.dbAdo2DaoType(.FieldType), _
.FieldSize, _
, _
sPara(0), _
sPara(1), _
.FieldDesc, _
fbDescOverlap
End If
End If
End With
Next i
LoBuiltSetCollect = True
End If
End Function
Private Function LoGetDefSetInfo(fsSetName As String) As String()
ReDim sInfo(1) As String
'0-FieldDesc
'1-CodeID
'2-Explain
Select Case fsSetName
Case "A0187"
sInfo(0) = "UF"
sInfo(1) = "0-既无平日加班又无休日加班" & vbCrLf & _
"1-平日加班及休日加班全计薪,但只计算超出应上工时的部分计加班" & vbCrLf & _
"2-平日加班全计薪,休日加班全计薪" & vbCrLf & _
"3-无平日加班,休日加班全计薪" & vbCrLf & _
"4-无平日加班,休日加班全计补休" & vbCrLf & _
"5-平日加班全计薪,无休日加班" & vbCrLf & _
"6-平日加班全计薪,休日加班全部算补休" & vbCrLf & _
"7-平日加班全计薪,休日加班8小时内算补休,超过8小时的部分计薪" & vbCrLf & _
"8-平日加班和休日加班全计补休" & vbCrLf & _
"9-正班段加班算加班,加班段加班算补休" & vbCrLf
Case "A0188", "A0195", "A0197", "A0198"
sInfo(0) = "UE"
Case "A0114": sInfo(0) = "AB" ' 籍贯
Case "A0107": sInfo(0) = "AX" ' 性别
Case "A0117": sInfo(0) = "AB" ' 出生地
Case "A0121": sInfo(0) = "AE" ' 民族
Case "A0124": sInfo(0) = "BF" ' 健康状况
Case "A0127": sInfo(0) = "BG" ' 婚姻状况
Case "A0131": sInfo(0) = "BK" ' 个人身份
Case "A0134": sInfo(0) = "AU" ' 家庭出身
Case "A0137": sInfo(0) = "AU" ' 本人成份
Case "A0154": sInfo(0) = "BI" ' 用工形式
Case "A0155": sInfo(0) = "JI" ' 劳动合同制用人形式
Case "A0157": sInfo(0) = "BH" ' 用工期限
Case "A0161": sInfo(0) = "AH" ' 职业类别
Case "A0164": sInfo(0) = "AI" ' 现从事专业
Case "A0167": sInfo(0) = "AL" ' 享受待遇级别
Case "A0171": sInfo(0) = "AB" ' 户口所在地
Case "A0174": sInfo(0) = "HP" ' 户口性质
Case "A0181": sInfo(0) = "AY" ' 港澳台侨属标识
Case "E0102": sInfo(0) = "HJ" ' 干部录聘标识
Case "E0104": sInfo(0) = "HA" ' 干部录聘用来源
Case "E0106": sInfo(0) = "HW" ' 干部选聘审批单位
Case "E0110": sInfo(0) = "HB" ' 减员途径
Case "E0114": sInfo(0) = "IM" ' 公务员录用来源
Case "E0116": sInfo(0) = "IN" ' 公务员特殊考试标识
Case "E0118": sInfo(0) = "IO" ' 进入跨地域标识
Case "E0122": sInfo(0) = "UM" ' 部门
Case "E0305": sInfo(0) = "KA" ' 进入方式
Case "E0355": sInfo(0) = "KB" ' 特殊项标识
Case "E1701": sInfo(0) = "HV" ' 岗位分类
Case "E1711": sInfo(0) = "HN" ' 岗位变化情况
Case "E1721": sInfo(0) = "KF" ' 公务员上岗方式
Case "E5804": sInfo(0) = "IA" ' 行政、岗位工资档次
Case "E5806": sInfo(0) = "HX" ' 工资级别
Case "E5808": sInfo(0) = "IA" ' 技术类工资档次
Case "E5841": sInfo(0) = "IA" ' 体育津贴档次
Case "E5844": sInfo(0) = "JR" ' 运动员比赛名次
Case "E5847": sInfo(0) = "JS" ' 运动员比赛层次
Case "E5895": sInfo(0) = "JU" ' 工资标准类型
Case "M5803": sInfo(0) = "KJ" ' 审批标识
'AB,AE,AH,AI,AL,AU,AX,AY,BF,BG,BH,BI,BK,HA,HB,HJ,HN,HP,HV,HW,HX,IA,IM,IN,IO,JI,JR,JS,JU,KA,KB,KF,KJ,UE,UF,UM
End Select
LoGetDefSetInfo = sInfo
End Function
#If Not IS_RUN Then
Private Sub DebugErr(Optional ByVal fsData As String)
If gclsDBFunc.dbGetLastError.Number <> 0 Then
Debug.Print IIf(fsData = "", "", fsData & ":") & gclsDBFunc.dbGetLastError.Description
gclsDBFunc.dbClearError
End If
End Sub
#End If
'对应旧版本的数据库，以下表发生变化：
'
'旧表 新表 描述
'----------------------------------------------
'SM_Function T0003S001 系统功能
'SM_User_Privileges T0007S001 操作员其他权限
'SM_UserGroup T0004S001 组成员列表
'SM_UserGroupId T0005S001 操作员组列表
'SM_UserId T0006S001 操作员列表
'sr_builtcollect T0008S001 已建代码集
'sr_BuiltItem T0009S001 已建指标集
'SR_CodeCollect T0010S001 代码集
'sr_codeitem T0011S001 代码项
'sr_department T0015S001 单位基本信息
'SR_SourceCollect T0012S001 指标集
'SR_SourceItem T0013S001 指标项
'sr_Unittype T0014S001 类别定义
'T0103S001 T0001S001 系统表描述
'T0104S001 T0002S001 系统字段描述
Public Function GetAllTables() As String()
Dim sTables(100) As String
sTables(0) = "A001A001" '在职人员人员基本信息
#If APPLICATION_TYPE = 10 Or APPLICATION_TYPE = 1 Then '工资系统(查询)或
sTables(1) = "A017A001" '在职人员岗位变化子集
sTables(2) = "A058A001" '在职人员工资子集
sTables(3) = "A066A001" '在职人员日考勤明细
sTables(4) = "A098A001" '在职人员密码子集
#End If
#If APPLICATION_TYPE = 11 Then '衡重
sTables(5) = "P001P001" '在编车辆车辆基本信息
#End If
sTables(6) = "T0001S001" '系统表描述
sTables(7) = "T0002S001" '系统字段描述
sTables(8) = "T0003S001" '系统功能
sTables(9) = "T0004S001" '组成员列表
sTables(10) = "T0005S001" '操作员组列表
sTables(11) = "T0006S001" '操作员列表
sTables(12) = "T0007S001" '操作员其他权限
sTables(13) = "T0008S001" '已建代码集
sTables(14) = "T0009S001" '已建指标集
sTables(15) = "T0010S001" '代码集
sTables(16) = "T0011S001" '代码项
sTables(17) = "T0012S001" '指标集
sTables(18) = "T0013S001" '指标项
sTables(19) = "T0014S001" '类别定义
sTables(20) = "T0015S001" '单位基本信息
sTables(21) = "T0101S001" '系统参数
sTables(22) = "T0102S001" '设备库
sTables(23) = "T0103S001" '控件事件屏蔽
sTables(24) = "T0105S001" '远程控制表
sTables(25) = "T0106A001" '设备权限表
sTables(26) = "T0107S001" '设备单价对应
sTables(27) = "T0108A001" '设备打卡权限
sTables(28) = "T0109A001" '人员打卡
sTables(29) = "T0110S001" '重要事件描述
sTables(30) = "T0111S001" '重要事件
sTables(31) = "T0112S001" '节假日定义
sTables(32) = "T0113A001" '发卡信息
sTables(33) = "T0114S001" '系统菜单
sTables(34) = "T0115S001" '操作员菜单权限
sTables(35) = "T0116S001" '操作流水
sTables(36) = "T0117S001" 'SQL查询
sTables(37) = "T0118S001" '请假类别
sTables(38) = "T0119S001" '考勤处理方式
sTables(39) = "T0120S001" '手工签卡
sTables(40) = "T0121S001" '考勤规则
sTables(41) = "T0122S001" '窗体元素布局
sTables(42) = "T0123A001" '临时记录表
sTables(43) = "T0124S001" '收费标准
' sTables(44) = "T0125A001" '黑名单
sTables(45) = "T0126S001" '最大ID值
sTables(46) = "T0127S001" '报表参数集
sTables(47) = "T0128S001" '报表参数项
sTables(48) = "T0129S001" '语言名称对照
sTables(49) = "T0130S001" '已注册运行的计算机
#If APPLICATION_TYPE = 3 Then '巡更
sTables(50) = "T3001S001" '巡更网点设置
sTables(51) = "T3002S001" '巡更班次种类
sTables(52) = "T3003A001" '巡更员卡信息
sTables(53) = "T3004A001" '巡更班次设置
sTables(54) = "T3005A001" '巡更明细
sTables(55) = "T3006A001" '巡更班次安排
#End If
#If APPLICATION_TYPE = 1 Then '考勤
sTables(56) = "T6620A001" '指定考勤项
sTables(57) = "T6621A001" '考勤明细
sTables(58) = "T6623A001" '人员换班
sTables(59) = "T6624A001" '班次安排
sTables(60) = "T6629A001" '人员打卡明细
sTables(61) = "T6632A001" '人员班次设置
sTables(62) = "T6633A001" '加班单
sTables(63) = "T6638A001" '人员请假安排
sTables(64) = "T6645A001" '请假报表
sTables(65) = "T6646A001" '串休表
sTables(66) = "T6649A001" '工时调换
sTables(67) = "T6650A001" '工时调换状态
sTables(68) = "T6651S001" '系统班次设置
sTables(69) = "T6652S001" '班次类型
#End If
#If APPLICATION_TYPE = 11 Then '衡重
sTables(70) = "T8202S001" '称重数据
sTables(71) = "T8203P001" '称重状态
#End If
#If APPLICATION_TYPE = 12 Then 'VMS
sTables(72) = "T5501A001" '号码库
sTables(73) = "T5503A001" '采购订单表头
sTables(74) = "T5505A001" '原因库
sTables(75) = "T5507A001" '采购明细
sTables(76) = "T5509A001" '客户
sTables(77) = "T5511A001" '银行-往来客户
sTables(78) = "T5513A001" '税码库
sTables(79) = "T5515A001" '物料
sTables(80) = "T5517A001" '物料类别
sTables(81) = "T5519A001" '物料组
sTables(82) = "T5521A001" '仓库
sTables(83) = "T5523A001" '物料移动凭证
sTables(84) = "T5525A001" '出运需求单
sTables(85) = "T5527A001" '出运需求明细
sTables(86) = "T5529A001" '付款条件
sTables(87) = "T5531A001" '客户合作方
sTables(88) = "T5533A001" '税码库
sTables(89) = "T5535A001" '币种汇率
sTables(90) = "T5537A001" '检验标准
sTables(91) = "T5539A001" '检验级别库
sTables(92) = "T5541A001" '抽样库
sTables(93) = "T5543A001" '检验单头
sTables(94) = "T5545A001" '检验单明细
sTables(95) = "T5547A001" '主管评述库
sTables(96) = "T5549A001" '仓库值
sTables(97) = "T5551A001" '凭证流转
sTables(98) = "T5553A001" '邮件短信
#End If
#If APPLICATION_TYPE = 13 Then '超限收费- V4_20_057_SN
sTables(99) = "T5701A001" '称重流水数据库
sTables(100) = "T5702A001" '车辆数据缓存区
#End If
GetAllTables = sTables
End Function
Public Function GetAllViews() As String()
Dim sViews(37) As String
sViews(0) = "QA001A001_001"
sViews(1) = "QA001A001_002"
sViews(2) = "QA001A001_003"
sViews(3) = "QA066A001_001"
sViews(4) = "QT0102S001_001"
sViews(5) = "QT0106A001_001"
sViews(6) = "QT0108A001_001"
sViews(7) = "QT0109A001_001"
sViews(8) = "QT0109A001_002"
sViews(9) = "QT0109A001_003"
sViews(10) = "QT0109A001_004"
sViews(11) = "QT0111S001_001"
'sViews(12) = "QT0111S001_002"
'sViews(13) = "QT0111S001_003"
sViews(14) = "QT0113A001_001"
sViews(15) = "QT0114S001_001"
sViews(16) = "QT0120S001_001"
sViews(17) = "QT0123A001_001"
sViews(18) = "QT0123A001_002"
#If APPLICATION_TYPE = 3 Then '巡更
sViews(19) = "QT3002A001_001"
sViews(20) = "QT3003A001_001"
'sViews(21) = "QT3004A001_001"
sViews(22) = "QT3005A001_001"
#End If
#If APPLICATION_TYPE = 1 Then '考勤
sViews(23) = "QT6620A001_001"
sViews(24) = "QT6621A001_001"
sViews(25) = "QT6621A001_002"
sViews(26) = "QT6621A001_003"
sViews(27) = "QT6621A001_004"
sViews(28) = "QT6623A001_001"
sViews(29) = "QT6623A001_002"
sViews(30) = "QT6624A001_001"
sViews(31) = "QT6629A001_001"
sViews(32) = "QT6632A001_001"
sViews(33) = "QT6633A001_001"
sViews(34) = "QT6645A001_001"
sViews(35) = "QT6645A001_002"
sViews(36) = "QT6646A001_001"
sViews(37) = "QT6649A001_001"
#End If
GetAllViews = sViews
End Function
Public Function GetAllIndexes() As String()
Dim sIndexes(79) As String
sIndexes(0) = "pk_A001A001"
sIndexes(1) = "A001A001_Card"
sIndexes(2) = "A001A001_ind"
sIndexes(3) = "pk_A017A001"
sIndexes(4) = "A017A001_ind"
sIndexes(5) = "pk_A058A001"
sIndexes(6) = "A058A001_ind"
sIndexes(7) = "pk_A066A001"
sIndexes(8) = "A066A001_ind"
sIndexes(9) = "pk_A098A001"
sIndexes(10) = "A098A001_ind"
sIndexes(11) = "pk_P001P001"
sIndexes(12) = "P001P001_Card"
sIndexes(13) = "P001P001_ind"
sIndexes(14) = "pk_T0003S001"
sIndexes(15) = "pk_T0004S001"
sIndexes(16) = "pk_T0005S001"
sIndexes(17) = "pk_T0006S001"
sIndexes(18) = "pk_T0007S001"
sIndexes(19) = "pk_T0008S001"
sIndexes(20) = "pk_T0009S001"
sIndexes(21) = "pk_T0010S001"
sIndexes(22) = "pk_T0011S001"
sIndexes(23) = "pk_T0015S001"
sIndexes(24) = "pk_T0012S001"
sIndexes(25) = "pk_T0013S001"
' sIndexes(26) = "pk_T0015S002"
sIndexes(27) = "pk_T0014S001"
sIndexes(28) = "pk_T0101S001"
sIndexes(29) = "pk_T0102S001"
sIndexes(30) = "T0102S001_ind"
sIndexes(31) = "pk_T0001S001"
sIndexes(32) = "pk_T0002S001"
sIndexes(33) = "pk_T0105S001"
sIndexes(34) = "pk_T0106A001"
sIndexes(35) = "pk_T0107S001"
sIndexes(36) = "pk_T0108A001"
sIndexes(37) = "T0109A001_CLUSTERED"
sIndexes(38) = "T0109A001_ind"
sIndexes(39) = "pk_T0110S001"
sIndexes(40) = "pk_T0111S001"
sIndexes(41) = "T0111S001_ind"
sIndexes(42) = "pk_T0112S001"
sIndexes(43) = "pk_T0113A001"
sIndexes(44) = "T0113A001_ind"
sIndexes(45) = "pk_T0114S001"
sIndexes(46) = "pk_T0115S001"
sIndexes(47) = "pk_T0116S001"
sIndexes(48) = "T0116S001_ind"
sIndexes(49) = "pk_T0117S001"
sIndexes(50) = "pk_T0118S001"
sIndexes(51) = "pk_T0119S001"
sIndexes(52) = "pk_T0120S001"
sIndexes(53) = "pk_T0121S001"
sIndexes(54) = "pk_T0126S001"
sIndexes(55) = "pk_T3001S001"
sIndexes(56) = "pk_T3002S001"
sIndexes(57) = "pk_T3003A001"
sIndexes(58) = "pk_T3004A001"
sIndexes(59) = "pk_T3005A001"
sIndexes(60) = "pk_T6620A001"
sIndexes(61) = "pk_T6621A001"
sIndexes(62) = "T6621A001_ind"
sIndexes(63) = "pk_T6623A001"
sIndexes(64) = "T6623A001_ind"
sIndexes(65) = "pk_T6624A001"
sIndexes(66) = "pk_T6629A001"
sIndexes(67) = "pk_T6632A001"
sIndexes(68) = "pk_T6633A001"
sIndexes(69) = "pk_T6638A001"
sIndexes(70) = "T6638A001_ind"
sIndexes(71) = "T6645A001_ind"
sIndexes(72) = "pk_T6646A001"
sIndexes(73) = "pk_T6649A001"
sIndexes(74) = "T6649A001_ind"
sIndexes(75) = "pk_T6650A001"
sIndexes(76) = "T6650A001_ind"
sIndexes(77) = "pk_T6651S001"
sIndexes(78) = "T6651S001_ind"
sIndexes(79) = "pk_T6652S001"
GetAllIndexes = sIndexes
End Function