?? 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -