1. Теперь за форумную активность начисляются биткоины и другие криптоденьги. Подробнее.
    Скрыть объявление
  2. Появилась архивная версия форума arhiv.xaker.name, где собраны темы с 2007 по 2012 год.
    Скрыть объявление

VB6. Играем трекерную музыку, как в keygen

Тема в разделе "Visual Basic", создана пользователем chimatii, 4 дек 2010.

  1. chimatii
    chimatii Глобальный модератор
    Симпатии:
    101
    На форумах по Visual Basic-у и на других форумах и сайтах мне довольно часто встречались вопросы вида "как в vb играть музыку как в keygen?" или "как играть трекерную музыку vb6?" Собственно, мне эта идея была непонятна: насколько я знал, keygen-ы и прочие крекерские прелести на VB
    [+] не пишутся
    их же лозунги: "VB - отстой, ASM рулит", ну а мне для написания моих калькуляторов его с верхом хватает))
    [свернуть]
    Чуть позже я начал встречать программы, в окошке "About" которых также играла музыка. И вот тут мне то и стало интересно: как это делается?

    Музыка в keygen-ах - трекерная музыка формата *.xm, *.mod, редко *.s3m или *.it. Возпроизвести ее можно при помощи спец. библиотек (www.fmod.org), там же на сайте находится порт для C++. Даже для Delphi товарищем coban2k написан mini-fmod port, а вот для VB6 ничего не нашлось. Решение проблемы, хоть и не совсем рациональное, я нашел: отсюда была скачана консольная версия fmod-плеера весом всего 11 Кб! (Хотя заявлено что 6 :))
    Идея заключалась в следующем: прикрепить к проекту на VB resource-файл, засунуть в него плеер и xm-файл с трекерной музыкой, а при запуске нужной нам формы распаковывать их и запускать с нужными параметрами, при закрытии программы - удалять с диска

    Вот собственно само решение. Создаем стандартный проект, далее добавляем в список используемых модулей редактор ресурсов:

    Далее выбираем его на тулбаре, находим кнопку "Add Custom Resource..." и добавляем наш звуковой файл и плеер.exe с именами 101 и 102 соответственно.
    Теперь добавим жизненно важный модуль для уничтожения процессов:

    Вбиваем в него следующий код:

    Код:
    Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * 260
    End Type
    
    Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
    End Type
    
    Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
    Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
    Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
    Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
    Private Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
    Private Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
    Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
    Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
    Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
    Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
    Private Const PROCESS_TERMINATE = &H1
    Private Const VER_PLATFORM_WIN32_WINDOWS = 1
    Private Const PROCESS_QUERY_INFORMATION = 1024
    Private Const PROCESS_VM_READ = 16
    Private Const TH32CS_SNAPPROCESS = &H2
    Private Function CheckVersion() As Long
    Dim tOS As OSVERSIONINFO
    tOS.dwOSVersionInfoSize = Len(tOS)
    Call GetVersionEx(tOS)
    CheckVersion = tOS.dwPlatformId
    End Function
    
    Public Function GetEXEProcessID(ByVal sEXE As String) As Long
    Dim aPID() As Long
    Dim lProcesses As Long
    Dim lProcess As Long
    Dim lModule As Long
    Dim sName As String
    Dim iIndex As Integer
    Dim bCopied As Long
    Dim lSnapShot As Long
    Dim tPE As PROCESSENTRY32
    Dim bDone As Boolean
    If CheckVersion() = VER_PLATFORM_WIN32_WINDOWS Then    'Windows 9x    'Create a SnapShot of the Currently Running Processes
    lSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
    If lSnapShot < 0 Then Exit Function
    tPE.dwSize = Len(tPE)    'Buffer the First Processes Info..
    bCopied = Process32First(lSnapShot, tPE)
    Do While bCopied      'While there are Processes List them..
    sName = Left$(tPE.szExeFile, InStr(tPE.szExeFile, Chr(0)) - 1)
    sName = Mid(sName, InStrRev(sName, "\") + 1)
    If InStr(sName, Chr(0)) Then
    sName = Left(sName, InStr(sName, Chr(0)) - 1)
    End If
    bCopied = Process32Next(lSnapShot, tPE)
    If StrComp(sEXE, sName, vbTextCompare) = 0 Then
    GetEXEProcessID = tPE.th32ProcessID
    Exit Do
    End If
    Loop
    Else    'Windows NT    'The EnumProcesses Function doesn't indicate how many Process there are,    'so you need to pass a large array and trim off the empty elements    'as cbNeeded will return the no. of Processes copied.
    ReDim aPID(255)
    Call EnumProcesses(aPID(0), 1024, lProcesses)
    lProcesses = lProcesses / 4
    ReDim Preserve aPID(lProcesses)
    For iIndex = 0 To lProcesses - 1      'Get the Process Handle, by Opening the Process
    lProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, aPID(iIndex))
    If lProcess Then        'Just get the First Module, all we need is the Handle to get        'the Filename..
    If EnumProcessModules(lProcess, lModule, 4, 0&) Then
    sName = Space(260)
    Call GetModuleFileNameExA(lProcess, lModule, sName, Len(sName))
    If InStr(sName, "\") > 0 Then
    sName = Mid(sName, InStrRev(sName, "\") + 1)
    End If
    If InStr(sName, Chr(0)) Then
    sName = Left(sName, InStr(sName, Chr(0)) - 1)
    End If
    If StrComp(sEXE, sName, vbTextCompare) = 0 Then
    GetEXEProcessID = aPID(iIndex)
    bDone = True
    End If
    End If
    lRet = CloseHandle(lProcess)
    If bDone Then Exit For
    End If
    Next
    End If
    End Function
    Public Function TerminateEXE(ByVal sEXE As String) As Boolean
    Dim lPID As Long
    Dim lProcess As Long
    lPID = GetEXEProcessID(sEXE)
    If lPID = 0 Then Exit Function
    lProcess = OpenProcess(PROCESS_TERMINATE, 0, lPID)
    Call TerminateProcess(lProcess, 0&)
    Call CloseHandle(lProcess)
    TerminateEXE = True
    End Function
    Теперь возвращаемя к нашей форме. Жмем на нее два раза мышкой и в открывшийся код функции Form_Load() пишем:

    Код:
    Dim bin_data() As Byte, nf As Integer 'задаем переменные
    nf = FreeFile()
    
    Open Environ("windir") & "\Temp\audio.xm" For Binary Access Write As nf 'открываем C:\Windows\Temp\audio.xm для записи
    bin_data = LoadResData(101, "CUSTOM") ' присваиваем массиву данные из ресурсов
    Put nf, , bin_data ' сохраняем на диск наш xm-файл
    Close nf ' закрываем
    Erase bin_data ' очищаем массив
    
    Open Environ("windir") & "\Temp\fmod.exe" For Binary Access Write As nf 'открываем C:\Windows\Temp\fmod.ex для записи
    bin_data = LoadResData(102, "CUSTOM") ' присваиваем массиву данные из ресурсов
    Put nf, , bin_data ' сохраняем на диск наш плеер
    Close nf ' закрываем
    Erase bin_data ' очищаем массив
    
    Call Shell(Environ("windir") + "\Temp\fmod.exe " + Environ("windir") + "\Temp\audio.xm", vbHide) '  запускаем плеер с параметрами для открытия нашего audio.xm в скрытом режиме
    При закрытии формы музыку надо будет выключить и хвосты за собой потереть. Добавим код, отвечающий за поведение программы при закрытии формы

    Код:
    Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next 'не тормозим если ошибка
    Call TerminateEXE("fmod.exe") 'убиваем процесс fmod.exe
    Call Kill(Environ("windir") & "\Temp\audio.xm") ' удаляем xm-файл
    Call Kill(Environ("windir") & "\Temp\fmod.exe") ' удаляем плеер
    End Sub
    Вроде как все! Теперь при загрузке формы будет играть музыка, прямо как в keygen-е)) Готовый пример "About"-окна можно скачать из вложений.
     

    Вложения:

    • sources.zip
      Размер файла:
      35,1 КБ
      Просмотров:
      102
    4 дек 2010
    5 пользователям это понравилось.
  2. 500mhz
    500mhz Новичок
    Симпатии:
    0
    ну вообшето есть bass.dll для этих целей http://www.un4seen.com/ так что баян )))
     
    4 дек 2010
  3. onthar
    onthar Команда форума Админ
    Симпатии:
    388
    с каких пор у нас нестандартный подход - боян?
     
    4 дек 2010
    1 человеку нравится это.
  4. chimatii
    chimatii Глобальный модератор
    Симпатии:
    101
    500mhz,
    увы мы с тобой находимся на разных уровнях)) если для тебя это баян то для меня это способ решения проблемы (решения которой я увы не увидел и не нашел, спасибо если бы ты мне подкинул идею), может и не совсем рационально придумал))
     
    Последнее редактирование: 4 дек 2010
    4 дек 2010
  5. 500mhz
    500mhz Новичок
    Симпатии:
    0
    не совсем гуд просто что то там на диск извлекать а потом удалять
     
    5 дек 2010
  6. lytgeygen
    lytgeygen pacifiste maniaque Новичок
    Симпатии:
    112
    можно конечно использовать миди, и готовые модули. Будет куда проще...

    Добавлено через 3 минуты
    http://zalil.ru/30275283
     
    Последнее редактирование: 5 янв 2011
    5 янв 2011
  7. chimatii
    chimatii Глобальный модератор
    Симпатии:
    101
    lytgeygen, конечно можно, и это намного легче) но здесь описан способ проигрывания именно трекерной музыки, а миди в кейгенах не используют
     
    7 янв 2011
  8. h[e]top
    h[e]top Новичок
    Симпатии:
    0
    Используя bass.dll тоже придется распаковывать его на диск (либо в system32 либо в папку с программой) так же сам *.xm файл тоже придется распаковывать.
    Использовать midi? глупость. Трекеры были созданы потому что midi на разных машинах играли по разному (подробнее гуглим историю трекерной музыки)
    Есть способ намного лучше. uFMOD
    • 1. Он умеет воспроизводить напрямую из ресурсов
    • 2. Ничего не надо распаковывать на диск, он вшивается в программу патченным линком.
    • 3. Вес готовой программы (форма с кнопками play и stop) весит 19Кб (ну тут еще зависит от самого *.xm файла)
    Все необходимое есть в архиве.
    Небольшая инструкция.
    • 1. В папку с проектом распаковываете все из папки FMODFILES
    • 2. В папке с установленным VB6 файл LINK.EXE переименовываем в LNK.EXE
    • 3. В папку с установленным VB6 распаковываем все из папки FMODLINKS
    • 4. Добавляем в проект модуль uF_vb.bas и файл ресурсов Resource.RES (чтобы изменить сам трек используйте Resource Hacker так как встроенный редактор не может добавить файлы в RCDATA
    Теперь немного кода:
    Код:
    'Декларирование функции
    Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pDat As Any, pSrc As Any, ByVal Bytelen As Long)
    
    'Воспроизвести файл
    uFMOD_PlaySong 1, 0, XM_RESOURCE
    
    'Останавливаем воспроизведение
    uFMOD_PlaySong 0, 0, 0
    В папке build лежит уже готовый *.exe весом в 19Кб.
    P.S. При создании из за измененных линков невозможно запустить программу в режиме отладки. Сначала компилируем, потом запускаем уже готовый *.exe.

    Если будут какие вопросы, пишите на почту hetop@ya.ru
     
    1 мар 2016

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

Загрузка...