模块源代码
Public curName As String
Public curFile As String
Public waitingCopyFile As String
Public curDirec As String
Public OldWindowProc    As Long
文件管理器窗体程序源代码
Option Explicit
Private FormOldWidth    As Long
Private FormOldHeight    As Long
Dim copyFile$
Dim newCopyFile$
Private comdResult As Integer
Private Sub Command1_Click()
On Error GoTo BadFilename
comdResult = -1
File1.FileName = Text1.Text
Dir1.Path = File1.Path
Drive1.Drive = Dir1.Path
File1.Pattern = Combo1.Text
comdResult = 0
Exit Sub
BadFilename:
MsgBox "没有这个文件!"
comdResult = 0
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
curFile = ""
curDirec = Dir1.Path
curName = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dim msg As String
On Error GoTo Drive_er
Dir1.Path = Drive1.Drive
Exit Sub
Drive_er:
If (err = 68) Or (err = 71) Then
msg$ = "驱动器" & Drive1.Drive & "未准备好"""
MsgBox msg$, vbOKOnly
Else
msg$ = "发现我未知错误，错误号=" + Str(err)
MsgBox msg$, vbOKOnly
End If
End Sub
Private Sub File1_Click()
If Right$(Dir1.Path, 1) <> "\" Then
curFile = Dir1.Path & "\" & File1.FileName
Else
curFile = Dir1.Path & File1.FileName
End If
curDirec = ""
waitingCopyFile = File1.FileName
End Sub
Private Sub File1_DblClick()
Dim RetVal, msg$
If comdResult = -1 Then Exit Sub
On Error GoTo err
RetVal = Shell(File1.FileName, 4)
Exit Sub
err:
If RetVal = 0 Then
msg$ = "文件打开错误"
MsgBox msg$, vbOKOnly
End If
End Sub
Private Sub Combo1_Change()
File1.Pattern = Combo1.Text
End Sub
Private Sub Combo1_Click()
File1.Pattern = Combo1.Text
End Sub
Private Sub Form_Load()
Combo1.AddItem "*.*"
Combo1.AddItem "*.bmp"
Combo1.AddItem "*.exe"
Combo1.AddItem "*.doc"
Combo1.AddItem "*.txt"
Command1.Default = True
Text1.Text = ""
File1.Pattern = "*.*"
curFile = ""
curDirec = Dir1.Path
curName = Dir1.Path
Call ResizeInit(Me)
End Sub
Private Sub mnuc_Click(Index As Integer)
copyFile = curFile
newCopyFile = waitingCopyFile
End Sub
Private Sub mnud_Click(Index As Integer)
Dim myDir$, reTempDir$, msg$
Dim lenfile As Integer
On Error GoTo errBad
If curFile <> "" Then
Kill curFile
File1.Refresh
Else
If curDirec <> "" Then
reTempDir = curDirec: myDir$ = curDirec
lenfile = Len(reTempDir)
Do While lenfile <> 1
If Right$(reTempDir, 1) = "\" Then
reTempDir = Left$(reTempDir, lenfile - 1)
If Right$(reTempDir, 1) = ":" Then
reTempDir = reTempDir & "\"
End If
Exit Do
End If
reTempDir = Left$(reTempDir, lenfile - 1)
lenfile = Len(reTempDir)
Loop
If lenfile = 1 Then Exit Sub
Dir1.Path = reTempDir
ChDir Dir1.Path
RmDir myDir$
Dir1.Refresh
End If
End If
Exit Sub
errBad:
If (err = 53) Then
MsgBox "文件名不存在", vbOKOnly
Else
If (err = 75) Then
MsgBox "目录中还存在文件", vbOKOnly
Else
msg$ = "发现未知错误，错误号=" + Str$(err)
MsgBox msg$, vbOKOnly
End If
End If
End Sub
Private Sub mn
un_Click(Index As Integer)
Load Form2
Form2.Show 1
End Sub
Private Sub mnuq_Click(Index As Integer)
Reset
End
End Sub
Private Sub mnut_Click(Index As Integer)
Load Form3
Form3.Show 1
End Sub
Private Sub mnuv_Click(Index As Integer)
Dim finalFile$
On Error GoTo errBad
ChDir curDirec
If Right$(curDirec, 1) <> "\" Then
finalFile$ = curDirec & "\" & newCopyFile
Else
finalFile$ = curDirec & newCopyFile
End If
FileCopy copyFile, finalFile$
File1.Refresh
Exit Sub
errBad:
MsgBox "文件不能自身复制", vbOKOnly
End Sub
Private Sub mnux_Click(Index As Integer)
If curFile = "" Then
MsgBox "请选中一个文件", vbOKOnly
Exit Sub
End If
Load Form4
Form4.Show 1
End Sub
Public Sub ResizeInit(FormName As Form)
Dim Obj    As Control
FormOldWidth = FormName.ScaleWidth
FormOldHeight = FormName.ScaleHeight
On Error Resume Next
For Each Obj In FormName
Obj.Tag = Obj.Left & "  " & Obj.Top & "  " & Obj.Width & "  " & Obj.Height & "  "
Next Obj
On Error GoTo 0
End Sub
Public Sub ResizeForm(FormName As Form)
Dim Pos(4)    As Double
Dim I    As Long, TempPos      As Long, StartPos      As Long
Dim Obj    As Control
Dim ScaleX    As Double, ScaleY      As Double
ScaleX = FormName.ScaleWidth / FormOldWidth
ScaleY = FormName.ScaleHeight / FormOldHeight
On Error Resume Next
For Each Obj In FormName
StartPos = 1
For I = 0 To 4
TempPos = InStr(StartPos, Obj.Tag, "  ", vbTextCompare)
If TempPos > 0 Then
Pos(I) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
StartPos = TempPos + 1
Else
Pos(I) = 0
End If
Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
Next I
Next Obj
On Error GoTo 0
End Sub
Private Sub Form_Resize()
Call ResizeForm(Me)   
Drive1.Left = Label3.Left
Drive1.Top = Label4.Top + Label4.Height
Drive1.Width = Label4.Width
Combo1.Left = Label1.Left
Combo1.Top = Label5.Top + Label5.Height
Combo1.Width = Label5.Width
End Sub
新建文件夹窗体程序源代码
Private Sub Command1_Click()
Dim msg$
On Error GoTo errBad
ChDir Form1.Dir1.Path
MkDir Text1.Text
Form1.Dir1.Refresh
Unload Form2
Exit Sub
errBad:
If (err = 75) Then
MsgBox "路径已经存在或设备未准备好或不存在", vbOKOnly
Else
If (err = 76) Then
MsgBox "路径名错误", vbOKOnly
Else
msg$ = "发现为止错误，错误号=" + Str$(err)
MsgBox msg$, vbOKOnly
End If
End If
End Sub
Private Sub Command2_Click()
Unload Form2
End Sub
重命名窗体程序源代码
Private Sub Command1_Click()
Dim lenPath As Integer
Dim tempName$, msg$
On Error GoTo errBad
If curFile <> "" Then
If Right$(curName, 1) <> "\" Then
tempName$ = curName & "\"
End If
Name curFile As tempName$ & Text1.Text
Form1.File1.Refresh
python和vb的代码可以通用吗
Else
lenPath = Len(curDirec)
tempName$ = curDirec
Do While lenPath <> 1
If Right$(tempName$, 1) = "\" Then
tempName$ = Left$(tempName$, lenPath)
Exit Do
End If
tempName$ = Left$(tempName$, lenPath - 1)
lenPath = Len(tempName$)
Lo
op
If lenPath = 1 Then Exit Sub
Name curDirec As tempName$ & Text1.Text
tempName$ = Left$(tempName$, lenPath - 1)
If Right$(tempName$, 1) = ":" Then
tempName$ = tempName$ & "\"
End If
Form1.Dir1.Path = tempName$
ChDir Form1.Dir1.Path
Form1.Dir1.Refresh
End If
Unload Form3
Exit Sub
errBad:
msg$ = "发现未知错误，错误号=" + Str$(err)
MsgBox msg$, vbOKOnly
End Sub
Private Sub Command2_Click()
Unload Form3
End Sub
文件属性程序源代码
Private Sub Form_Load()
Dim fileAttr As Integer
If curFile <> "" Then
Check1.Value = 0
Check2.Value = 0
Check3.Value = 0
Check4.Value = 0
fileAttr = GetAttr(curFile)
If (fileAttr = 0) Or (fileAttr = 32) Then Check4.Value = 1
If (fileAttr = 1) Or (fileAttr = 33) Then Check1.Value = 1
If (fileAttr = 2) Or (fileAttr = 34) Then Check2.Value = 1
If (fileAttr = 4) Or (fileAttr = 36) Then Check3.Value = 1
If (fileAttr = 3) Or (fileAttr = 35) Then
Check2.Value = 1: Check1.Value = 1
End If
If (fileAttr = 5) Or (fileAttr = 37) Then
Check1.Value = 1: Check3.Value = 1
End If
If (fileAttr = 6) Or (fileAttr = 38) Then
Check2.Value = 1: Check3.Value = 1
End If
If (fileAttr = 7) Or (fileAttr = 39) Then
Check1.Value = 1: Check2.Value = 1: Check3.Value = 1
End If
Else
MsgBox "请选中一个文件", vbOKOnly
End If
End Sub

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。