Question

删除vb中 form

Answer 1

编程环境vb 6.0
把下面代码复制到文本文件，重命名此文本文件为(文件搜索器(API).vbp)
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\WINDOWS\system32\stdole2.tlb#OLE Automation
Object={EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0; shdocvw.dll
Reference=*\G{420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#..\..\..\..\..\WINDOWS\system32\scrrun.dll#Microsoft Scripting Runtime
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; mscomctl.ocx
Form=文件搜索器(API).frm
Startup="Form1"
HelpFile=""
ExeName32="FileSearch.exe"
Command32=""
Name="工程1"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="shiming"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1

[MS Transaction Server]
AutoRefresh=1

把下面代码复制到文本文件，重命名此文本文件为(文件搜索器(API).frm)
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 5640
ClientLeft = 60
ClientTop = 345
ClientWidth = 7995
LinkTopic = "Form1"
ScaleHeight = 5640
ScaleWidth = 7995
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command5
Caption = "删除"
Height = 330
Left = 6360
TabIndex = 12
Top = 0
Width = 1050
End
Begin VB.CommandButton Command4
Caption = "退出"
Height = 330
Left = 6360
TabIndex = 11
Top = 480
Width = 1050
End
Begin VB.PictureBox Picture1
BackColor = &H00FFFFFF&
Height = 2985
Left = 45
ScaleHeight = 2925
ScaleWidth = 2745
TabIndex = 9
Top = 2340
Width = 2805
Begin VB.Image Image1
Height = 2850
Left = 45
Top = 45
Visible = 0 'False
Width = 2670
End
Begin VB.Label Label1
BackColor = &H00FFFFFF&
Caption = "预览区"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 720
TabIndex = 10
Top = 1035
Width = 915
End
End
Begin VB.Frame Frame3
Caption = "搜索类型/文件"
Height = 1320
Left = 45
TabIndex = 5
Top = 945
Width = 2805
Begin VB.CommandButton Command3
Caption = "停止"
Enabled = 0 'False
Height = 285
Left = 1800
TabIndex = 8
Top = 810
Width = 825
End
Begin VB.CommandButton Command2
Caption = "搜索"
Height = 285
Left = 810
TabIndex = 7
Top = 810
Width = 825
End
Begin VB.ComboBox Combo2
Height = 300
Left = 180
TabIndex = 6
Text = "Combo2"
Top = 315
Width = 1815
End
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 285
Left = 0
TabIndex = 4
Top = 5355
Width = 7995
_ExtentX = 14102
_ExtentY = 503
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 2
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 11007
EndProperty
EndProperty
End
Begin MSComctlLib.ListView ListView1
Height = 4470
Left = 2925
TabIndex = 3
Top = 855
Width = 5010
_ExtentX = 8837
_ExtentY = 7885
MultiSelect = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin VB.Frame Frame1
Caption = "搜索路径"
Height = 690
Left = 45
TabIndex = 0
Top = 90
Width = 5685
Begin VB.CommandButton Command1
Caption = "浏览"
Height = 285
Left = 4365
TabIndex = 2
Top = 270
Width = 825
End
Begin VB.TextBox Text1
Height = 285
Left = 180
TabIndex = 1
Text = "C:\"
Top = 270
Width = 3795
End
End
Begin VB.Menu popMenu
Caption = "popMenu"
Visible = 0 'False
Begin VB.Menu mnuCopy
Caption = "复制到..."
End
Begin VB.Menu mnuSelectAll
Caption = "全选"
End
Begin VB.Menu mnuRevSelect
Caption = "反向选择"
End
Begin VB.Menu mnuSelectNone
Caption = "取消选择"
End
Begin VB.Menu mm
Caption = "-"
End
Begin VB.Menu mnuDel
Caption = "删除"
End
Begin VB.Menu mnuRename
Caption = "重命名"
End
Begin VB.Menu mnuAttr
Caption = "属性"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SHGetPathFromIDList Lib "Shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "Shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Type BROWSEINFO '用于选择目录对话框的结构
hOwer As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
ilmage As Long
End Type
Private Const BIF_RETURNONLYFSDIRS = &H1 '此常数的值待查
Private lindex As Long
Private Pflag As Boolean
'以下为显示文件属性对话框时用到的声明
Private Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
' Optional fields
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
Private Const SEE_MASK_INVOKEIDLIST = &HC
Private Const SEE_MASK_NOCLOSEPROCESS = &H40
Private Const SEE_MASK_FLAG_NO_UI = &H400
Private SEI As SHELLEXECUTEINFO
Private Declare Function ShellExecuteEX Lib "Shell32.dll" Alias "ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long
'以下为利用API查找文件的声明
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const MAX_PATH = 260
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Private Sub Command1_Click()
Dim bi As BROWSEINFO
Dim rtn As String, pidl As String, path As String
Dim pos As Long
bi.hOwer = Me.hwnd
bi.lpszTitle = "请选择目录" '选择目录对话框
bi.ulFlags = BIF_RETURNONLYFSDIRS
pidl = SHBrowseForFolder(bi)
path = Space(512)
SHGetPathFromIDList pidl, path
pos = InStr(path, Chr(0))
rtn = Left(path, pos - 1)
If rtn = "" Then Exit Sub
Text1.Text = rtn
End Sub

Private Sub Command2_Click()
Dim fso As New FileSystemObject
On Error Resume Next
Pflag = False
Command3.Enabled = True
ListView1.ListItems.Clear
lindex = 1
Command2.Enabled = False
Screen.MousePointer = vbHourglass
StatusBar1.Panels(1).Text = "请稍侯..."
FindFile Trim(Text1.Text), Trim(Combo2.Text) '调用搜索过程
Command2.Enabled = True
Command3.Enabled = False
Screen.MousePointer = 0
StatusBar1.Panels(2).Text = "共有" & ListView1.ListItems.Count & "个文件"
StatusBar1.Panels(1).Text = "就绪"
End Sub
Private Sub FindFile(sPath As String, sFile As String)
Dim xf As WIN32_FIND_DATA
Dim ff As WIN32_FIND_DATA
Dim findhandle As Long
Dim lFindFile As Long
Dim Dstr As String
Dim fso As New FileSystemObject
Dim f As File
Dim cPath As String

On Error Resume Next
cPath = IIf(Len(sPath) > 3, sPath & "\", sPath)
lFindFile = FindFirstFile(cPath & sFile, ff)
StatusBar1.Panels(2).Text = "正在搜索 " & sPath
If lFindFile > 0 Then
Do
Set f = fso.GetFile(cPath & ff.cFileName)
ListView1.ListItems.Add lindex, , f.Name
ListView1.ListItems(lindex).SubItems(1) = f.ParentFolder
ListView1.ListItems(lindex).SubItems(2) = IIf(f.Size < 1024, Format(f.Size, "#### Byte"), Format(f.Size \ 1024, "###### KB"))
ListView1.ListItems(lindex).SubItems(3) = f.Type
ListView1.ListItems(lindex).SubItems(4) = Left(f.DateLastModified, Len(CStr(f.DateLastModified)) - 3)
lindex = lindex + 1
Loop Until (FindNextFile(lFindFile, ff) = 0)
FindClose lFindFile
If Pflag Then Exit Sub
End If
findhandle = FindFirstFile(cPath & "*.*", xf)
DoEvents
Do '注意这处判断是否为目录应使用与运算
If (xf.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
If Asc(xf.cFileName) <> Asc(".") Then
Dstr = cPath + Left(xf.cFileName, InStr(xf.cFileName, Chr(0)) - 1)
FindFile Dstr, sFile
End If
End If
If Pflag Then
FindClose findhandle
Exit Sub
End If
Loop Until (FindNextFile(findhandle, xf) = 0)
FindClose findhandle
End Sub

Private Sub Command3_Click()
Pflag = True
End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Command5_Click()
Dim i As Integer
i = ListView1.ListItems.Count

Do While i > 0
Kill ListView1.ListItems(i).SubItems(1) & "\" & ListView1.ListItems(i)
i = i - 1
Loop
MsgBox "文件已经全部删除完毕!～"
End Sub

Private Sub Form_Load()
ListView1.View = lvwReport
ListView1.ColumnHeaders.Add , , "文件名称"
ListView1.ColumnHeaders.Add , , "所在文件夹"
ListView1.ColumnHeaders.Add , , "大小"
ListView1.ColumnHeaders.Add , , "类型"
ListView1.ColumnHeaders.Add , , "修改日期"
ListView1.ColumnHeaders(2).Width = 3200
Combo2.AddItem "*.mp3"
Combo2.AddItem "*.wav"
Combo2.AddItem "*.mid"
Combo2.AddItem "*.gif"
Combo2.AddItem "*.avi"
Combo2.AddItem "*.rm"
Combo2.AddItem "*.swf"
Combo2.AddItem "*.jpg"
Combo2.AddItem "*.cur"
Combo2.AddItem "*.ico"
Combo2.Text = ""
Combo2.ListIndex = 0
End Sub

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim Fpath As String
On Error Resume Next
Image1.Stretch = False
Image1.Picture = LoadPicture(GPath(ListView1.SelectedItem.Index) & ListView1.SelectedItem.Text)
If Image1.Picture <> 0 Then
Label1.Visible = False
If Image1.Width > Picture1.ScaleWidth Then
Image1.Stretch = True
Image1.Width = Picture1.ScaleWidth
Image1.Left = 0
Else
Image1.Left = (Picture1.ScaleWidth - Image1.Width) / 2
End If
If Image1.Height > Picture1.ScaleHeight Then
Image1.Stretch = True
Image1.Height = Picture1.ScaleHeight
Image1.Top = 0
Else
Image1.Top = (Picture1.ScaleHeight - Image1.Height) / 2
End If
Image1.Visible = True
End If
End Sub

Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
PopupMenu popMenu
End If
End Sub

Private Sub mnuAttr_Click() '显示文件属性对话框
On Error Resume Next
With SEI
.cbSize = Len(SEI)
.fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
.hwnd = Form1.hwnd
.lpVerb = "properties"
.lpFile = GPath(ListView1.SelectedItem.Index) & ListView1.SelectedItem.Text
.lpDirectory = vbNullChar
.lpParameters = vbNullChar
.nShow = 0
.hInstApp = 0
.lpIDList = 0
.lpClass = vbNullChar
.hkeyClass = 0
.dwHotKey = 0
.hProcess = 0
.hIcon = 0
End With
ShellExecuteEX SEI
End Sub

Private Sub mnuCopy_Click()
Dim bi As BROWSEINFO
Dim rtn As String, pidl As String, path As String
Dim pos As Long
Dim fso As New FileSystemObject
Dim i As Long
bi.hOwer = Me.hwnd
bi.lpszTitle = "请选择目标文件夹"
bi.ulFlags = BIF_RETURNONLYFSDIRS
pidl = SHBrowseForFolder(bi)
path = Space(512)
SHGetPathFromIDList pidl, path
pos = InStr(path, Chr(0))
rtn = Left(path, pos - 1)
If rtn = "" Then Exit Sub
If Right(rtn, 1) <> "\" Then rtn = rtn & "\"
For i = 1 To ListView1.ListItems.Count
If ListView1.ListItems(i).Selected Then
fso.CopyFile GPath(i) & ListView1.ListItems(i).Text, rtn, True
End If
Next i
End Sub
Private Function GPath(i As Long)
GPath = IIf(Len(ListView1.ListItems(i).SubItems(1)) > 3, ListView1.ListItems(i).SubItems(1) & "\", ListView1.SelectedItem.SubItems(1))
End Function

Private Sub mnuDel_Click()
Dim fso As New FileSystemObject
Dim i As Long
Dim listCount As Long
For i = 1 To ListView1.ListItems.Count
If ListView1.ListItems(i).Selected Then
fso.DeleteFile GPath(i) & ListView1.ListItems(i).Text
End If
Next i
listCount = ListView1.ListItems.Count
Do While listCount > 0
If ListView1.ListItems(listCount).Selected Then
ListView1.ListItems.Remove listCount
End If
listCount = listCount - 1
Loop
End Sub

Private Sub mnuRename_Click()
Dim tmp As String
tmp = InputBox("将文件名改为：", "文件改名", ListView1.SelectedItem.Text)
On Error GoTo err
Name GPath(ListView1.SelectedItem.Index) & ListView1.SelectedItem.Text As GPath(ListView1.SelectedItem.Index) & tmp
ListView1.SelectedItem.Text = tmp
err:
End Sub

Private Sub mnuRevSelect_Click()
Dim i As Long
For i = 1 To ListView1.ListItems.Count
ListView1.ListItems(i).Selected = Not ListView1.ListItems(i).Selected
Next
End Sub

Private Sub mnuSelectAll_Click()
Dim i As Long
For i = 1 To ListView1.ListItems.Count
ListView1.ListItems(i).Selected = True
Next i
End Sub

Private Sub mnuSelectNone_Click()
Dim i As Long
For i = 1 To ListView1.ListItems.Count
ListView1.ListItems(i).Selected = False
Next
End Sub

Answer 2

在 右边的视图里的要删除的form上右击移除就可以了