|
|
马上注册,结识高手,享用更多资源,轻松玩转三维网社区。
您需要 登录 才可以下载或查看,没有帐号?注册
x
添加个窗体,在窗体上添加几个控件可
`) `' G; W. G5 u* ]$ E) UPrivate Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _; F1 s, Q, R( p7 ]+ \6 y
ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
- o3 `: k' x0 W* Y0 d ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
& {8 ^' C' w3 o( P
( X- ^( i# C0 v7 {" v/ oFunction FindFiles(path As String, SearchStr As String, _
3 H6 [- `. @) ^; @- b6 }% c FileCount As Integer, DirCount As Integer)5 c8 a; ?& l) y: H
Dim FileName As String ' Walking filename variable.
% S Q7 C* w( e2 s6 {8 V Dim DirName As String ' SubDirectory Name.& I6 x6 O- J& V, T$ g# ^! Z3 n& p, Y
Dim dirNames() As String ' Buffer for directory name entries.
: e; c1 d4 Z, T! Z. R) j2 S Dim nDir As Integer ' Number of directories in this path.
x! q! r9 v" V! D7 [% ^ c% m2 ?, [ Dim i As Integer ' For-loop counter." O# N" ~5 ]* ^ B
4 M4 }! x. l, p' q k' C& J x
On Error GoTo sysFileERR: S6 K; ?* o5 r6 _
If Right(path, 1) <> "\" Then path = path & "\"+ m- @/ ~/ \0 R9 o8 f K7 ` Y5 v
' Search for subdirectories.
9 Y& x e/ _* s$ p nDir = 04 X1 q6 ~! O3 O$ {0 n
ReDim dirNames(nDir)7 |1 J5 G: c# T/ K' R ]
DirName = Dir(path, vbDirectory Or vbHidden Or vbArchive Or vbReadOnly _
' h; Y1 B2 `, S0 o9 _2 X' BOr vbSystem) ' Even if hidden, and so on.7 o0 }* W: @9 @ Y
Do While Len(DirName) > 0- T; v3 Q) i: r& R$ ?$ \0 S
' Ignore the current and encompassing directories.
) R- @" |% p5 n1 c( v+ H8 O If (DirName <> ".") And (DirName <> "..") Then
/ N) i$ W: g2 i4 x4 x2 T) m; B5 C6 u ' Check for directory with bitwise comparison.
: ^- y/ R- E- t, I6 b/ S If GetAttr(path & DirName) And vbDirectory Then
) n8 m4 D- r: _' N( _ dirNames(nDir) = DirName
4 |- a7 L- r- S1 ]6 O2 X2 ] DirCount = DirCount + 1
( Z; w5 M4 [ P+ m5 J- b. [) f nDir = nDir + 1
# o0 t8 m5 }" L4 } ReDim Preserve dirNames(nDir)
$ t( R! C, q$ q2 f 'listbox2.AddItem path & DirName ' Uncomment to listbox; n; J, L# X' U2 H; Q4 [# e) H1 `
End If ' directories.- L+ A9 n, u2 q& A* p
sysFileERRCont:
. a! a, C0 v. X' U/ W! B- N End If
. D- L2 J' b% g3 s* | DirName = Dir() ' Get next subdirectory.0 @" q+ C8 B- t
Loop
2 u# R. C. d! n! x
3 ]/ A0 O& P4 D" d ' Search through this directory and sum file sizes.( i! g/ K7 J d t# K8 i; { h
FileName = Dir(path & SearchStr, vbNormal Or vbHidden Or vbSystem _* e% N7 N! g# t7 l0 t
Or vbReadOnly Or vbArchive)
# v l1 L$ ~& |2 }( {9 i5 _' @" S While Len(FileName) <> 0% O5 p1 C9 ~% }% s6 [7 D0 T
FindFiles = FindFiles + FileLen(path & FileName)% Y q: M" I1 H2 U$ f) S
FileCount = FileCount + 1( e; R2 w0 s% f0 Z8 F
' Load listbox box$ I: k( j# o" t6 k2 w
ListBox2.AddItem path & FileName '& vbTab & _: o* l5 }3 J- L4 q( x
'FileDateTime(path & FileName) ' Include Modified Date% Z1 e; C0 M2 K. O( d9 x) p
FileName = Dir() ' Get next file.' [. D) k- B. J2 F
Wend! w( r" D2 a% M& O' k: A- l
5 f' V1 u# g, r0 X ' If there are sub-directories..
9 q% v& A/ B$ Q If nDir > 0 Then7 c( e. c* c" _
' Recursively walk into them6 u) O; { c2 u+ n
For i = 0 To nDir - 1
4 x Z& |6 p/ `# a9 h# W( } FindFiles = FindFiles + FindFiles(path & dirNames(i) & "\", _* @# ^! S6 S" n9 {8 T
SearchStr, FileCount, DirCount): U+ l; f% E6 ?9 e) m- l6 K+ S/ @
Next i3 f* N" d7 [& j( d9 B! c: `
End If W. _4 z/ Q- o0 X7 i7 Y0 \
& w0 B# n" W! |& ?" `AbortFunction:
, E6 ?( `, D& @' D6 k; i Exit Function
6 \( H: A8 _& A1 o: J$ e$ B. o' DsysFileERR:
* E; \: v' c5 C If Right(DirName, 4) = ".sys" Then$ `* u+ N/ f, k" {
Resume sysFileERRCont ' Known issue with pagefile.sys- `. [6 a2 O8 b
Else
( j" M. I: J% M, U$ n& t MsgBox "Error: " & Err.Number & " - " & Err.Description, , _
! s r( |( S" w+ d m; x "Unexpected Error"/ A: H$ S; N; s
Resume AbortFunction) D9 \1 I/ J# `" J1 M, l
End If, m2 n6 Z' Z! w( U' i
End Function3 a( x' }0 S1 H2 V- O! n
( }& K0 r2 u7 K- j1 ^. FPrivate Sub CommandButton1_Click()% }, S) y7 d3 p0 e3 R9 ]) q
SearchForm.Hide
$ p, ?( j; \6 Z1 m2 S! @% k7 n2 sEnd Sub
1 U6 B3 V- W! H2 p6 ]3 H" G& }1 W2 a' J: n2 Y
Private Sub Commandbutton2_Click()
( f; ?% O, x* k" ]! W Dim SearchPath As String, FindStr As String
) x7 l! b) H* @0 E7 g( x Dim FileSize As Long
% f0 D4 r3 b8 ]2 H0 p Dim NumFiles As Integer, NumDirs As Integer
/ n8 f* _( {% F# S0 E9 V' c! J2 x# z: L. i3 x
'Screen.MousePointer = vbHourglass
7 y8 `, z/ K) a$ O: G2 |+ ~3 E ListBox2.Clear
4 _( s" ]* U* H5 W' J3 l0 A SearchPath = TextBox1.Text
+ d( H( d8 N5 F7 ? FindStr = "*" & TextBox2.Text & "*" & TextBox3.Text
o$ j6 d, }+ y! E h! I FileSize = FindFiles(SearchPath, FindStr, NumFiles, NumDirs)
m. u d+ b6 U0 q' g7 B TextBox5.Text = NumFiles & " Files found in " & NumDirs + 1 & _
0 a! f3 @! S4 s " Directories"! a6 {) V! t6 j1 ^$ a. K. V5 w
'textbox6.Text = "Size of files found under " & SearchPath & " = " & _
1 p% f3 \# L/ W6 v" ` 'Format(FileSize, "#,###,###,##0") & " Bytes"
# l- Z, {( {( `6 L6 E' S" H4 A 'Screen.MousePointer = vbDefault9 w! N& K+ H7 w* r4 i
If ListBox2.ListCount = 1 Then ListBox2_Click2 _% U, `2 b0 F' g) a* l
End Sub* N; c* N2 V0 D' a4 a7 z- D9 r
9 H+ w% S2 l! i# s1 }: \& X) U! q; c$ B3 ~
Private Sub ListBox2_Click()# u, a6 J8 E: E3 d3 ~
Dim strfilename As String
' R: q/ Z8 t/ o: A; z JIf ListBox2.ListCount >= 1 Then
$ h4 a" Z* o$ Z2 y '如果没有选中的内容,用上一次的列表项。% d) R0 c! W7 [" M. T8 F. |
If ListBox2.ListIndex = -1 Then
3 }+ A- p% ~* K/ C2 S ListBox2.ListIndex = _
: W. I1 M' `- a ListBox2.ListCount - 1; X$ v9 E0 r0 }" T
End If
. V( `& s2 {: y+ h9 s8 e strfilename = ListBox2.List(ListBox2.ListIndex)" j8 s1 ]6 F5 v: r. H2 c2 S, y/ f
+ u: e6 k+ |& `( H& ^
ShellExecute Application.hwnd, "open", strfilename, _
2 T3 {7 R2 q0 S3 t. W vbNullString, vbNullString, 3
0 Y9 ~1 S& ]; m! @; i3 rEnd If
6 s! a2 c% U: \, N
i% M# C1 B4 @
M* K6 R+ O. z8 r' C7 z0 D w DEnd Sub
8 q" x# ?. [( G- C: ?; b' f: d
Public Sub Start(ByVal strfilename As String, ByVal searchfolder As String)
8 i3 b0 G& v: HDim sel& G W& R E6 w( g/ t' f2 b
Dim fs
" k% v2 I K, f7 o0 E& hCommandButton2.Caption = "SEARCH"* l: x* a2 A1 h7 m4 a5 V8 M' V% D
'MsgBox (strfilename)
0 B; i6 D" O7 a( w0 k! s; fstrfilename = Strings.Left(strfilename, 8) '取前八位
$ o X+ Q$ s6 G$ ITextBox1.Text = searchfolder- G1 B# q* `; m9 d" R) o, g6 ~$ c
TextBox2.Text = strfilename
5 p. b' V, T A& ^SearchForm.Show vbModeless
4 |4 J' H$ L- C+ x( n; b7 g" s3 M
) n: Z+ z( l* c f' ~8 r# xIf Strings.Left(strfilename, 2) <> "17" And Strings.Left(strfilename, 2) <> "H7" And Strings.Left(strfilename, 1) <> "S" Then7 m& `% K# X* r
MsgBox ("Not drawings No.")) d8 Q" T7 k# I' i D, M
$ i- \+ S; c3 e) k Exit Sub& E9 _& O8 f5 c" }7 V) m% k6 E2 |
End If2 ^$ q i1 }3 f6 _3 @' A& q. m
0 O5 N5 H0 n) R, `* j7 U 'CommandButton1.Caption = "Use API code"
$ w+ z$ n e8 H& S 4 v! O$ m9 Y3 F# l
' start with some reasonable defaults
9 {: O& Z, L, X/ ?9 v Commandbutton2_Click
7 W) i! p! t8 u* M \5 A N/ {End Sub |
|