www.pudn.com > VB-KAOQINXITONG.zip > frmPubCheckData.frm
VERSION 5.00
Object = "{B9D938CE-50EE-40B2-9FA2-79A3112F4788}#4.2#0"; "BNCtrlGroup.ocx"
Begin VB.Form frmPubCheckData
ClientHeight = 3615
ClientLeft = 60
ClientTop = 345
ClientWidth = 2460
Icon = "frmPubCheckData.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
ScaleHeight = 3615
ScaleWidth = 2460
StartUpPosition = 1 '所有者中心
Begin VB.Frame Frame1
Appearance = 0 'Flat
ForeColor = &H80000008&
Height = 3660
Left = 15
TabIndex = 0
Top = -90
Width = 2430
Begin BNCtrlGroup.BNButton cmdExit
Height = 405
Left = 165
TabIndex = 6
Tag = "Exit"
Top = 3120
Width = 2040
_ExtentX = 3598
_ExtentY = 714
Caption = "退 出"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
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 cmdDatabase
Height = 405
Index = 0
Left = 165
TabIndex = 4
Tag = "Backup"
Top = 1791
Visible = 0 'False
Width = 2040
_ExtentX = 3598
_ExtentY = 714
Caption = "数据库备份"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
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 cmdDatabase
Height = 405
Index = 1
Left = 165
TabIndex = 5
Tag = "Restore"
Top = 2265
Visible = 0 'False
Width = 2040
_ExtentX = 3598
_ExtentY = 714
Caption = "数据库恢复"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
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 cmdFix
Height = 405
Left = 165
TabIndex = 1
Tag = "Download"
Top = 375
Visible = 0 'False
Width = 2040
_ExtentX = 3598
_ExtentY = 714
Caption = "数据库错误整理"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
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 cmdSingleDatabase
Height = 405
Index = 1
Left = 165
TabIndex = 2
Tag = "Backup"
Top = 847
Width = 2040
_ExtentX = 3598
_ExtentY = 714
Caption = "单机数据备份"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
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 cmdSingleDatabase
Height = 405
Index = 0
Left = 165
TabIndex = 3
Tag = "Restore"
Top = 1319
Width = 2040
_ExtentX = 3598
_ExtentY = 714
Caption = "单机数据恢复"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
End
End
Attribute VB_Name = "frmPubCheckData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mTDateRange As DateRange
Private Sub cmdDatabase_Click(Index As Integer)
Me.Hide
gbBusy = True
If Index = 1 Then
If gclsCommon.CBNRestoreDatabase Then
MsgBox "数据库恢复成功,请重新启动系统", vbInformation
Unload Me
gTAppLicInfo.CtrlUnload = True
Else
Me.Show
End If
ElseIf Index = 0 Then
If gclsCommon.CBNBackupDatabase Then MsgBox "数据库备份成功!", vbInformation
Me.Show
End If
gbBusy = False
End Sub
Private Sub cmdFix_Click()
Dim sSQL As String
Dim lTimeOut As Long
On Error GoTo ErrLabel
If MsgBox("本次整理将对" & gclsCommon.CBNGetTableDesc("A066A001") & _
"," & gclsCommon.CBNGetTableDesc("T6621A001") & _
"中的数据除错,是否继续?", vbQuestion + vbOKCancel) = vbCancel Then Exit Sub
Me.Hide
gclsCommon.CBNSplashShow
DoEvents
gclsCommon.CBNSplashSetMessage "正在整理数据库错误"
DoEvents
'将人员信息中符合的数据剔除
lTimeOut = gDBRecordConn.CommandTimeout
gDBRecordConn.CommandTimeout = 500
gclsCommon.CBNSplashSetNotes "正在将" & gclsCommon.CBNGetTableDesc("A066A001") & "中有而在" & gclsCommon.CBNGetTableDesc("A001A001") & "中没有的数据删除"
DoEvents
gDBRecordConn.Execute "DROP TABLE TempTable"
gDBRecordConn.Execute "SELECT DISTINCT A066A001.A0189 INTO TempTable FROM A066A001 " & _
"LEFT JOIN A001A001 ON ([A066A001].[B0110] = [A001A001].[B0110]) AND " & _
"([A066A001].[A0189] = [A001A001].[A0189]) WHERE ([A001A001].[A0189] Is Null);"
gDBRecordConn.Execute gclsCommon.CBNCSql("DELETE A066A001.* FROM A066A001 WHERE " & _
"A0189 IN (SELECT A0189 FROM TempTable);")
gclsCommon.CBNSplashSetNotes "正在将" & gclsCommon.CBNGetTableDesc("T6621A001") & "中有而" & _
gclsCommon.CBNGetTableDesc("A001A001") & "中无的数据删除"
DoEvents
gDBRecordConn.Execute "DROP TABLE TempTable"
gDBRecordConn.Execute "SELECT DISTINCT T6621A001.A0189 INTO TempTable FROM T6621A001 " & _
"LEFT JOIN A001A001 ON ([T6621A001].[B0110] = [A001A001].[B0110]) AND " & _
"([T6621A001].[A0189] = [A001A001].[A0189]) AND ([T6621A001].[A0189] = [A001A001].[E0122]) WHERE " & _
"([A001A001].[E0122] Is Null);"
gDBRecordConn.Execute gclsCommon.CBNCSql("DELETE T6621A001.* FROM T6621A001 WHERE A0189 IN ( SELECT A0189 FROM TempTable)")
If gTAppLicInfo.SoftNetwork Then
gclsCommon.CBNSplashSetNotes "正在填补" & gclsCommon.CBNGetTableDesc("A066A001") & _
"中不存在的数据记录"
DoEvents
sSQL = "INSERT INTO A066A001 (B0110,A0100,W0075,W0076,E0122,A0189,ID) " & _
"(SELECT A001A001.B0110, A001A001.A0100, A001A001.W0075," & _
"A001A001.W0076, A001A001.E0122, A001A001.A0189,100 AS ID " & _
"FROM A001A001 LEFT OUTER JOIN " & _
"A066A001 ON A001A001.A0100 = A066A001.A0100 " & _
"WHERE (A066A001.A0100 IS NULL))"
gDBRecordConn.Execute sSQL
End If
gclsCommon.CBNSplashSetNotes "正在将" & gclsCommon.CBNGetTableDesc("A066A001") & _
"中值为空的数据记录替换为零"
DoEvents
gclsDBFunc.dbSetNullToZero "A066A001", gDBRecordConn, , , True
ErrLabel:
If Err = -2147217865 Then
Resume Next
ElseIf Err <> 0 Then
MsgBox Error
Else
MsgBox "整理完毕"
End If
gclsCommon.CBNSplashSetNotes ""
gclsCommon.CBNSplashUnload
If lTimeOut > 0 Then _
gDBRecordConn.CommandTimeout = lTimeOut
Me.Show
End Sub
Private Sub cmdSingleDatabase_Click(Index As Integer)
Me.Hide
If Index = 1 Then
LoDataBackup
ElseIf Index = 0 Then
LoDataRestore
End If
Me.Show
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub Form_Load()
LoSetButtonTag
SetIcon Me
cmdFix.Visible = gTAppLicInfo.SysLoginSA
If gTPickStruct.TDateRange.DStart > 0 Then
mTDateRange = gTPickStruct.TDateRange
Else
#If APPLICATION_TYPE = 1 Then '考勤
mDBgnDate = gclsCommon.CBNGetFirstDay(gTAttendCtl.BeginAttendDay)
#Else
mDBgnDate = gclsCommon.CBNGetFirstDay(1)
#End If
mDEndDate = gclsInclude.MyDateOf(gclsCommon.CBNGetNow)
End If
cmdDatabase(0).Visible = gTAppLicInfo.SoftNetwork
cmdDatabase(1).Visible = gTAppLicInfo.SoftNetwork
Me.Caption = "数据整理"
End Sub
Private Sub LoSetButtonTag()
cmdExit.Tag = "IMG029"
cmdDatabase(0).Tag = "IMG065"
cmdDatabase(1).Tag = "IMG066"
cmdSingleDatabase(0).Tag = "IMG065"
cmdSingleDatabase(1).Tag = "IMG066"
cmdFix.Tag = "IMG024"
End Sub
Private Sub LoDataBackup()
Dim DDateBgn As Date
Dim DDateEnd As Date
Dim iEarly As Integer
Dim sTblInfo As String
Dim TTblInfo() As TblInfo
Dim adoTempRS As ADODB.Recordset
If MsgBox("此操作将备份并且删除选择的时间范围内所有的数据,是否继续?", vbOKCancel + vbInformation) = vbCancel Then Exit Sub
iEarly = funcGetINIData("System Settings", "BackupEarlyDay", 0)
If iEarly = 0 Then
'得到上个月的最后一天的时间
#If APPLICATION_TYPE = 1 Then '考勤
DDateEnd = gclsCommon.CBNGetFirstDay(gTAttendCtl.BeginAttendDay)
#Else
DDateEnd = gclsCommon.CBNGetFirstDay(1)
#End If
Else
DDateEnd = gclsCommon.CBNGetNow - iEarly
End If
DDateBgn = DDateEnd - 100
Set adoTempRS = Nothing
CloseOtherWindows "frmTimePick"
If Not gclsCommon.CBNShowTimePick(DDateBgn, DDateEnd, _
, , , , , _
Not (gTAppLicInfo.SysLoginSYS Or gTAppLicInfo.SysLoginSA)) Then _
Exit Sub
sTblInfo = "T0109A001,W0031,W0031,A0199" & vbCrLf & _
"T0111S001,W1109,W1109,W1111" & vbCrLf & _
"T6620A001,W0020,W0020,A0189" & vbCrLf & _
"T6621A001,E6600,E6600,A0189" & vbCrLf & _
"T6623A001,W6618,A0189" & vbCrLf & _
"T6629A001,W6620,W6620,A0189" & vbCrLf & _
"T6638A001,W6640,W6640,A0189" & vbCrLf & _
"T0120S001,W6677,W6677,W6677,A0189"
TTblInfo = LoGetBackupInfo(sTblInfo)
' gbLogining = True
' shpBusy.FillColor = vbBlue
gclsCommon.CBNDataBackup DDateBgn, DDateEnd, TTblInfo
' shpBusy.FillColor = vbGreen
' gbLogining = False
End Sub
Private Sub LoDataRestore()
' gbLogining = True
' shpBusy.FillColor = vbBlue
gclsCommon.CBNDataRestore
' shpBusy.FillColor = vbGreen
' gbLogining = False
End Sub
Private Function LoGetBackupInfo(fsTblInfo As String) As TblInfo()
Dim vSplit
Dim i As Integer
Dim iBegin As Integer
Dim iEnd As Integer
Dim TTblInfo() As TblInfo
vSplit = Split(fsTblInfo, vbCrLf)
ReDim TTblInfo(UBound(vSplit))
For i = 0 To UBound(TTblInfo)
ReDim TTblInfo(i).sFldName(1)
iBegin = 1
iEnd = InStr(vSplit(i), ",")
TTblInfo(i).sTblName = Mid(vSplit(i), iBegin, iEnd - iBegin)
iBegin = iEnd + 1
iEnd = InStr(iBegin, vSplit(i), ",")
TTblInfo(i).sFldName(0) = Mid(vSplit(i), iBegin, iEnd - iBegin)
TTblInfo(i).sFldName(1) = Mid(vSplit(i), iEnd + 1)
Next i
LoGetBackupInfo = TTblInfo
End Function