Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Администратор установил на работе Добавлено: 06.06.09 14:46  

Автор вопроса:  madja
Кто может подскажите, файл с расширением .vbs и кодом описанным ниже.Он создант текстовый файл на диске С:. Отслеживает ли данный код набор с клавиатуры паролей(под звездочками)? И как его можнно на время останавливать для выполнения личных операций?


' Dim fso, f, s
' Set fso = CreateObject("Scripting.FileSystemObject")
' Set f = fso.GetFile("H:\tt8.jpg")
' s = UCase(filespec) & "<BR>"
' s = s & "Created: " & f.DateCreated & "<BR>"
' s = s & "Last Accessed: " & f.DateLastAccessed & "<BR>"
' s = s & "Last Modified: " & f.DateLastModified
' msgbox s
'on error resume next

'putpf("c:\") 59.3
dim a , fso, rfn, dr

  Set fso = CreateObject("Scripting.FileSystemObject")
  Set dr = fso.GetDrive("c:")
  rfn = cstr(dr.SerialNumber)
  rfn = "c:\"+cstr( year( now ) ) +"_"+ cstr( month( now ) ) +"_" + cstr( day( now ) )+"_"+ rfn +".txt"

  Set a = fso.CreateTextFile( rfn, True)
  a.Close
  ssf( "c:\" )

Sub putpf( pth )
  Dim fso, f, SubFolders, nf , ffc, a

  pth = pth + "Program Files"
  Set fso = CreateObject("Scripting.FileSystemObject")
' msgbox format( now , "yyyymmdd")
'msgbox cstr( year( now ) )
  Set a = fso.CreateTextFile("c:\kav\"+cstr( year( now ) ) + cstr( month( now ) ) + cstr( day( now ) )+ ".txt", True)

  Set f = fso.GetFolder(pth)
  Set SubFolders = F.SubFolders

  If SubFolders.Count <> 0 Then
For Each SubFolder In SubFolders
                    a.WriteLine(SubFolder.path)
' msgbox SubFolder.path
Next
  End If

  a.Close
End Sub



Sub ssf( pth )
  Dim fso, f, SubFolders, nf , ffc, a
 
  if instr( lcase( pth ) , lcase("Program Files") ) = 4 then
    exit sub
  end if

  if instr( lcase( pth ) , lcase("windows") ) = 4 then
    exit sub
  end if
  if instr( lcase( pth ) , lcase("System Volume Information") ) = 4 then
    exit sub
  end if
'System Volume Information
  Set fso = CreateObject("Scripting.FileSystemObject")

    
  Set f = fso.GetFolder(pth)
  Set SubFolders = F.SubFolders

  If SubFolders.Count <> 0 Then
For Each SubFolder In SubFolders
ssf(SubFolder.path)
Next

  End If

  Set a = fso.OpenTextFile( rfn , 8, -2)
  Set ffc = f.Files
  For Each f1 in ffc
    if instr( f1.name , ".7z" ) then
                a.WriteLine(pth+"\"+f1.name)
    end if

    if instr( f1.name , ".rar" ) then
                a.WriteLine(pth+"\"+f1.name)
    end if

    if instr( f1.name , ".exe" ) then
                a.WriteLine(pth+"\"+f1.name)
    end if

    if instr( f1.name , ".avi" ) then
                a.WriteLine(pth+"\"+f1.name)
    end if
    if instr( f1.name , ".mpg" ) then
                a.WriteLine(pth+"\"+f1.name)
    end if
    if instr( f1.name , ".mpeg" ) then
                a.WriteLine(pth+"\"+f1.name)
    end if
    if instr( f1.name , ".vmw" ) then
                a.WriteLine(pth+"\"+f1.name)
    end if


    if instr( f1.name , ".mp3" ) then
                a.WriteLine(pth+"\"+f1.name)
    end if
    if instr( f1.name , ".vma" ) then
                a.WriteLine(pth+"\"+f1.name)
    end if

    if instr( f1.name , ".swf" ) then
                a.WriteLine(pth+"\"+f1.name)
    end if

    if instr( f1.name , ".zip" ) then
                a.WriteLine(pth+"\"+f1.name)
    end if

    if instr( f1.name , ".cab" ) then
                a.WriteLine(pth+"\"+f1.name)
    end if
    if instr( f1.name , ".msi" ) then
                a.WriteLine(pth+"\"+f1.name)
    end if
    if instr( f1.name , ".jpg" ) then
' a.WriteLine(pth+"\"+f1.name)
    end if
    if instr( f1.name , ".jpeg" ) then
' a.WriteLine(pth+"\"+f1.name)
    end if
    if instr( f1.name , ".tif" ) then
' a.WriteLine(pth+"\"+f1.name)
    end if
    if instr( f1.name , ".tiff" ) then
' a.WriteLine(pth+"\"+f1.name)
    end if
    if instr( f1.name , ".gif" ) then
' a.WriteLine(pth+"\"+f1.name)
    end if

    if instr( f1.name , ".bmp" ) then
' a.WriteLine(pth+"\"+f1.name)
    end if



  Next
  a.Close

End Sub

'Set fs = CreateObject("Scripting.FileSystemObject")
'fnn = fs.GetAbsolutePathName("c:")
'Set f = fs.GetFolder( fnn )

Ответить

  Ответы Всего ответов: 2  

Номер ответа: 1
Автор ответа:
 VβÐUηìt



Вопросов: 246
Ответов: 3333
  Web-сайт: смекаешь.рф
 Профиль | | #1 		Добавлено: 06.06.09 15:12
  1. ' Dim fso, f, s
  2. ' Set fso = CreateObject("Scripting.FileSystemObject")
  3. ' Set f = fso.GetFile("H:\tt8.jpg")
  4. ' s = UCase(filespec) & "<BR>"
  5. ' s = s & "Created: " & f.DateCreated & "<BR>"
  6. ' s = s & "Last Accessed: " & f.DateLastAccessed & "<BR>"
  7. ' s = s & "Last Modified: " & f.DateLastModified
  8. ' msgbox s
  9. 'on error resume next
  10.  
  11. 'putpf("c:\") 59.3
  12. dim a , fso, rfn, dr
  13.  
  14.   Set fso = CreateObject("Scripting.FileSystemObject")
  15.   Set dr = fso.GetDrive("c:")
  16.   rfn = cstr(dr.SerialNumber)
  17.   rfn = "c:\"+cstr( year( now ) ) +"_"+ cstr( month( now ) ) +"_" + cstr( day( now ) )+"_"+ rfn +".txt"
  18.  
  19.   Set a = fso.CreateTextFile( rfn, True)
  20.   a.Close
  21.   ssf( "c:\" )
  22.  
  23. Sub putpf( pth )
  24.   Dim fso, f, SubFolders, nf , ffc, a
  25.  
  26.   pth = pth + "Program Files"
  27.   Set fso = CreateObject("Scripting.FileSystemObject")
  28. ' msgbox format( now , "yyyymmdd")
  29. 'msgbox cstr( year( now ) )
  30.   Set a = fso.CreateTextFile("c:\kav\"+cstr( year( now ) ) + cstr( month( now ) ) + cstr( day( now ) )+ ".txt", True)
  31.  
  32.   Set f = fso.GetFolder(pth)
  33.   Set SubFolders = F.SubFolders
  34.  
  35.   If SubFolders.Count <> 0 Then
  36. For Each SubFolder In SubFolders
  37.                     a.WriteLine(SubFolder.path)
  38. ' msgbox SubFolder.path
  39. Next
  40.   End If
  41.  
  42.   a.Close
  43. End Sub
  44.  
  45.  
  46.  
  47. Sub ssf( pth )
  48.   Dim fso, f, SubFolders, nf , ffc, a
  49.   
  50.   if instr( lcase( pth ) , lcase("Program Files") ) = 4 then
  51.     exit sub
  52.   end if
  53.  
  54.   if instr( lcase( pth ) , lcase("windows") ) = 4 then
  55.     exit sub
  56.   end if
  57.   if instr( lcase( pth ) , lcase("System Volume Information") ) = 4 then
  58.     exit sub
  59.   end if
  60. 'System Volume Information
  61.   Set fso = CreateObject("Scripting.FileSystemObject")
  62.  
  63.      
  64.   Set f = fso.GetFolder(pth)
  65.   Set SubFolders = F.SubFolders
  66.  
  67.   If SubFolders.Count <> 0 Then
  68. For Each SubFolder In SubFolders
  69. ssf(SubFolder.path)
  70. Next
  71.  
  72.   End If
  73.  
  74.   Set a = fso.OpenTextFile( rfn , 8, -2)
  75.   Set ffc = f.Files
  76.   For Each f1 in ffc
  77.     if instr( f1.name , ".7z" ) then
  78.                 a.WriteLine(pth+"\"+f1.name)
  79.     end if
  80.  
  81.     if instr( f1.name , ".rar" ) then
  82.                 a.WriteLine(pth+"\"+f1.name)
  83.     end if
  84.  
  85.     if instr( f1.name , ".exe" ) then
  86.                 a.WriteLine(pth+"\"+f1.name)
  87.     end if
  88.  
  89.     if instr( f1.name , ".avi" ) then
  90.                 a.WriteLine(pth+"\"+f1.name)
  91.     end if
  92.     if instr( f1.name , ".mpg" ) then
  93.                 a.WriteLine(pth+"\"+f1.name)
  94.     end if
  95.     if instr( f1.name , ".mpeg" ) then
  96.                 a.WriteLine(pth+"\"+f1.name)
  97.     end if
  98.     if instr( f1.name , ".vmw" ) then
  99.                 a.WriteLine(pth+"\"+f1.name)
  100.     end if
  101.  
  102.  
  103.     if instr( f1.name , ".mp3" ) then
  104.                 a.WriteLine(pth+"\"+f1.name)
  105.     end if
  106.     if instr( f1.name , ".vma" ) then
  107.                 a.WriteLine(pth+"\"+f1.name)
  108.     end if
  109.  
  110.     if instr( f1.name , ".swf" ) then
  111.                 a.WriteLine(pth+"\"+f1.name)
  112.     end if
  113.  
  114.     if instr( f1.name , ".zip" ) then
  115.                 a.WriteLine(pth+"\"+f1.name)
  116.     end if
  117.  
  118.     if instr( f1.name , ".cab" ) then
  119.                 a.WriteLine(pth+"\"+f1.name)
  120.     end if
  121.     if instr( f1.name , ".msi" ) then
  122.                 a.WriteLine(pth+"\"+f1.name)
  123.     end if
  124.     if instr( f1.name , ".jpg" ) then
  125. ' a.WriteLine(pth+"\"+f1.name)
  126.     end if
  127.     if instr( f1.name , ".jpeg" ) then
  128. ' a.WriteLine(pth+"\"+f1.name)
  129.     end if
  130.     if instr( f1.name , ".tif" ) then
  131. ' a.WriteLine(pth+"\"+f1.name)
  132.     end if
  133.     if instr( f1.name , ".tiff" ) then
  134. ' a.WriteLine(pth+"\"+f1.name)
  135.     end if
  136.     if instr( f1.name , ".gif" ) then
  137. ' a.WriteLine(pth+"\"+f1.name)
  138.     end if
  139.  
  140.     if instr( f1.name , ".bmp" ) then
  141. ' a.WriteLine(pth+"\"+f1.name)
  142.     end if
  143.  
  144.  
  145.  
  146.   Next
  147.   a.Close
  148.  
  149. End Sub
  150.  
  151. 'Set fs = CreateObject("Scripting.FileSystemObject")
  152. 'fnn = fs.GetAbsolutePathName("c:")
  153. 'Set f = fs.GetFolder( fnn )

Ответить

Номер ответа: 2
Автор ответа:
 SSTREGG



Вопросов: 3
Ответов: 64
  Профиль | | #2 Добавлено: 06.06.09 15:12
Данный код не отслеживает ввод с клавиатуры вообще. Он проходит рекурсией по всему диску 'C:' кроме папок: Program Files, Windows, System Volume Information; и ищет в каждой папке файлы с расширением: 7z, rar, exe, avi, mpg, mpeg, vmw, mp3, vma, swf, zip, cab и msi; и записывает всё это в файл 'c:\год_месяц_день_rfn.txt'.

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам