mdumun.bas

教学资源管理系统

Attribute VB_Name = "mduMun"


Dim flag(30, 2) As Boolean
Public Sub SetFlag(ByVal i As Integer, ByVal lei As Integer)
   flag(i, lei) = False
End Sub
Public Function TianJiao(ByVal str As String, ByVal Index As Integer) As Integer
    '######################################################
    '函数功能：处理添加菜单
    '######################################################
    On Error Resume Next
myNext:
    fMainForm.dlgCommonDialog.DialogTitle = " 添加" + str
    fMainForm.dlgCommonDialog.ShowOpen
    If Err.Number Then Exit Function
    If Not IsFileExists(fMainForm.dlgCommonDialog.FileName) Then
        MsgBox "该文件不存在！", , "错误"
        GoTo myNext
    End If
    If fMainForm.dlgCommonDialog.FileName <> "" Then
        Dim frmD As frmDaoru
        Dim strTitle As String, strFileName As String, strFileFullName As String
        Dim strDirName As String
        Dim lngSize As Long
        strDirName = "res\" + CStr(Year(Now)) + CStr(Month(Now)) + CStr(Day(Now)) + CStr(Hour(Time)) + CStr(Minute(Time)) + CStr(Second(Time)) + "\"
        Set frmD = New frmDaoru
        frmD.labFile.Caption = fMainForm.dlgCommonDialog.FileName
        Dim i As Integer
        i = 1
        Do While Left(Right(fMainForm.dlgCommonDialog.FileName, i), 1) <> "\"
            i = i + 1
        Loop
        strFileName = Right(fMainForm.dlgCommonDialog.FileName, i - 1)
        strFileFullName = App.Path + "\" + strDirName + strFileName
        frmD.labType.Caption = str
        strTitle = Right(fMainForm.dlgCommonDialog.FileName, i - 1)
        lngSize = Format(FileLen(fMainForm.dlgCommonDialog.FileName) / 1024, "0.00")
        frmD.labFileSize.Caption = CStr(lngSize) + "K"
        i = 1
        Do While Left(Right(fMainForm.dlgCommonDialog.FileName, i), 1) <> "." And i <= Len(fMainForm.dlgCommonDialog.FileName)
            i = i + 1
        Loop
        Dim geshi As String
        If i <= Len(fMainForm.dlgCommonDialog.FileName) Then geshi = Right(fMainForm.dlgCommonDialog.FileName, i - 1)
        strTitle = Left(strTitle, Len(strTitle) - i)
        frmD.txtTitle.Text = strTitle
        frmD.txtZuozhe.Text = strUserName
        frmD.Show vbModal, fMainForm
        If frmD.OK Then
            MkDir App.Path + "\" + strDirName
            FileCopy fMainForm.dlgCommonDialog.FileName, strFileFullName
            Dim UserItem As MSComctlLib.ListItem
            For Each UserItem In frmD.ListView1.ListItems
                If UserItem.Checked Then
                    Dim strYuanDir As String, strYuanFileName As String, strMubiaoDir As String
                    strYuanDir = FileDir(fMainForm.dlgCommonDialog.FileName)
                    strYuanFileName = Right(UserItem.Text, Len(UserItem.Text) - Len(strYuanDir))
                    strMubiaoDir = App.Path + "\" + strDirName
               
                    Do While True
                        i = InStr(1, strYuanFileName, "\")
                        If i = 0 Then Exit Do
                        strMubiaoDir = strMubiaoDir + Left(strYuanFileName, i)
                        MkDir strMubiaoDir
                        strYuanFileName = Right(strYuanFileName, Len(strYuanFileName) - i)
                    Loop
                    If Right(UserItem.Text, 1) = "\" Then
                        Dim cDir As clsDir
                        Set cDir = New clsDir
                        cDir.strMyDir = UserItem.Text
                        cDir.uCopyDir strMubiaoDir
                        Set cDir = Nothing
                    Else
                        If strFileFullName <> strMubiaoDir + strYuanFileName Then
                            FileCopy UserItem.Text, strMubiaoDir + strYuanFileName
                        End If
                    End If
                End If
            Next
            Set cDir = New clsDir
            cDir.strMyDir = App.Path + "\" + strDirName
            lngSize = cDir.uSize / 1024
            lngSize = Format(lngSize, "0.00")
            con.Open
            Dim sql As String
            sql = "select * from info"
            rs.Open sql, con, adOpenKeyset, adLockPessimistic
            rs.AddNew
            rs("type") = str
            rs("filename") = strFileName
            rs("filedir") = strDirName
            rs("kemu") = frmD.cmbKemu.Text
            rs("nianji") = frmD.cmbNianji.Text
            rs("title") = frmD.txtTitle.Text
            rs("zuozhe") = frmD.txtZuozhe.Text
            rs("jieshao") = frmD.txtJieshao
            rs("geshi") = geshi
            rs("size") = CStr(lngSize) + "KB"
            rs("date") = CStr(Date)
            rs("time") = CStr(Time)
            rs("deldate") = "0"
            rs("gongju") = frmD.cmbGongju.Text
            rs.Update
            fMainForm.sbStatusBar.Panels(1).Text = "资源总数 " + CStr(rs.RecordCount)
            rs.Close
            con.Close
        End If
        Unload frmD
    End If
End Function
Public Function LiuLanLeixing(ByVal str As String, ByVal Index As Integer) As Integer
    '######################################################
    '函数功能：处理浏览菜单
    '######################################################
    If str <> "-" Then LoadNewDoc str, Index, 0
            
End Function
Public Function LiuLanNianji(ByVal str As String, ByVal Index As Integer) As Integer
    '######################################################
    '函数功能：处理浏览菜单
    '######################################################
     If str <> "-" Then LoadNewDoc str, Index, 1
            
End Function
Public Function LiuLanKemu(ByVal str As String, ByVal Index As Integer) As Integer
    '######################################################
    '函数功能：处理浏览菜单
    '######################################################
     If str <> "-" Then LoadNewDoc str, Index, 2
            
End Function
Private Sub LoadNewDoc(ByVal strName As String, ByVal Index As Integer, ByVal lei As Integer)
    If flag(Index, lei) Then Exit Sub
    flag(Index, lei) = True
    Dim frmD As frmDocument
    Set frmD = New frmDocument
    frmD.Caption = strName
    frmD.lei = lei
    frmD.MyIndex = Index
    Select Case lei
        Case 0
            frmD.Init ("select * from info where type='" + strName + "' and deldate='0'")
        Case 1
            frmD.Init ("select * from info where nianji='" + strName + "' and deldate='0'")
        Case 2
            frmD.Init ("select * from info where kemu='" + strName + "' and deldate='0'")
    End Select
    frmD.Show
End Sub