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

Здесь планируется выкладывать Add-in'ы, готовые модули, какие-либо полезные коды.

 

Класс для копирования в отдельном потоке с отображением прогресса.
Бывает ситуация, когда нужно скопировать большой файл(ы), при этом стандартная ф-ция 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 замирает на это время.

 

Модуль с расширенными математическими функциями для вещественных и комплексных чисел.

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 - детерминант матрицы;

 

Шифрование 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) и если попытается расшифровать его, одновременно вычисляя контрольную сумму. Если после полной расшифровки сумма совпадает - файл успешно расшифрован и запускается основной код, в противном случае выводится сообщение об ошибке.
Вот пример это код до шифрования:

Этот код после:

Спасибо за внимание!

 

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

 

Класс для асинхронного ожидания объектов ядра
Разработал класс для асинхронного ожидания объектов ядра. Класс генерирует событие при установке объекта в сигнальное состояние или при таймауте. Работает с любыми объектами.
Класс имеет 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

 

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

 

Класс - MP3 проигрыватель из памяти.
Всем привет. Я разработал класс для асинхронного воспроизведения MP3 файлов в памяти. Например это может пригодится для воспроизведения фоновой музыки из ресурсов или из сети минуя запись в файл. Воспроизводить можно несколько файлов одновременно, но некоторые параметры воспроизведения (громкость, панорама) для всех проигрывателей будут общими. Класс разработан так, что корректно обрабатывает ситуации остановки среды кнопками "стоп", "пауза" и выхода по End. По тегам, корректно обрабатываются только ID3v1 и ID3v2 теги, другие не распознаются и файл скорее всего не будет играться.
Методы:

• Initialize - инициализирует проигрыватель, в качестве первого параметра передается указатель на данные MP3 файла. Второй параметр указывает на размер данных. Третий параметр определяет нужно ли копировать файл во внутренний буфер внутри объекта и воспроизводить файл оттуда;
• Play - запускает воспроизведение, параметр looped при первом воспроизведении определяет будет ли файл зацикливаться;
• Pause - приостанавливает воспроизведение, следующее воспроизведение начнется с текущей позиции;
• StopPlaying - останавливает воспроизведение;
• SetPositionMs - устанавливает текущую позицию воспроизведения (мс);
• GetPositionMs - возвращает текущую позицию воспроизведения (мс);
• GetDurationMs - возвращает длину файла в миллисекундах;
• GetBitrate - возвращает битрейт на момент воспроизведения (кб/с);
• IsPlaying - определяет играется ли файл;

Свойства:

• Volume - задает/возвращает текущую громкость воспроизведения (0...1);
• Pan - задает/возвращает текущую панораму воспроизведения ((левый канал)-1...1(правый канал)).

 

Хеш - таблица 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 можно переключать отображение с ключей на значения и обратно.

Сама реализация представляет собой массив двусвязных списков, где индексы массива - хеш-значения соответствующих ключей. Для поддержки перечисления используется объект-перечислитель. Реализация интерфейса 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 цикл.

Огромная благодарность Алексу (Dragokas) за дебаггинг.

 

Распознавание речи используя API.AI
Небольшой пример использования средств API.AI для распознавания голосовых команд.

 

Пользовательская отрисовка окна

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

 

Перевод из строки в число и обратно.
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.  

 

Новый васм умилил меня VB. Это всё Ваши творения? Думал, что его уже не используют, языков нынче много.

 

Да, мои. Пока что все что я здесь публиковал по VB и по АСМу мое.

Используют.

 

да, VB - это один из тех языков программирования и сред, которые просто не хотят умирать... я помню времена, когда майкрософт хотела его выпилить с релизом 8ой венды в пользу VB.NET, но он живет и по сей день... кстати любителям VB советую так же посмотреть PureBasic и FreeBasic...

 

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 получается сильно меньше/шустрее.

 

Ребята давайте поменьше VB =)) ато неясно во что форум скатывается

 

Чёт как-то... У меня вообще не возникало никогда необходимости использовать какой-либо васик.