PDA

View Full Version : تحلیل برنامه



goodman2681
سه شنبه 07 مهر 1388, 18:52 عصر
سلام

من این برنامه رو که از همین سایت گرفتم

و میخواستم دوستان زحمت تحلیلشو بکشن چون من تازه واردم و سر در نیوردم


Option Explicit
Dim AA As Integer
Dim a As Integer
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const MAX_PATH = 260
Dim file_obj As New FileSystemObject
Dim selected_boll As Boolean
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 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 pbMessage As Boolean

Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _
(ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
ByVal lpProcName As String) As Long
Private Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, _
ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lParameter As Long, _
ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Private Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, _
lpExitCode As Long) As Long
Private Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Dim Reg As String, Success As Long
Dim mresult

Public Sub getfiles(Path As String, SubFolder As Boolean, Optional Pattern As String = "*.*")
'AA = 1
'Label4.Caption = "Searching ..."
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long, fPath As String, fName As String

fPath = AddBackslash(Path)

Dim sPattern As String
sPattern = Pattern
fName = fPath & sPattern


hFile = FindFirstFile(fName, WFD)
If (hFile > 0) And ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
lstFl.AddItem (fPath & StripNulls(WFD.cFileName))
End If

If hFile > 0 Then
While FindNextFile(hFile, WFD)
If AA = 1 Then
Label4.Caption = "Searching ..."
Label7.Caption = lstFl.ListCount
DoEvents
If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
lstFl.AddItem (fPath & StripNulls(WFD.cFileName))
End If
End If
Wend

End If

If SubFolder Then


hFile = FindFirstFile(fPath & "*.*", WFD)
If (hFile > 0) And ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) And _
StripNulls(WFD.cFileName) <> "." And StripNulls(WFD.cFileName) <> ".." Then

getfiles fPath & StripNulls(WFD.cFileName), True, sPattern
End If

While FindNextFile(hFile, WFD)
If AA = 1 Then
If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) And _
StripNulls(WFD.cFileName) <> "." And StripNulls(WFD.cFileName) <> ".." Then


getfiles fPath & StripNulls(WFD.cFileName), True, sPattern
End If
End If
Wend

End If
FindClose hFile

End Sub


Private Function StripNulls(f As String) As String
StripNulls = Left$(f, InStr(1, f, Chr$(0)) - 1)
End Function

Private Function AddBackslash(S As String) As String

If Len(S) Then
If Right$(S, 1) <> "\" Then
AddBackslash = S & "\"
Else
AddBackslash = S
End If
Else
AddBackslash = "\"
End If
End Function

Function get_file_name(temp As String)
get_file_name = Right(temp, Len(temp) - InStrRev(temp, "\", Len(temp)))
End Function

Private Sub cmd_search_Click()
a = a + 1
If a = 1 Then
cmd_search.Caption = "&Stop"
AA = 1
Label4.Caption = "Searching ..."
Dim ar As Variant
Dim k As Integer
Dim temp As String
ar = Split(txt_patern.Text, ";", , vbTextCompare)
lstFl.Clear
For k = 0 To UBound(ar)
temp = ar(k)
If chk_sub_dir.Value = 1 Then
Call getfiles(Dir1.Path, True, temp)
Else
Call getfiles(Dir1.Path, False, temp)
End If
Next k
If AA = 1 And Label4.Caption <> "Searching Stopped" And Label4.Caption = "Searching ..." Then
Label4.Caption = "Search Completed."
cmd_search.Caption = "&Search"
a = 0
End If
ElseIf a = 2 Then
cmd_search.Caption = "&Search"
AA = 0
Label4.Caption = "Searching Stopped"
a = 0
End If
End Sub

Private Sub cmdDeleteall_Click()
Dim i As Long
On Error Resume Next
Me.MousePointer = 11

For i = 0 To lstFl.ListCount - 1
Kill lstFl.List(i)

Next i

lstFl.Clear
Me.MousePointer = 0
End Sub

Private Sub cmdnew_Click()
txt_patern.Text = "autoply.exe"
End Sub

Private Sub Command1_Click()
Dim a As Long
On Error Resume Next
Kill (lstFl.Text)
lstFl.RemoveItem (lstFl.ListIndex)
End Sub

Private Sub Command2_Click()
Shell "sfc.exe /scannow", vbNormalFocus
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
On Error GoTo errorH
If file_obj.DriveExists(Mid(Drive1.Drive, 1, 1)) Then
Dir1.Path = Drive1.Drive
End If
Exit Sub
errorH:
If Err.Number = 68 Then
MsgBox "Insert disk into " & Drive1.Drive & "\ drive", vbCritical, "Drive empty"
Drive1.Drive = "C:"
Dir1.Path = Drive1.Drive
Exit Sub
End If
MsgBox Err.Description & " #" & Err.Number
End Sub

Private Sub Form_Load()
AA = 1
End Sub

site-111
سه شنبه 07 مهر 1388, 18:56 عصر
تحلیلش یعنی چی کاملتر توضیح بده!

goodman2681
چهارشنبه 08 مهر 1388, 11:05 صبح
من میخولم داکیو منتشو برا پرژوه ارئه یدم
یعنی توضبحات فارسیش