frminputg.frm

档案管理系统,使用vb6+access数据库开发

    l_Text(i + 5) = dcZR(i).Text
    l_Text(i + 15) = dcZTC(i).Text
  Next
  l_Text(18) = dcZTC(3).Text
  l_Text(19) = dcZTC(4).Text
End Sub

Private Function AutoAdd(txtDh As String) As String     '档号自动加1的函数
Dim i, loc_dh, re_no, new_no, len_no As Integer
Dim dh_no, new_dh, re_dh As String
re_dh = StrReverse(txtDh)       '颠倒档号字串
If Val(re_dh) = 0 Then
   AutoAdd = txtDh
Else
   re_no = Val(re_dh)
   For i = 0 To Len(re_dh)      '统计序号位数
     If Val(Left(re_dh, i)) = re_no Then Exit For
   Next
   dh_no = StrReverse(Left(re_dh, i))       '返回档号原有的顺序号(字符型)
   new_no = Val(dh_no) + 1                  '顺序号加1，返回新的顺序号(数值型)
   len_no = Len(LTrim(Str(new_no)))         '统计新顺序号的位数
   len_no = IIf(len_no < Len(dh_no), Len(dh_no), len_no)
   new_dh = Right(Str(new_no + 10 ^ len_no), len_no)    '返回档号的顺序号(字符型)
   loc_dh = InStrRev(txtDh, dh_no)          '返回要替换的顺序号的位置
   AutoAdd = Left(txtDh, loc_dh - 1) & Replace(txtDh, dh_no, new_dh, loc_dh, 1)
End If
End Function

Private Sub cmdModify_Click()
Load frmModifyG
frmModifyG.Show
End Sub

Private Sub cmdOK_Click()
  With adoRst
    .Fields("全宗号") = ConvertNull(Text0.Text)
    .Fields("目录号") = ConvertNull(Text1.Text)
    .Fields("档号") = ConvertNull(Text2.Text)
    .Fields("文件编号") = ConvertNull(Text3.Text)
    .Fields("形成日期") = ConvertNull(Text4.Text)
    .Fields("责任者1") = ConvertNull(IIf(dcZR(0).Text = "", -1, ZZID(0)))
    .Fields("责任者2") = ConvertNull(IIf(dcZR(1).Text = "", -1, ZZID(1)))
    .Fields("责任者3") = ConvertNull(IIf(dcZR(2).Text = "", -1, ZZID(2)))

    
    .Fields("保管期限") = ConvertNull(Combo1.Text)
    .Fields("密级") = ConvertNull(Combo2.Text)
    .Fields("存档情况") = ConvertNull(Combo3.Text)
    .Fields("规格") = ConvertNull(Text5.Text)
    .Fields("份数") = ConvertNull(Val(Text6.Text))
    .Fields("页数") = ConvertNull(Val(Text7.Text))
    .Fields("正题名") = ConvertNull(Text8.Text)
    .Fields("摘要") = ConvertNull(Text9.Text)
    .Fields("主题词1") = ConvertNull(IIf(dcZTC(0).Text = "", -1, ZZID(3)))
    .Fields("主题词2") = ConvertNull(IIf(dcZTC(1).Text = "", -1, ZZID(4)))
    .Fields("主题词3") = ConvertNull(IIf(dcZTC(2).Text = "", -1, ZZID(5)))
    .Fields("主题词4") = ConvertNull(IIf(dcZTC(3).Text = "", -1, ZZID(6)))
    .Fields("主题词5") = ConvertNull(IIf(dcZTC(4).Text = "", -1, ZZID(7)))
    .Fields("FileType") = ConvertNull(Text10.Text)

Do While False
    .Fields("责任者1") = ConvertNull(IIf(dcZR(0).Text = "", -1, dcZR(0).BoundText))
    .Fields("责任者2") = ConvertNull(IIf(dcZR(1).Text = "", -1, dcZR(1).BoundText))
    .Fields("责任者3") = ConvertNull(IIf(dcZR(2).Text = "", -1, dcZR(2).BoundText))
    .Fields("主题词1") = ConvertNull(IIf(dcZTC(0).Text = "", -1, dcZTC(0).BoundText))
    .Fields("主题词2") = ConvertNull(IIf(dcZTC(1).Text = "", -1, dcZTC(1).BoundText))
    .Fields("主题词3") = ConvertNull(IIf(dcZTC(2).Text = "", -1, dcZTC(2).BoundText))
    .Fields("主题词4") = ConvertNull(IIf(dcZTC(3).Text = "", -1, dcZTC(3).BoundText))
    .Fields("主题词5") = ConvertNull(IIf(dcZTC(4).Text = "", -1, dcZTC(4).BoundText))
Loop

    .Update
  End With
  Call SaveText
  Call TextEmpty
  Call SetEnable(False)
  cmdAdd.SetFocus
End Sub

Private Sub CmdReturn_Click()
adoRst.CancelUpdate
adoRst.Close
frmInputG.Hide
Unload frmInputG
End Sub

Private Sub SetEnable(para_Value As Boolean)
Dim Cntl As Control
For Each Cntl In frmInputG
  If TypeOf Cntl Is TextBox Then
     Cntl.Enabled = para_Value
  End If
  If TypeOf Cntl Is ComboBox Then
     Cntl.Enabled = para_Value
  End If
  If TypeOf Cntl Is DataCombo Then
     Cntl.Enabled = para_Value
  End If
  If TypeOf Cntl Is UpDown Then
     Cntl.Enabled = para_Value
  End If
Next
cmdAdd.Enabled = Not para_Value
cmdCopy.Enabled = para_Value
cmdClear.Enabled = para_Value
cmdOK.Enabled = para_Value
F_Add.Enabled = Not para_Value
F_Save.Enabled = para_Value
E_Copy.Enabled = para_Value
E_Clear.Enabled = para_Value

udDate.Enabled = False
End Sub

Private Sub cmdSeek_Click()
Load frmSeekG
frmSeekG.Show
End Sub

Private Sub Combo1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub Combo2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub Combo3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub D_Modify_Click()
cmdModify_Click
End Sub

Private Sub D_Seek_Click()
cmdSeek_Click
End Sub

Private Sub dcZR_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub dcZR_LostFocus(Index As Integer)
Dim NewZr As Boolean
Dim NewID As Integer
If LTrim(Trim(dcZR(Index).Text)) = "" Then Exit Sub
NewZr = True
NewID = 0
With adoZrRst
  .Open "Select * From Zr Order By ZrID"
  .MoveFirst
  Do Until .EOF
     If Trim(.Fields("ZrID")) = NewID Then NewID = NewID + 1
     If Trim(.Fields("Zr")) = Trim(dcZR(Index).Text) Then
        NewZr = False
        ZZID(Index) = Val(dcZR(Index).BoundText)    '保存责任者编号
        Exit Do
     End If
     .MoveNext
  Loop
  .MoveFirst
  If NewZr Then             '添加一个新的责任者
     .AddNew
     .Fields("ZrID") = NewID
     .Fields("Zr") = dcZR(Index).Text
     .Update
     ZZID(Index) = NewID    '保存责任者编号
  End If
  .Close
End With
End Sub

Private Sub dcZTC_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub dcZTC_LostFocus(Index As Integer)
Dim NewZtc As Boolean
Dim NewID As Integer
If LTrim(Trim(dcZTC(Index).Text)) = "" Then Exit Sub
NewZtc = True
NewID = 0
With adoZtcRst
  .Open "Select * From Ztc Order By ZtcID"
  .MoveFirst
  Do Until .EOF
     If Trim(.Fields("ZtcID")) = NewID Then NewID = NewID + 1
     If Trim(.Fields("Ztc")) = Trim(dcZTC(Index).Text) Then
        NewZtc = False
        ZZID(Index + 3) = Val(dcZTC(Index).BoundText)   '保存主题词编号
        Exit Do
     End If
     .MoveNext
  Loop
  .MoveFirst
  If NewZtc Then                '添加一个新的主题词
     .AddNew
     .Fields("ZtcID") = NewID
     .Fields("Ztc") = dcZTC(Index).Text
     .Update
     ZZID(Index + 3) = NewID    '保存主题词编号
  End If
  .Close
End With
End Sub

Private Sub E_Clear_Click()
cmdClear_Click
End Sub

Private Sub E_Copy_Click()
cmdCopy_Click
End Sub

Private Sub F_Add_Click()
cmdAdd_Click
End Sub

Private Sub F_Save_Click()
cmdOK_Click
End Sub

Private Sub Form_Load()
  Set adoCon = New ADODB.Connection
  adoCon.Open "PmData", "Admin"

  Set adoRst = New ADODB.Recordset
  Set adoRst.ActiveConnection = adoCon
  adoRst.CursorType = adOpenKeyset
  adoRst.LockType = adLockOptimistic
  
  Set adoZrRst = New ADODB.Recordset
  Set adoZrRst.ActiveConnection = adoCon
  adoZrRst.CursorType = adOpenKeyset
  adoZrRst.LockType = adLockOptimistic
  
  Set adoZtcRst = New ADODB.Recordset
  Set adoZtcRst.ActiveConnection = adoCon
  adoZtcRst.CursorType = adOpenKeyset
  adoZtcRst.LockType = adLockOptimistic
  
  adoRst.Open "Select * From DataG Where FileType Like '" & frmMain.FileType & "'"
  
  Call SetEnable(False)
  frmInputG.Caption = frmInputG.Caption + "  （" + frmMain.FileType + "档案）"
End Sub

Sub Text0_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub Text4_LostFocus()
Dim i, dotNum, dotLoc(10), lenDate As Integer
Dim iDate As String
If Text4.Text = "" Then Exit Sub
dotNum = 0
iDate = LTrim(Trim(Text4.Text))
lenDate = Len(iDate)
For i = 1 To lenDate
  If Mid(iDate, i, 1) = "." Then
     dotNum = dotNum + 1
     dotLoc(dotNum) = i
  End If
Next
Select Case dotNum
       Case Is = 0
            If lenDate = 2 Then
               iDate = "19" & iDate
            Else
               If lenDate <> 4 Then
                  Text4.SetFocus
                  Exit Sub
               End If
            End If
       Case Is = 1
            If dotLoc(1) = 3 And lenDate > 3 Then
               iDate = "19" & iDate
               lenDate = lenDate + 2
               If lenDate = 6 Then
                  iDate = Left(iDate, 5) & "0" & Right(iDate, 1)
                  lenDate = lenDate + 1
               End If
               If lenDate <> 7 Then
                  Text4.SetFocus
                  Exit Sub
               End If
            Else
               If dotLoc(1) = 5 Then
                  If lenDate = 6 Then
                     iDate = Left(iDate, 5) & "0" & Right(iDate, 1)
                     lenDate = lenDate + 1
                  End If
                  If lenDate <> 7 Then
                     Text4.SetFocus
                     Exit Sub
                  End If
               Else
                  Text4.SetFocus
                  Exit Sub
               End If
            End If
       Case Is = 2
            Select Case dotLoc(1)
                   Case 3
                        Select Case dotLoc(2)
                               Case 5
                                    Select Case lenDate
                                           Case 6
                                                iDate = "19" & Left(iDate, 3) & _
                                                     "0" & Mid(iDate, 4, 2) & _
                                                     "0" & Right(iDate, 1)
                                           Case 7
                                                iDate = "19" & Left(iDate, 3) & _
                                                     "0" & Right(iDate, 4)
                                    End Select
                               Case 6
                                    Select Case lenDate
                                           Case 7
                                                iDate = "19" & Left(iDate, 6) & _
                                                     "0" & Right(iDate, 1)
                                           Case 8
                                                iDate = "19" & iDate
                                    End Select
                        End Select
                   Case 5
                        Select Case dotLoc(2)
                               Case 7
                                    Select Case lenDate
                                           Case 8
                                                iDate = Left(iDate, 5) & "0" & _
                                                      Mid(iDate, 6, 2) & "0" & _
                                                      Right(iDate, 1)
                                           Case 9
                                                iDate = Left(iDate, 5) & "0" & _
                                                      Right(iDate, 4)
                                    End Select
                               Case 8 And lenDate = 9
                                    iDate = Left(iDate, 8) & "0" & Right(iDate, 1)
                        End Select
            End Select
            lenDate = Len(iDate)
            If lenDate <> 10 Or Mid(iDate, 5, 1) <> "." Or Mid(iDate, 8, 1) <> "." Then
               Text4.SetFocus
               Exit Sub
            End If
       Case Else
            Text4.SetFocus
            Exit Sub
End Select
If Right(iDate, 1) = "." Then
   Text4.Text = Left(iDate, lenDate - 1)
Else
   Text4.Text = iDate
End If
End Sub

Sub Text5_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Sub Text6_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Sub Text7_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Sub Text8_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Private Sub Text8_LostFocus()
Dim i, j, k As Integer
Dim ZT(10, 3), ZT1 As String
Dim Swap
i = 0
With adoZtcRst
  .Open "Select * From Ztc Order By ZtcID"
  .MoveFirst
  Do While Not .EOF And i < 10
     ZT1 = LTrim(Trim(.Fields!Ztc))
     ZT(i, 2) = InStr(Text8.Text, ZT1)
     If ZT(i, 2) Then
        ZT(i, 0) = ZT1
        ZT(i, 1) = .Fields!ZtcID
        i = i + 1
     End If
     .MoveNext
  Loop
  i = i - 1
  For j = 0 To i - 1
    For k = j + 1 To i
      If ZT(j, 2) > ZT(k, 2) Then
         Swap = ZT(j, 0)
         ZT(j, 0) = ZT(k, 0)
         ZT(k, 0) = Swap
         Swap = ZT(j, 1)
         ZT(j, 1) = ZT(k, 1)
         ZT(k, 1) = Swap
         Swap = ZT(j, 2)
         ZT(j, 2) = ZT(k, 2)
         ZT(k, 2) = Swap
      End If
    Next k
  Next j
  For i = 0 To 4
    dcZTC(i).Text = ZT(i, 0)
    dcZTC(i).BoundText = ZT(i, 1)
  Next
  .Close
End With
End Sub

Sub Text9_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdOK.SetFocus
KeyAscii = 0
End If
End Sub