form_renwuf.frm

2008年版

      Caption         =   "电子文档号"
      Height          =   180
      Left            =   450
      TabIndex        =   31
      Top             =   4800
      Width           =   900
   End
   Begin VB.Label Label11 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "拍摄时间"
      Height          =   180
      Left            =   9090
      TabIndex        =   30
      Top             =   2610
      Width           =   720
   End
   Begin VB.Label Label12 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "主题词"
      Height          =   180
      Left            =   450
      TabIndex        =   29
      Top             =   3390
      Width           =   540
   End
   Begin VB.Label Label13 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "拍摄地点"
      Height          =   180
      Left            =   9180
      TabIndex        =   28
      Top             =   2055
      Width           =   720
   End
   Begin VB.Label Label14 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "载体类型"
      Height          =   180
      Left            =   4410
      TabIndex        =   27
      Top             =   2235
      Width           =   720
   End
   Begin VB.Label Label15 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "拍摄者"
      Height          =   180
      Left            =   450
      TabIndex        =   26
      Top             =   3000
      Width           =   540
   End
   Begin VB.Label Label16 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "文字说明"
      Height          =   180
      Left            =   9180
      TabIndex        =   25
      Top             =   3150
      Width           =   720
   End
   Begin VB.Label Label17 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "页数"
      ForeColor       =   &H000000C0&
      Height          =   180
      Left            =   450
      TabIndex        =   24
      Top             =   2205
      Width           =   360
   End
   Begin VB.Label Label18 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "底片号"
      Height          =   180
      Left            =   480
      TabIndex        =   23
      Top             =   1410
      Width           =   540
   End
   Begin VB.Label Label19 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "件号"
      Height          =   180
      Left            =   4410
      TabIndex        =   22
      Top             =   1470
      Width           =   360
   End
End
Attribute VB_Name = "form_RenWuF"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strfile As String

Private Sub Combo1_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

Private Sub Combo2_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

Private Sub Combo3_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

Private Sub Command1_Click()
On Error GoTo e:
    If fond("T_ARCHIVE_0500_FILE", Text1.text, Text16.text) > 0 Then
            If flag = "Insert" Then
                MsgBox "在室编档号重复的情况下,件号不可重复，请核查!", vbExclamation, ""
                Exit Sub
            ElseIf Not (strfile = Text1.text + Text16.text) Then
                MsgBox "在室编档号重复的情况下,件号不可重复，请核查!", vbExclamation, ""
                Exit Sub
            End If
        End If
        If Text1.text = "" Or Text1.text = " " Then
            MsgBox "请输入室编档号！", vbExclamation, ""
            Exit Sub
        End If
        If Text2.text = "" Or Text2.text = " " Then
            MsgBox "请输入题名！", vbExclamation, ""
            Exit Sub
        End If
        If Text6.text = 0 Then
             MsgBox "页数不能为0!", 48, ""
             Exit Sub
        End If
        If Text7.text = "" Or Text7.text = " " Then
                MsgBox "请输入责任者！", vbExclamation, ""
            Exit Sub
        End If
    If flag = "Insert" Then
        num = id("T_ARCHIVE_0500_FILE")
        strSql = "insert into T_ARCHIVE_0500_FILE ("
        strSql = strSql + "RECORD_SEQUENCE_NUMBER,REFERENCE_CODE_OF_FILE_OFFICE,TITLE_PROPER,STARTING_PHOTO_CODE,MEDIUM_type"
        strSql = strSql + ",SECRET_LEVEL_FOR_DOCUMENTS,RETENTION_PERIOD"
        strSql = strSql + ",DISCRIPTOR,DOCUMENT_CODE,PRIMARY_CREATOR,SUBORDINATE_CREATOR"
        strSql = strSql + ",ELECTRONIC_RECORD_CODE,NEGATIVE_CODE,TAKE_PHOTO_PERSON,DATE_BEGUN"
        strSql = strSql + ",LOCATION,NOTES_OF_ARCHIVIST,REMARK"
        strSql = strSql + ",flag,CLASS_CODE,number_of_page,ARCHIVES_CODE,IS_SHARING"
        strSql = strSql + ")values("
        strSql = strSql + "" & num & ",'" & Text1.text & "' ,'" & Text2.text & "','" & Text3.text & "','" & Combo3.text & "'"
        strSql = strSql + ",'" & Combo1.text & "','" & Combo2.text & "','" & Text5.text & "','" & Text6.text & "'"
        strSql = strSql + ",'" & Text7.text & "','" & Text8.text & "','" & Text9.text & "','" & Text10.text & "'"
        strSql = strSql + ",'" & Text11.text & "','" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" & Text12.text & "','" & Text13.text & "','" & Text14.text & "'"
        strSql = strSql + ",0,'" & form_AnJuan.List1.ListIndex & "'," & Text16.text & ",'" & Text17.text & "','" & Check1.Value & "'"
        strSql = strSql + ")"
    ElseIf flag = "Modify" Then
        strSql = "update T_ARCHIVE_0500_file set "
        strSql = strSql + "REFERENCE_CODE_OF_FILE_OFFICE='" & Text1.text & "'     ,TITLE_PROPER                 ='" & Text2.text & "'     ,STARTING_PHOTO_CODE          ='" & Text3.text & "'     ,MEDIUM_type                  ='" & Combo3.text & "'     "
        strSql = strSql + ",SECRET_LEVEL_FOR_DOCUMENTS   ='" & Combo1.text & "'    ,RETENTION_PERIOD             ='" & Combo2.text & "'    ,DISCRIPTOR                   ='" & Text5.text & "'     ,DOCUMENT_CODE                ='" & Text6.text & "'       "
        strSql = strSql + ",PRIMARY_CREATOR              ='" & Text7.text & "'     ,SUBORDINATE_CREATOR          ='" & Text8.text & "'     ,ELECTRONIC_RECORD_CODE       ='" & Text9.text & "'     ,NEGATIVE_CODE                ='" & Text10.text & "'    "
        strSql = strSql + ",TAKE_PHOTO_PERSON            ='" & Text11.text & "'    ,DATE_BEGUN                   ='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "',LOCATION                     ='" & Text12.text & "'    ,NOTES_OF_ARCHIVIST           ='" & Text13.text & "'    ,REMARK                       ='" & Text14.text & "'    "
        strSql = strSql + ",number_of_page=" & Text16.text & ",ARCHIVES_CODE='" & Text17.text & "',IS_SHARING='" & Check1.Value & "'"
        strSql = strSql + " where RECORD_SEQUENCE_NUMBER=" & num & ""
    End If
    'MsgBox strSql
    rs.Open strSql, conn
    MsgBox "保存成功！", vbInformation, ""
    lblState.Caption = returnInputState(Label2, Text1, Label18, Text10)
    If flag = "Insert" Then
        Text16.text = numberPage("t_archive_0500_file", Text1.text)
        Dim itmX As ListItem
        Set itmX = form_AnJuan.ListView2.ListItems.Add(, , form_AnJuan.ListView2.ListItems.Count + 1)
        itmX.SubItems(1) = num
        itmX.SubItems(2) = Text1.text
        itmX.SubItems(3) = Text2.text
        itmX.SubItems(4) = Text7.text
        itmX.SubItems(5) = Format(DTPicker1.Value, "yyyy-mm-dd")
    End If
    If flag = "Insert" Then
        Text6.text = "0"
    End If
    If flag = "Modify" Then
        form_AnJuan.Refresh
    End If
        Exit Sub
e:
    'MsgBox Err.Number & Err.Description, vbExclamation, ""
    MsgBox "请输入正确数据格式", vbExclamation, ""
    If rs.State = 1 Then
        rs.Close
    End If
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
    SendKeys "{tab}"
    KeyAscii = 0
    End If
End Sub
Private Sub Form_Load()
    backColor = bgColor
    Label1.Caption = form_AnJuan.Label4.Caption + "卷内文件信息"
    Label1.backColor = bgColor
    
    Combo1.AddItem "公开"
    Combo1.AddItem "限制"
    Combo1.AddItem "秘密"
    Combo1.AddItem "机密"
    Combo1.ListIndex = 1
    
    Combo2.AddItem "永久"
    Combo2.AddItem "长期"
    Combo2.AddItem "短期"
    Combo2.ListIndex = 0
    
    Combo3.AddItem "纸质"
    Combo3.AddItem "声像"
    Combo3.AddItem "实物"
    Combo3.AddItem "电子"
    Combo3.AddItem "其它"
    Combo3.ListIndex = 0
    
    Text1.text = ""
    Text2.text = ""
    Text3.text = ""
    Text4.text = ""
    Text5.text = ""
    Text6.text = 0
    Text7.text = ""
    Text8.text = ""
    Text9.text = ""
    Text10.text = 0
    Text11.text = ""
    Text12.text = ""
    Text13.text = ""
    Text14.text = ""
    Text15.text = ""
    Text16.text = 0
    Text17.text = ""
    Text16.MaxLength = 128
    Text15.MaxLength = 5
    DTPicker1.Value = Date
    Text1.MaxLength = 24
    Text2.MaxLength = 1000
    Text3.MaxLength = 6
    Text4.MaxLength = 20
    Text5.MaxLength = 100
    Text6.MaxLength = 5
    Text7.MaxLength = 255
    Text8.MaxLength = 255
    Text9.MaxLength = 50
    Text10.MaxLength = 6
    Text11.MaxLength = 60
    Text12.MaxLength = 100
    Text13.MaxLength = 1000
    Text14.MaxLength = 1000
    Text17.MaxLength = 6
    
    If flag = "Modify" Then
        rs.Open "select * from T_ARCHIVE_0500_FILE where RECORD_SEQUENCE_NUMBER=" & num & "", conn
            If rs!REFERENCE_CODE_OF_FILE_OFFICE <> "" Then
              Text1.text = rs!REFERENCE_CODE_OF_FILE_OFFICE
            End If
            If rs!TITLE_PROPER <> "" Then
              Text2.text = rs!TITLE_PROPER
            End If
            If rs!STARTING_PHOTO_CODE <> "" Then
              Text3.text = rs!STARTING_PHOTO_CODE
            End If
            If rs!MEDIUM_type <> "" Then
              Combo3.text = rs!MEDIUM_type
            End If
            If rs!SECRET_LEVEL_FOR_DOCUMENTS <> "" Then
              Combo1.text = rs!SECRET_LEVEL_FOR_DOCUMENTS
            End If
            If rs!RETENTION_PERIOD <> "" Then
              Combo2.text = rs!RETENTION_PERIOD
            End If
            If rs!DISCRIPTOR <> "" Then
              Text5.text = rs!DISCRIPTOR
            End If
'            If rs!DOCUMENT_CODE <> "" Then
'              Text6.Text = rs!DOCUMENT_CODE
'            End If
            Dim k As Integer
                k = InStr(xml("DOCUMENT_CODE"), "-")
                If k <> 0 Then
                    Text6.text = Mid(xml("DOCUMENT_CODE"), 1, k - 1)
                    Text15.text = Mid(xml("DOCUMENT_CODE"), k + 1)
                Else
                    Text6.text = xml("DOCUMENT_CODE")
                End If
            '页号分段处理
            If rs!PRIMARY_CREATOR <> "" Then
              Text7.text = rs!PRIMARY_CREATOR
            End If
            If rs!SUBORDINATE_CREATOR <> "" Then
              Text8.text = rs!SUBORDINATE_CREATOR
            End If
            If rs!ELECTRONIC_RECORD_CODE <> "" Then
              Text9.text = rs!ELECTRONIC_RECORD_CODE
            End If
            If rs!NEGATIVE_CODE <> "" Then
              Text10.text = rs!NEGATIVE_CODE
            End If
            If rs!TAKE_PHOTO_PERSON <> "" Then
              Text11.text = rs!TAKE_PHOTO_PERSON
            End If
            If rs!DATE_BEGUN <> "" Then
              DTPicker1.Value = rs!DATE_BEGUN
            End If
            If rs!Location <> "" Then
              Text12.text = rs!Location
            End If
            If rs!NOTES_OF_ARCHIVIST <> "" Then
              Text13.text = rs!NOTES_OF_ARCHIVIST
            End If
            If rs!REMARK <> "" Then
              Text14.text = rs!REMARK
            End If
            Text16.text = xml("number_of_page")
            Text17.text = xml("ARCHIVES_CODE")
            If xml("IS_SHARING") <> "" Then
                Check1.Value = xml("IS_SHARING")
            End If
        rs.Close
    End If
    strfile = Text1.text + Text16.text
End Sub


Private Sub Text1_Change()
        If flag = "Insert" Then
            Text16.text = numberPage("t_archive_0500_file", Text1.text)
    End If
End Sub

Private Sub Text16_KeyPress(KeyAscii As Integer)
    If Not (KeyAscii > 47 And KeyAscii < 59) And KeyAscii <> 8 Then
        KeyAscii = 0
        MsgBox "请输入数字!", 48, ""
    End If
End Sub

Private Sub Text6_KeyPress(KeyAscii As Integer)
    If Not (KeyAscii > 47 And KeyAscii < 59) And KeyAscii <> 8 Then
        KeyAscii = 0
        MsgBox "请输入数字!", 48, ""
    End If
End Sub