Инструменты, готовые модули, полезные коды.

Тема в разделе "VB", создана пользователем Thetrik, 8 дек 2016.

  1. Thetrik

    Thetrik UA6527P

    Публикаций:
    0
    Регистрация:
    25 июл 2011
    Сообщения:
    863
    Здесь планируется выкладывать Add-in'ы, готовые модули, какие-либо полезные коды.
     
  2. Thetrik

    Thetrik UA6527P

    Публикаций:
    0
    Регистрация:
    25 июл 2011
    Сообщения:
    863
    Класс для копирования в отдельном потоке с отображением прогресса.
    Бывает ситуация, когда нужно скопировать большой файл(ы), при этом стандартная ф-ция FileCopy вешает всю программу до тех пор, пока не закончится копирование. Я разработал класс, в котором используется возможности ф-ции CopyFileEx (использовал ANSI версию), отображение прогресса копирования и возможности отмены, а также многопоточность для запуска всех функций в фоновом потоке. При запущенном процессе копирования, нельзя останавливать среду кнопкой стоп, только закрытием (нужно обязательно вызывать деструктор класса), иначе возможны глюки. Также желательно не запускать одновременно копирование большого количества файлов т.к. на каждое копирование создается отдельный поток, и при большом их количестве будут тормоза. Для отдельного потока использовал ассемблерную вставку со следующим кодом:
    Код (ASM):
    1. ; Основная функция вызываемая в новом потоке при копировании
    2. Copy:
    3.     xor eax,eax     ; eax <- 0
    4.     push eax        ; Локальная переменная pbCancel
    5.     mov ecx,esp     ; Сохраняем адрес переменной
    6.     push eax        ; dwCopyFlags
    7.     push ecx            ; Указатель на pbCancel
    8.     push eax        ; lpData
    9.     push 0x0        ; lpProgressRoutine
    10.     push 0x0        ; lpNewFileName
    11.     push 0x0        ; lpExitingFileName
    12.     call 0x0        ; Вызов CopyFileEx
    13.     mov dword [0],eax   ; Возвращаемое значение
    14.     xor eax,eax     ; dwExitCode
    15.     call 0x0        ; Вызов ExitThread
    16. ; Функция обратного вызова CopyProgressRoutine
    17. CopyProgressRoutine:
    18.     fild qword [esp+12]     ; LARGE_INTEGER в вещественное число TotalBytesTransferred
    19.     fild qword [esp+4]  ; LARGE_INTEGER в вещественное число TotalFileSize
    20.     fdivp           ; делим на TotalFileSize
    21.     fstp dword [0]      ; Сохраняем в переменную
    22.     mov eax, dword [0]  ; Возвращаемое значение
    23.     ret 0x34
    Вместо нулей, вписываются данные походу в процедурах LoadStaticValue - это те, которые не будут изменяться и LoadDynamicValue - это имена файлов. Использовать класс можно и один для нескольких копирований или же несколько для одновременного копирования.
    PS. Т.к. не рекомендуется завершать потоки через TerminateThread, я использовал ExitThread в самом потоке, поэтому при большом количестве файлов, обрабатываемых одновременно, при закрытии окна, каждый класс ждет завершения своего потока и VB6 замирает на это время.
    [​IMG]
     

    Вложения:

  3. Thetrik

    Thetrik UA6527P

    Публикаций:
    0
    Регистрация:
    25 июл 2011
    Сообщения:
    863
    Модуль с расширенными математическими функциями для вещественных и комплексных чисел.
    1. Deg - из градусов в радианы;
    2. LogX - логарифм по основанию X;
    3. Log10 - десятичный логарифм;
    4. Log2 - двоичный логарифм;
    5. Ceil - округление в большую сторону;
    6. Floor - округление в меньшую сторону;
    7. Sec - секанс вещественного числа;
    8. Csc - косеканс вещественного числа;
    9. Ctg - котангенс вещественного числа;
    10. Asin - арксинус вещественного числа;
    11. Acos - арккосинус вещественного числа;
    12. Asec - арксеканс вещественного числа;
    13. Acsc - арккосеканс вещественного числа;
    14. Atan2 - угол чей тангенс равен отношению двух величин;
    15. Actg - арккотангенс вещественного числа;
    16. Sinh - гиперболический синус вещественного числа;
    17. Cosh - гиперболический косинус вещественного числа;
    18. Tanh - гиперболический тангенс вещественного числа;
    19. Ctgh - гиперболический котангенс вещественного числа;
    20. Sech - гиперболический секанс вещественного числа;
    21. Csch - гиперболический косеканс вещественного числа;
    22. Asinh - гиперболический арксинус вещественного числа;
    23. Acosh - гиперболический арккосинус вещественного числа;
    24. Atanh - гиперболический арктангенс вещественного числа;
    25. Actan - гиперболический арккотангенс вещественного числа;
    26. Asech - гиперболический арксеканс вещественного числа;
    27. Acsch - гиперболический арккосеканс вещественного числа;
    28. Max - максимум двух чисел;
    29. Max3 - максимум трех чисел;
    30. Max4 - максимум четырех чисел;
    31. Min - минимум двух чисел;
    32. Min3 - минимум трех чисел;
    33. Min4 - минимум четырех чисел;
    34. IEEERemainder - остаток от деления вещественных чисел;
    35. rMod - остаток от деления вещественных чисел;
    36. cxOne - комплексная единица;
    37. cxImgOne - мнимая единица;
    38. cxZero - нулевое комплексное число;
    39. cxNew - создание нового комплексного числа;
    40. cxPolar - создание нового комплексного числа по полярным координатам;
    41. cxNeg - аддитивная инверсия комплексного числа;
    42. cxInv - мультипликативная инверсия комплексного числа;
    43. cxAdd - сложение двух комплексных чисел;
    44. cxSub - вычитание двух комплексных чисел;
    45. cxMul - умножение двух комплексных чисел;
    46. cxDiv - деление двух комплексных чисел;
    47. cxDgr - возведение комплексного числа в вещественную степень;
    48. cxSqr - квадратный корень комплексного числа;
    49. cxMod - модуль комплексного числа;
    50. cxPhase - фаза комплексного числа;
    51. cxArg - аргумент комплексного числа;
    52. cxExp - комплексная экспонента;
    53. cxAddReal - сложение комплексного и вещественного числа;
    54. cxSubReal - вычитание из комплексного числа вещественного;
    55. cxRealSub - вычитание комплексного числа из вещественного;
    56. cxMulReal - умножение комплексного числа на вещественное;
    57. cxDivReal - деление комплексного числа на вещественное;
    58. cxRealDiv - деление вещественного числа на комплексное;
    59. cxAddImg - добавить вещественное число к мнимой части;
    60. cxSubImg - вычесть вещественное число из мнимой части;
    61. cxImgSub - вычесть из мнимой части заданной как вещественное комплексного числа;
    62. cxMulImg - умножение комплексного числа на мнимую часть;
    63. cxDivImg - деление комплексного числа на мнимую часть;
    64. cxImgDiv - деление мнимой части на комплексное число;
    65. cxEq - проверить, являются ли комплексные числа равными;
    66. cxAbs - абсолютное значение комплексного числа;
    67. cxConj - сопряжение комплексного числа;
    68. cxLog - натуральный логарифм комплексного числа;
    69. cxLogX - логарифм комплексного числа по основанию X;
    70. cxSin - синус комплексного числа;
    71. cxCos - косинус комплексного числа;
    72. cxTan - тангенс комплексного числа;
    73. cxCtg - котангенс комплексного числа;
    74. cxSec - секанс комплексного числа;
    75. cxCsc - косеканс комплексного числа;
    76. cxAsin - арксинус комплексного числа;
    77. cxAcos - арккосинус комплексного числа;
    78. cxAtan - арктангенс комплексного числа;
    79. cxActg - арккотангенс комплексного числа;
    80. cxAsec - арксеканс комплексного числа;
    81. cxAcsc - арккосеканс комплексного числа;
    82. cxSinh - гиперболический синус комплексного числа;
    83. cxCosh - гиперболический косинус комплексного числа;
    84. cxTanh - гиперболический тангенс комплексного числа;
    85. cxCtgh - гиперболический котангенс комплексного числа;
    86. cxSech - гиперболический секанс комплексного числа;
    87. cxCsch - гиперболический косеканс комплексного числа;
    88. cxAsinh - гиперболический арксинус комплексного числа;
    89. cxAcosh - гиперболический арккосинус комплексного числа;
    90. cxAtanh - гиперболический арктангенс комплексного числа;
    91. cxActgh - гиперболический арккотангенс комплексного числа;
    92. cxAsech - гиперболический арксеканс комплексного числа;
    93. cxAcsch - гиперболический арккосеканс комплексного числа;
    94. PrintMtrx - напечатать матрицу;
    95. mxCreate - создать матрицу;
    96. mxNull - создать пустую матрицу;
    97. mxIdt - создать единичную матрицу;
    98. mxTrans - транспонировать матрицу;
    99. mxMulReal - умножение матрицы на число;
    100. mxAdd - сложение двух матриц;
    101. mxSub - разность двух матриц;
    102. mxMul - умножение двух матриц;
    103. mxDtm - детерминант матрицы;
     

    Вложения:

    • MathModule.zip
      Размер файла:
      4,7 КБ
      Просмотров:
      608
  4. Thetrik

    Thetrik UA6527P

    Публикаций:
    0
    Регистрация:
    25 июл 2011
    Сообщения:
    863
    Шифрование EXE файла.
    Всем привет!
    Представляю пример реализации простого шифрования EXE файла на основе файла лицензии. При некорректном файле лицензии EXE не запустится и выдаст сообщение об ошибочной лицензии, большинство кода будет зашифрованным, в ином случае EXE сам расшифровывает свой код и запускается.
    Как это работает?
    Во-первых, чтобы была возможность расшифровывать EXE нужно чтобы код расшифровки не шифровался. Для этого в коде используются функции маркеры: BEGIN_OF_NON_ENCRYPTABLE_REGION и END_OF_NON_ENCRYPTABLE_REGION. Код между ними будет нетронут.
    Во-вторых, для шифрования файла нужно запустить его с параметром crypt:[файл лицензии], к примеру:
    В этом случае EXE запускает процедуру самошифрования. В качестве файла лицензии может использоваться любой непустой файл. Если файл уже зашифрован - то возникнет ошибка. Для идентификации зашифрован ли файл используется поле VBHeader.pProjectInfo->dwNull которое не используется в скомпилированном файле и мы можем хранить любую информацию там. Я храню там контрольную сумму, где старший бит определяет факт шифрования.
    В общем процедура шифрования определяет границы исполняемого кода и XOR'ит его с файлом лицензии, который выступает как кольцевой буфер. Потом контрольная сумма оригинальных данных сохраняется в вышеуказанное поле EXE файла. Шифрованный файл сохраняется как [ModuleName]__encrypted.[extension] в той же директории, оригинальный файл не изменяется.
    Теперь если запустить файл то программа сначала проверит файл лицензии (он должен называться license.lic и лежать в директории EXE) и если попытается расшифровать его, одновременно вычисляя контрольную сумму. Если после полной расшифровки сумма совпадает - файл успешно расшифрован и запускается основной код, в противном случае выводится сообщение об ошибке.
    Вот пример это код до шифрования:
    [​IMG]
    Этот код после:
    [​IMG]
    Спасибо за внимание!
     

    Вложения:

    • CryptExe.zip
      Размер файла:
      101,1 КБ
      Просмотров:
      605
  5. Thetrik

    Thetrik UA6527P

    Публикаций:
    0
    Регистрация:
    25 июл 2011
    Сообщения:
    863
    TrickSound - класс для работы с аудио.
    Привет всем!
    Этот класс предоставляет простой интерфейс для захвата и воспроизведения звука. Он также не требует никаких дополнительных зависимостей и работает автономно. Объект данного класса генерирует событие NewData когда устройство захвата заполняет внутренний буфер звуковыми данными или устройству воспроизведения требуется очередная порция звуковых данных. Для того чтобы инициализировать воспроизведение вызовите метод InitPlayback, для захвата InitCapture. Затем нужно вызвать StartProcess для того чтобы начать воспроизведение/захват. Я сделал два примера использования этого класса: простой синтезатор и простой диктофон.
     

    Вложения:

    • TrickSound.zip
      Размер файла:
      14,3 КБ
      Просмотров:
      606
  6. Thetrik

    Thetrik UA6527P

    Публикаций:
    0
    Регистрация:
    25 июл 2011
    Сообщения:
    863
    Класс для асинхронного ожидания объектов ядра
    Разработал класс для асинхронного ожидания объектов ядра. Класс генерирует событие при установке объекта в сигнальное состояние или при таймауте. Работает с любыми объектами.
    Класс имеет 3 метода vbWaitForSingleObject, vbWaitForMultipleObjects, IsActive, Abort. Первые два аналогичны вызову одноименных API функций без префикса "vb" и запускают ожидание объекта в новом потоке. Методы завершаются немедленно. При завершении функций в новом потоке генерируется событие OnWait, в параметрах которого содержится описатель объекта и возвращенное значение. При удачном завершении методы возвращают True, иначе False, также генерируются исключения.
    IsActive - возвращает True, если идет ожидание, иначе False.
    Abort - прерывает ожидание, при удачном выполнении возвращает True.
    Экземпляр класса может обрабатывать только один вызов за раз.
    В примере я подготовил 3 случая использования данного класса: отслеживание тика ожидающего таймера, отслеживание завершения приложения, отслеживание файловых операций в папке.
    Как это работает.
    Создается окно для приема уведомлений в главном потоке. При вызове метода ожидания создается новый поток с одноименной API функцией. Когда функция отрабатывает (по сигнальному состоянию, таймауту или ошибке) она передает сообщение нашему окну, которое обрабатывая его генерирует событие для текущего экземпляра объекта. Все манипуляции сделаны на ассемблере, что позволило обойтись одним классом (без модулей), к тому же для всех экземпляров используется один код. Также сделал небольшие проверки в IDE (в скомпилированном виде они отсутствуют), поэтому можно останавливать кнопкой "в среде", жать паузы без последствий (события просто не будут вызваны). Единственный способ "вылета" может произойти если запустить ожидание, остановить его кнопкой стоп (не вызвать деструктор). Потом опять запустить среду - если в этот момент отработает событие из прошлого запуска - будет вылет, т.к. того объекта уже нет. Код на ассемблере:
    Код (ASM):
    1. [BITS 32]
    2. WAITFORSINGLEOBJECT:
    3. mov     ecx, [esp+4]
    4. push    ecx
    5. push    dword [ecx+4]          ; dwTime
    6. push    dword [ecx]            ; hHandle
    7. call    0x12345678             ; WaitForSingleObject
    8. pop     ecx
    9. mov     dword [ecx+32], eax    ; Long -> Variant
    10. lea     eax, [ecx+12]
    11. push    eax                    ; Параметры в RAISE (lParam)
    12. push    eax                    ; ---               (wParam)
    13. push    0x400                  ; WM_ONWAIT         (uMsg)
    14. push    dword [ecx+8]          ; hWnd
    15. call    0x12345678             ; PostMessage
    16. ret     0x4
    17. WAITFORMULTIPLEOBJECTS:
    18. mov     ecx, [esp+4]
    19. push    ecx
    20. push    dword [ecx+4]          ; dwTime
    21. push    dword [ecx+8]          ; WaitAll
    22. push    dword [ecx]            ; lpHandles
    23. push    dword [ecx+12]         ; nCount
    24. call    0x12345678             ; WaitForMultipleObjects
    25. pop     ecx
    26. mov     dword [ecx+40], eax    ; Long -> Variant
    27. lea     eax, [ecx+20]
    28. push    eax                    ; Параметры в RAISE (lParam)
    29. push    eax                    ; ---           (wParam)
    30. push    0x400                  ; WM_ONWAIT         (uMsg)
    31. push    dword [ecx+16]         ; hWnd
    32. call    0x12345678             ; PostMessage
    33. ret     0x4
    34. WINDOWPROC:
    35. cmp     word [esp+8], 0x400    ; If Msg = WM_ONWAIT
    36. jz      WM_ONWAIT
    37. jmp     0x12345678             ; DefWindowProc
    38. WM_ONWAIT:
    39. ; Процедура для исключения падения в IDE
    40. call    0x12345678             ; call EbMode
    41. test    al,al                  ; Если остановлен
    42. jz      CLEAR
    43. cmp     al,1                   ; Если запущен
    44. jz      RAISE
    45. jmp     0x12345678             ; DefWindowProc
    46. CLEAR:                         ; Очистка
    47. push    dword [esp+4]          ; hwnd
    48. call    0x12345678             ; DestroyWindow
    49. jmp     0x12345678             ; DefWindowProc
    50. ; Конец заглушки
    51. RAISE:                         ; Возбуждение события
    52. mov     esi, dword [esp+0xc]   ; Указатель на источник
    53. sub     esp, 44                ; 44 байт параметров
    54. mov     edi, esp               ; Указатель на стек
    55. cld                            ; df = 0 (увеличение счетчиков)
    56. xor     ecx,ecx
    57. mov     cl,11                  ; 44 Байт (параметры _vbaRaiseEvent и аргументы
    58. rep     movsd
    59. call    0x12345678             ; __vbaRaiseEvent
    60. add     esp, 44
    61. ret     0x10
     

    Вложения:

  7. Thetrik

    Thetrik UA6527P

    Публикаций:
    0
    Регистрация:
    25 июл 2011
    Сообщения:
    863
    Модуль для удаления всех ресурсов после выполнения программы.
    Всем привет. Я бы хотел продемонстрировать небольшой проект, который содержит модуль для удаления файлов после завершения работы EXE. Это может быть полезно к примеру для программы которая использует какие-либо библиотеки для своей работы и нужно обеспечить удаление этих компонентов с жесткого диска после выполнения программы. Этот модуль позволяет даже удалить собственный EXE после завершения работы.
    Принцип работы очень прост, модуль содержит шеллкод написанный на VB6 который внедряется в процесс "зомби" и ждет завершения программы. После завершения программы шеллкод удаляет файлы которые пользователь передал в него, т.е. исключаются какие-либо блокировки со стороны EXE файла, поэтому мы можем все удалять даже сам EXE. После выполнения всех действий шеллкод завершает работу процесса "зомби".
    Для того чтобы обеспечить удаление файлов после работы EXE нужно вызвать функцию CleanFiles передавая в качестве параметра список файлов для удаления. Можно вызвать эту функцию как в начале работы приложения, в этом случае файлы будут удалены даже если приложение завершилось аварийно, так и в конце работы приложения.
    В аттаче небольшой пример использования который распаковывает внутренний OCX, а после завершения приложения удаляет его и собственный EXE файл.
     

    Вложения:

  8. Mikl___

    Mikl___ Супермодератор Команда форума

    Публикаций:
    14
    Регистрация:
    25 июн 2008
    Сообщения:
    3.741
    DirectX в VB6
    Всем привет.
    В архиве содержится библиотека типов "DirectX 9 for Visual Basic 6.0 type library by The trick" (dx9vb.tlb) содержащая описание следующих интерфейсов:
    • IDirect3D9;
    • IDirect3DDevice9;
    • IDirect3DSurface9;
    • IDirect3DResource9;
    • IDirect3DSwapChain9;
    • IDirect3DTexture9;
    • IDirect3DBaseTexture9;
    • IDirect3DVolumeTexture9;
    • IDirect3DVolume9;
    • IDirect3DCubeTexture9;
    • IDirect3DVertexBuffer9;
    • IDirect3DIndexBuffer9;
    • IDirect3DStateBlock9;
    • IDirect3DVertexDeclaration9;
    • IDirect3DVertexShader9;
    • IDirect3DPixelShader9;
    • IDirect3DQuery9;
    Также в этой библиотеке задекларированы множество типов, констант и энумов.
    Также в архиве содержится несколько модулей написанных на VB6:
    • D3DX_COLOR.bas - для работы с цветами
    • D3DX_MATRICES.bas - для работы с матрицами
    • D3DX_QUATERNION.bas - для работы с кватернионами
    • D3DX_VECTOR2.bas, D3DX_VECTOR3.bas, D3DX_VECTOR4.bas - для работы с векторами
    • D3DX_MISC.bas - различные функции которые не вошли не в одну из вышеоисанных категорий
    Эти модули содержат аналоги соответствующих функций D3DX.
    Также в архиве содержится несколько тестовых примеров работы.
    [​IMG]
    [​IMG]
    [​IMG]
    [​IMG]

    Скачать.
     
    Последнее редактирование: 7 май 2018
    A.P.$lasH и Thetrik нравится это.
  9. Mikl___

    Mikl___ Супермодератор Команда форума

    Публикаций:
    14
    Регистрация:
    25 июн 2008
    Сообщения:
    3.741
    DirectSound в VB6


    Параллельно с Direct3D9 я делал библиотеку типов и модуль с вспомогательными функциями для DirectSound. В архиве библиотека типов dsvb.tlb и модуль DS_Functions.bas. В дальнейшем добавлю модуль класса для поддержки асинхронных уведомлений, пока можно пользоваться этим.
    В модуле DS_Functions содержатся следующие функции:
    • DSCreateSoundBufferFromFile - создает объект с интерфейсом IDirectSoundBuffer8 из файла. Поддерживаются только WAVE и MP3 файлы. MP3 файлы могут содержать только ID3v1 и ID3v2 теги, какие-либо другие возможно не распознаются/не будут работать. Слишком длинные (по времени) файлы не поддерживаются. Для потокового воспроизведения нужно писать потоковое декодирование на основе кода функции DSCreateSoundBufferFromMemory.
    • DSCreateSoundBufferFromMemory - тоже самое, но вместо файла передается указатель на данные файла в памяти и их размер.
    Также в архиве содержится пример плеера который реализует некоторые методы IDirectSoundBuffer8 интерфейса (громкость, панорама, частота, эффекты).
    TLB также особо сильно не тестировалась, поэтому что-то может не работать. Если что-то не работает пишите сюда.

    Скачать.
     
    A.P.$lasH и Thetrik нравится это.
  10. Thetrik

    Thetrik UA6527P

    Публикаций:
    0
    Регистрация:
    25 июл 2011
    Сообщения:
    863
    Класс - MP3 проигрыватель из памяти.
    Всем привет. Я разработал класс для асинхронного воспроизведения MP3 файлов в памяти. Например это может пригодится для воспроизведения фоновой музыки из ресурсов или из сети минуя запись в файл. Воспроизводить можно несколько файлов одновременно, но некоторые параметры воспроизведения (громкость, панорама) для всех проигрывателей будут общими. Класс разработан так, что корректно обрабатывает ситуации остановки среды кнопками "стоп", "пауза" и выхода по End. По тегам, корректно обрабатываются только ID3v1 и ID3v2 теги, другие не распознаются и файл скорее всего не будет играться.
    Методы:
    • Initialize - инициализирует проигрыватель, в качестве первого параметра передается указатель на данные MP3 файла. Второй параметр указывает на размер данных. Третий параметр определяет нужно ли копировать файл во внутренний буфер внутри объекта и воспроизводить файл оттуда;
    • Play - запускает воспроизведение, параметр looped при первом воспроизведении определяет будет ли файл зацикливаться;
    • Pause - приостанавливает воспроизведение, следующее воспроизведение начнется с текущей позиции;
    • StopPlaying - останавливает воспроизведение;
    • SetPositionMs - устанавливает текущую позицию воспроизведения (мс);
    • GetPositionMs - возвращает текущую позицию воспроизведения (мс);
    • GetDurationMs - возвращает длину файла в миллисекундах;
    • GetBitrate - возвращает битрейт на момент воспроизведения (кб/с);
    • IsPlaying - определяет играется ли файл;
    Свойства:
    • Volume - задает/возвращает текущую громкость воспроизведения (0...1);
    • Pan - задает/возвращает текущую панораму воспроизведения ((левый канал)-1...1(правый канал)).
     

    Вложения:

    • Ver.1.1.zip
      Размер файла:
      717,8 КБ
      Просмотров:
      655
    A.P.$lasH и rococo795 нравится это.
  11. Thetrik

    Thetrik UA6527P

    Публикаций:
    0
    Регистрация:
    25 июл 2011
    Сообщения:
    863
    Хеш - таблица VB6
    Представляю автономный класс реализующий хеш-таблицу, который во многих случаях может стать заменой словаря (Dictionary) из Scripting runtime. Реализованы все те же методы что и у словаря, а также добавлены новые.
    Включена поддержка перечисления через For Each, также можно задавать режим перечисления ключи/значения, также по сравнению с предыдущей версией исправлены баги вылета из среды при остановки в теле циклов For Each, а также нет никаких ограничений на вложенные циклы. Работает достаточно быстро, на моей машине приблизительно также (даже чуть быстрее) как словарь при двоичном сравнении, при текстовом сравнении работает почти в 2-раза быстрее словаря. В качестве ключей допускаются Variant переменные с типам от vbEmpty до vbDecimal включительно. Числовые ключи должны быть уникальны, т.е. -1, True, -1e0 - один и тот же ключ как и в словаре.
    Новый метод EnumMode - определяет текущий режим перечисления. Допустимые значения ENUM_BY_KEY, ENUM_BY_VALUE. При входе в цикл For Each начинает перечисляться тот параметр, который задан этим свойством. Например можно перечислять в главном цикле ключи, во вложенном значения, или сначала ключи потом значения. Также задавая это свойство в окнах Locals или Watch можно переключать отображение с ключей на значения и обратно.
    [​IMG]
    Сама реализация представляет собой массив двусвязных списков, где индексы массива - хеш-значения соответствующих ключей. Для поддержки перечисления используется объект-перечислитель. Реализация интерфейса IEnumVariant и IUnknown для перечислителя написана на ассемблере:
    Код (ASM):
    1. [BITS 32]
    2.  
    3. QueryInterface:
    4.     mov eax,[esp+4]         ; ObjPtr
    5.     inc dword [eax+4]       ; Counter++
    6.     mov ecx, [esp+0xc]
    7.     mov [ecx],eax           ; ppvObject = ObjPtr
    8.     xor eax,eax             ; Success
    9.     ret 0xc
    10.  
    11. AddRef:
    12.     mov eax,[esp+4]         ; ObjPtr
    13.     inc dword [eax+4]       ; Counter++
    14.     mov eax, [eax+4]        ; Counter return
    15.     ret 0x4
    16.  
    17. Release:
    18.     mov eax,[esp+4]         ; ObjPtr
    19.     dec dword [eax+4]       ; Counter--
    20.     jz  RemoveObject        ; if (Counter == 0)
    21.     mov eax, [eax+4]        ; Counter return
    22.     ret 0x4
    23. RemoveObject:
    24.     push    eax             ; lpMem
    25.     push    0x00000001      ; HEAP_NO_SERIALIZE
    26.     call    0x12345678      ; GetProcessHeap
    27.     push    eax             ; hHeap
    28.     call    0x12345678      ; HeapFree
    29.     xor eax,eax             ; Counter = 0
    30.     ret 0x4
    31.  
    32. IEnumVariant_Next:
    33.     push ebx
    34.     push edi
    35.     push esi
    36.  
    37.     mov esi, [esp+0x10]     ; ObjPtr
    38.     mov ebx, [esp+0x14]     ; ebx = celt
    39.     mov edi, [esp+0x18]     ; rgVar
    40.  
    41. NextItem:
    42.  
    43.         movsx   eax, word [esi+0x8] ; Pointer.Hash
    44.         inc eax
    45.         jz  ExitCycle           ; if (Pointer.Hash == -1)
    46.         dec eax
    47.         mov ecx, [esi+0xc]      ; DataPtr
    48.         mov ecx, [ecx+eax*8+4]  ; ecx = tItem.tElement
    49.         movzx   eax, word [esi+0xA] ; Pointer.Index
    50.         imul    ax, ax, 0x28        ;
    51.         movzx   eax, ax         ; eax = Pointer.Index * sizeof(tElement)
    52.         mov ecx, [ecx+0xc]      ; ecx = *tElement(0)
    53.         lea ecx, [ecx+eax]      ; *tElement(Pointer.Index)
    54.         mov eax, [ecx+0x20]
    55.         add ecx, [esi+0x14]     ; ecx += OffsetVarinat
    56.         mov [esi+0x8], eax      ; Pointer = tElement(Pointer.Index).Next
    57.         push    ecx             ; pvargSrc
    58.         push    edi             ; pvargDest == rgVar
    59.         call    0x12345678      ; VariantCopy
    60.  
    61.         add edi, 0x10
    62.         dec ebx
    63.         jne NextItem
    64.        
    65. ExitCycle:
    66.    
    67.     test ebx, ebx
    68.     setne   dl              ; if (ebx = 0) dl = 0 else dl = 1
    69.     movzx   esi, dl         ; edx = dl
    70.    
    71.     mov edi, [esp+0x1c]     ; pCeltFetched
    72.     test edi, edi
    73.     je ExitFunction
    74.    
    75.     mov eax, [esp+0x14]     ; eax = celt
    76.     sub eax, ebx
    77.     mov     [edi], eax      ; pCeltFetched = count
    78.  
    79. ExitFunction:
    80.    
    81.     mov eax, esi
    82.     pop esi
    83.     pop edi
    84.     pop ebx
    85.     ret 0x10
    86.  
    87. IEnumVariant_Skip:
    88.  
    89.     mov edx, [esp+0x04]     ; ObjPtr
    90.     mov eax, [edx+0x8]      ; Pointer.Hash
    91.     mov edx, [edx+0xc]      ; DataPtr
    92.  
    93. NextItem_2:
    94.        
    95.         inc ax
    96.         jz  ExitCycle_2         ; if (Pointer.Hash == -1)
    97.         dec ax
    98.        
    99.         movzx   ecx, ax         ; ecx = Pointer.Hash
    100.         mov ecx, [edx+ecx*8+4]  ; ecx = tItem.tElement
    101.         shr eax, 0x10           ; eax = Pointer.Index
    102.         imul    ax, ax, 0x28    ;
    103.  
    104.         mov ecx, [ecx+0xc]      ; ecx = *tElement(0)
    105.         mov eax, [ecx+eax+0x20] ; eax = tElement(Pointer.Index).Next
    106.        
    107.         dec dword [esp+0x08]    ; celt--
    108.         jne NextItem_2
    109.        
    110.         xor edx, edx
    111.  
    112. ExitCycle_2:
    113.    
    114.     test edx, edx
    115.     setne   dl              ; if (edx = 0) dl = 0 else dl = 1
    116.     mov eax, edx
    117.    
    118.     ret 0x08
    119.  
    120. IEnumVariant_Reset:
    121.     mov eax, [esp+0x04]     ; ObjPtr
    122.     mov edx, [eax+0x10]     ; First
    123.     mov [eax+0x08], edx     ; Pointer = First
    124.     xor eax, eax
    125.     ret 0x4
    Код создается только при создании первого объекта, и используется всеми последующими объектами. Адрес хранится в переменных окружения.
    Также я написал небольшое тестовое приложение для сравнения скоростей словаря и моей хеш-таблицы. Кнопка "Add 100000" добавляет 100000 записей в словарь/таблицу и отображает время работы. Кнопка "Clear" очищает словарь/таблицу. Кнопка "Access all" перечисляет все элементы используя доступ по ключу. Кнопка "For each" перечисляет все элементы используя For Each цикл.
    [​IMG]
    Огромная благодарность Алексу (Dragokas) за дебаггинг.
     

    Вложения:

    A.P.$lasH нравится это.
  12. Thetrik

    Thetrik UA6527P

    Публикаций:
    0
    Регистрация:
    25 июл 2011
    Сообщения:
    863
    Распознавание речи используя API.AI
    Небольшой пример использования средств API.AI для распознавания голосовых команд.
     

    Вложения:

    • API_AI.zip
      Размер файла:
      12,9 КБ
      Просмотров:
      524
    A.P.$lasH нравится это.
  13. Thetrik

    Thetrik UA6527P

    Публикаций:
    0
    Регистрация:
    25 июл 2011
    Сообщения:
    863
    Пользовательская отрисовка окна

    В Windows 7 появилась замечательная вещь - индикация прогресса на кнопках панели задач. Чтобы использовать данную возможность на VB6 (и в любых других языках) нужно создать объект TaskBarList, получить интерфейс ITaskBarList3 и воспользоваться его методами SetProgressState и SetProgressValue.
    В своем модуле я добавил возможность задавать состояние индикатора прогресса на панели задач, а также продублировал этот индикатор на саму форму + добавил возможность использования анимированных иконок в заголовке формы (также поддерживаются и обычные иконки). Из данного примера можно узнать, как самому отрисовывать неклиентскую область окна, делать кнопки которые подсвечиваются при наведении. В примере используется двойная буфферизация, поэтому все работает гладко и без мерцаний. Данный модуль можно прециплять к любому проекту с любыми формами.
     

    Вложения:

    A.P.$lasH нравится это.
  14. Thetrik

    Thetrik UA6527P

    Публикаций:
    0
    Регистрация:
    25 июл 2011
    Сообщения:
    863
    Перевод из строки в число и обратно.
    VB-шные функции для перевода и проверки чисел в строки (и обратно) очень неудобные, в плане того что туда можно много чего написать, и они их "съедят". Можно написать числа в шестнадцатеричной системе или в скобках, в экспоненциальной записи и т.п. С одной стороны это хорошо, но с другой может быть проблемой. Я написал 2 функции которые переводят десятичные целые числа неограниченной размерности из одного представления в другое. Может быть полезно например для отображения (установки) LARGE_INTEGER или любых других больших (сверхбольших) чисел.
    Код (Visual Basic):
    1.  
    2. Option Explicit
    3.  
    4. Private Declare Function GetMem2 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
    5.  
    6. Private Sub Form_Load()
    7.     Dim Value() As Byte, Res As String
    8.    
    9.     StrToUI "1234567891011121314151617181920", Value
    10.    
    11.     Res = UIToStr(Value)
    12.    
    13. End Sub
    14. ' Перевод беззнакового целого числа из байтового представления в строку
    15. Private Function UIToStr(bValue() As Byte) As String
    16.     Dim i As Long, f As Boolean, loc() As Byte
    17.     loc = bValue
    18.     Do
    19.         i = Div10UI(loc)
    20.         UIToStr = CStr(i) & UIToStr
    21.         f = False
    22.         For i = UBound(loc) To 0 Step -1
    23.             If loc(i) Then f = True: Exit For
    24.         Next
    25.     Loop While f
    26. End Function
    27. ' Перевод беззнакового целого числа из строкового представления в массив байт
    28. Private Sub StrToUI(sValue As String, Out() As Byte)
    29.     Dim i As Long, lpStr As Long, v As Integer, b(0) As Byte
    30.     ReDim Out(0)
    31.     If Len(sValue) Then
    32.         lpStr = StrPtr(sValue)
    33.         For i = 0 To Len(sValue) - 1
    34.             GetMem2 ByVal lpStr, v
    35.             v = v - &H30
    36.             If v < 0 Or v > 9 Then Err.Raise 13: Exit Sub
    37.             b(0) = v
    38.             If i Then Mul10UI Out
    39.             AddUI Out, b()
    40.             lpStr = lpStr + 2
    41.         Next
    42.     Else: Err.Raise 5
    43.     End If
    44. End Sub
    45. Private Sub AddUI(Op1() As Byte, Op2() As Byte)
    46.     Dim i As Long, p As Long, o As Long, q As Long
    47.     If UBound(Op1) < UBound(Op2) Then ReDim Preserve Op1(UBound(Op2))
    48.     Do
    49.         If i <= UBound(Op2) Then o = Op2(i) Else o = 0
    50.         q = CLng(Op1(i)) + o + p
    51.         p = (q And &H100&) \ &H100
    52.         Op1(i) = q And &HFF
    53.         i = i + 1
    54.     Loop While CBool(o Or p) And i <= UBound(Op1)
    55.     If p Then ReDim Preserve Op1(i): Op1(i) = p
    56. End Sub
    57. Private Function Div10UI(Value() As Byte) As Long
    58.     Dim i1 As Long, i2 As Long, acc() As Byte, loc() As Byte, q As Long, p As Long
    59.     For i1 = 0 To (UBound(Value) + 1) * 8
    60.         Div10UI = (Div10UI * 2) Or p
    61.         If Div10UI < 10 Then p = 0 Else p = 1: Div10UI = Div10UI - 10
    62.         For i2 = 0 To UBound(Value)
    63.             q = (CLng(Value(i2)) * 2) Or p
    64.             p = (q And &H100) \ &H100
    65.             Value(i2) = q And &HFF&
    66.         Next
    67.     Next
    68. End Function
    69. Private Sub Mul10UI(Value() As Byte)
    70.     Dim i As Long, p As Long, q As Long
    71.     For i = 0 To UBound(Value)
    72.         q = (CLng(Value(i)) * 4 + Value(i)) * 2 + p
    73.         p = (q And &HFF00&) \ &H100
    74.         Value(i) = q And &HFF
    75.     Next
    76.     If p Then ReDim Preserve Value(i): Value(i) = p
    77. End Sub
    78.  
     
    A.P.$lasH нравится это.
  15. yashechka

    yashechka Ростовский фанат Нарвахи

    Публикаций:
    90
    Регистрация:
    2 янв 2012
    Сообщения:
    1.449
    Адрес:
    Россия
    Новый васм умилил меня VB. Это всё Ваши творения? Думал, что его уже не используют, языков нынче много.
     
  16. Thetrik

    Thetrik UA6527P

    Публикаций:
    0
    Регистрация:
    25 июл 2011
    Сообщения:
    863
    Да, мои. Пока что все что я здесь публиковал по VB и по АСМу мое.
    Используют.
     
  17. Rel

    Rel Well-Known Member

    Публикаций:
    2
    Регистрация:
    11 дек 2008
    Сообщения:
    5.284
    да, VB - это один из тех языков программирования и сред, которые просто не хотят умирать... я помню времена, когда майкрософт хотела его выпилить с релизом 8ой венды в пользу VB.NET, но он живет и по сей день... кстати любителям VB советую так же посмотреть PureBasic и FreeBasic...
     
  18. _edge

    _edge Well-Known Member

    Публикаций:
    1
    Регистрация:
    29 окт 2004
    Сообщения:
    631
    Адрес:
    Russia
    FreeBasic отвратителен и не заслуживает упоминания. Дело не в синтаксисе языка, сколько в подходе разрабочиков (опенсорц такой опенцсорц, далее поймете почему). Таки разница между free (open) платформой и paid, часто громадна.

    Пример. Захотел я игру написать. И вот нужно мне вывести на экран текст. Логично для этого использовать TTF-шрифты из виндов. И там, где в других средах вопросов не возникает, во FreeBasic я сталкиваюсь с тем, что в нем этого просто нет. Нельзя вывести надпись на экран используя шрифты. Из готового/встроенного есть библиотека тайлов, где чтобы выводить шрифт, я должен как в незапамятные времена, подготовить битмап (png с прозрачностью), и фигачить из него. Или есть _своя либа для шрифтов, со своим форматом, и даже написанным конвертером из TTF. На вопрос, а как сделать, используя родные шрифты, мне предлагают фрактальный костыль /костыль, сделанный из костылей/ - прогу, где намешан FreeBasic, встроенный Асм для математики (ручной разбор вектор-формата, или у меня уже фантазия играет?), и вызовов ВинАпи - ок, я бы такое проглотил - но оно не умеет кириллические шрифты, вот незадача.

    Нет решения.

    Схожие муки испытал, пытаясь подключить либу для работы с Png/Jpg, оно содержит .a файлы, имеющие отн-е к Линукс-системам. Игрища с вызовом компилятора (а компиль там опенсорцный, mingw если не ошибась) с разными опциями и неистовое гугление оставили осадок в виде сомнений в собственном IQ. Видимо, встроить GDI вызовы виндовых библиотек в FreeBasic - разработчикам не позволяет религия - я должен писать это сам. Или давайте костылить, писать либы, разбирать в либах форматы битмапов вручную, это же так увлекательно (во времена дос не было другого выбора, но сейчас вроде не та эпоха).

    Нет решения.

    PureBasic понравился больше. Очевидный плюс - то что вышеописанное делается "изкаропки", как собственно и должно быть, т.к. оно уже встроено в ОСь. Немного напрягает, что везде нужно делать If/endif.

    FreeBasic резко умер годах в 2006-09, судя по упадку сайтов и журналов (да, были целые журналы игроделов, посвяященные FB/QB; собственно, кроме бесплатности, у FB есть преимущество в виде поддержки синтаксиса QBasic, - проги из QB можно запустить в FB без переделок).

    PureBasic кроссплатформенный, если не извращаться и использовать только средства языка, код перекомпилируется что под Вин, что под Линукс. PureBasic стоит денег (двусмысленная фраза, да, он платный, но этими деньгами оплачивается его потенциал). Версия 5 умеет x64, но на мой взгляд, для x32 код лучше компилировать более старыми версиями вроде 4-й, результирующий EXE получается сильно меньше/шустрее.
     
    Последнее редактирование: 19 янв 2017
  19. sl0n

    sl0n Мамонт дзена **

    Публикаций:
    0
    Регистрация:
    26 сен 2003
    Сообщения:
    692
    Ребята давайте поменьше VB =)) ато неясно во что форум скатывается
     
    rococo795 нравится это.
  20. SadKo

    SadKo Владимир Садовников

    Публикаций:
    8
    Регистрация:
    4 июн 2007
    Сообщения:
    1.610
    Адрес:
    г. Санкт-Петербург
    Чёт как-то... У меня вообще не возникало никогда необходимости использовать какой-либо васик.