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

Чем тебе мешает VB в разделе VB?

Думаю у большинства людей на планете не возникало.

 

кстати говоря о басиках: есть еще Xojo, Monkey X, Gambas, GLBasic... ну защищать FreeBasic у меня нету причин, тк я его толком не использовал... так посмотрел на компилятор, что генерит C и LLVM IR, вроде норм код получается и на этом все... как бы он мне особо не был нужен, там меня разочаровало отсутствие модулей и ужасная модель инклудов, аналогичная сишным... в PureBasic раздрожает отсутствие привычной во многих языках сборки мусора или RAII, но это у многих басиков такая проблема... я кстати в свое время его купил, но так толком не заюзал ни для чего... Xojo тож проприетарный, стоит денег, и чет многие от него плюются, хотя в качестве постоения гуишек он вроде вполне себе норм... Monkey X и GLBasic заточены под игры, для чего то другого их толком не используешь... хотя Monkey X довольно приятный, если его использовать с проприетарной средой разработки Jungle IDE или как-то так... Gambas очень интересен в плане создания гуишок, но удручает отсутствие нормальной поддержки венды... в общем идеального бейсика на мой взгляд я еще не видел...

 

G

Потому что VB и WASM раньше был не совместим, тут другие вещи писали. Но драйвер на VB меня умилил.

 

Ну если бы я пришел на форум садоводов и писал там про VB - это было бы несовместимо. А я пишу на форум по программированию, в специальный раздел предназначенный для этого. Аналогия - я бы пришел на старый WASM и писал там в ветку C. На старом васме, насколько я помню, были статьи где ЯП выступал дельфи.

Времена меняются. Текущая администрация решила расширить раздел LANGS. К примеру администрация x1024.ru (васм.рф) решила все оставить по старому, решила профилироваться только по асму. Если текущая администрация решит исключить VB6, тогда это другой разговор.

VB6 такой же ЯП как и остальные - компилирует в 32 битный машинный код (а также в P-Code), и на нем также как к примеру на C++ можно писать драйверы и вообще делать что угодно.

 

Во-первых, правила форума не запрещают выкладывать статьи по VB, во-вторых - это тоже продвигает форум, пусть и с другой стороны. В - третьих, кто мешает выкладывать проги на асме, выкладывайте свои наработки, идеи, практику, у Вас многих опыта от "а до я" которому позавидовать можно, а то такое впечатление складывается, что кроме Mikl_ это никому и не нужно, лишь бы собраться потрындеть. Ведь столько еще разных тем не раскрыто, а кто мешает Вам их раскрывать. А Thetrik все правильно делает, сделал то, что ему нравится, выложил наработки, исходники, кому надо пригодятся, кому не надо, так не надо. Кто это мешает делать на асме??? Вперед!!! Вот rococo795 рад бы что нибудь написать и выложить, да опыта нет (где то в соседней теме писал), и я такой же. В июле того года мне что регистр ebx, что eprst, никакой разницы. Куча всяких идей, да знаний в асме пока не хватает. Так что прежде чем VB обсуждать (надо, не надо) давайте асм разовьем по полной.

 

Здравствуйте. Он и так уже развит по "полной".

Если вы про обучение то в сети много информации с чего начать, например почитать битфрая, рассылки калашникова(правда там под DOS).

P.S. Васм уже не васм, это совсем другой формат веб ресурса. Кстати Alex, какой у вас был ник на старом васме? А то тут многие открылись "who is who", а вас я лично и не знаю.

 

Патчинг кодогенерации __vbaSetSystemError

Как известно любая API функция объявленная через Declare генерирует вызов функции __vbaSetSystemError которая задает свойство Err.LastDllError. Иногда может быть полезно избежать генерацию этого кода для производительности либо других целей. Для того чтобы сделать это необходимо пропатчить функцию кодогенератора EXMGR::ProcessSystemError:

Код (Visual Basic):

1. Option Explicit
2. Private Enum PTR
3.     [_]
4. End Enum
5. Private Const PAGE_EXECUTE_READWRITE  As Long = &H40&
6. Private Declare Function GetModuleHandle Lib "kernel32" _
7.                          Alias "GetModuleHandleW" ( _
8.                          ByVal lpModuleName As PTR) As PTR
9. Private Declare Function VirtualProtect Lib "kernel32" ( _
10.                          ByVal lpAddress As Long, _
11.                          ByVal dwSize As Long, _
12.                          ByVal flNewProtect As Long, _
13.                          ByRef lpflOldProtect As Long) As Long
14. Private Declare Sub GetMem4 Lib "msvbvm60" ( _
15.                     ByRef pAddr As Any, _
16.                     ByRef pDst As Any)
17. Private Declare Sub GetMemPtr Lib "msvbvm60" _
18.                     Alias "GetMem4" ( _
19.                     ByRef pAddr As Any, _
20.                     ByRef pDst As Any)
21. Private Declare Sub GetMem8 Lib "msvbvm60" ( _
22.                     ByRef pAddr As Any, _
23.                     ByRef pDst As Any)
24. Private Declare Sub PutMemPtr Lib "msvbvm60" _
25.                     Alias "PutMem4" ( _
26.                     ByRef pDst As Any, _
27.                     ByVal pVal As PTR)
28. Private Declare Sub PutMem2 Lib "msvbvm60" ( _
29.                     ByRef pDst As Any, _
30.                     ByVal iVal As Integer)
31. Private Function RemoveSystemError() As Boolean
32.     Dim hVB6    As PTR
33.     Dim pNTHdr  As PTR
34.     Dim pStart  As PTR
35.     Dim pEnd    As PTR
36.     Dim cSign   As Currency
37.     Dim lLength As Long
38.     Dim lProt   As Long
39.  
40.     hVB6 = GetModuleHandle(StrPtr("vba6.dll"))
41.     If hVB6 = 0 Then Exit Function
42.     GetMem4 ByVal hVB6 + &H3C, pNTHdr
43.     pNTHdr = pNTHdr + hVB6
44.  
45.     GetMem4 ByVal pNTHdr + &H104, pStart
46.     pStart = pStart + hVB6
47.  
48.     GetMem4 ByVal pNTHdr + &H100, lLength
49.     pEnd = pStart + lLength - 8
50.    
51.     Do While pStart <= pEnd
52.    
53.         GetMem8 ByVal pStart, cSign
54.    
55.         If cSign = -356375250902713.1008@ Then
56.             If VirtualProtect(pStart + &H10, 2, PAGE_EXECUTE_READWRITE, lProt) Then
57.        
58.                 PutMem2 ByVal pStart + &H10, &H9090
59.                 VirtualProtect pStart + &H10, 2, lProt, lProt
60.                 RemoveSystemError = True
61.            
62.             End If
63.        
64.             Exit Do
65.        
66.         End If
67.    
68.         pStart = pStart + 1
69.    
70.     Loop
71. End Function

--- Сообщение объединено, 21 июн 2026 в 22:14 ---

Перенаправление Debug.Print вывода в любой объект.

Код (Visual Basic):

1. ' //
2. ' // Debug redirect
3. ' // by The trick
4. ' //
5. Option Explicit
6. Private Enum PTR
7.     [_]
8. End Enum
9. Private Declare Function GetModuleHandle Lib "kernel32" _
10.                          Alias "GetModuleHandleW" ( _
11.                          ByVal lpModuleName As PTR) As PTR
12. Private Declare Sub GetMem4 Lib "msvbvm60" ( _
13.                     ByRef pAddr As Any, _
14.                     ByRef pDst As Any)
15. Private Declare Sub GetMemPtr Lib "msvbvm60" _
16.                     Alias "GetMem4" ( _
17.                     ByRef pAddr As Any, _
18.                     ByRef pDst As Any)
19. Private Declare Sub GetMem8 Lib "msvbvm60" ( _
20.                     ByRef pAddr As Any, _
21.                     ByRef pDst As Any)
22. Private Declare Sub PutMemPtr Lib "msvbvm60" _
23.                     Alias "PutMem4" ( _
24.                     ByRef pDst As Any, _
25.                     ByVal pVal As PTR)
26. Private Function ReplaceDebugObject( _
27.                  ByVal pObj As PTR) As PTR
28.     Static s_pCurObject As PTR
29.     Dim hVBA        As PTR
30.     Dim pNTHdr      As PTR
31.     Dim pStart      As PTR
32.     Dim pEnd        As PTR
33.     Dim cSign       As Currency
34.     Dim lLength     As Long
35.     Dim lOldProtect As Long
36.  
37.     If s_pCurObject = 0 Then
38.  
39.         hVBA = GetModuleHandle(StrPtr("vba6"))
40.         If hVBA = 0 Then Exit Function
41.  
42.         GetMem4 ByVal hVBA + &H3C, pNTHdr
43.         pNTHdr = pNTHdr + hVBA
44.      
45.         GetMem4 ByVal pNTHdr + &H12C, pStart
46.         pStart = pStart + hVBA
47.      
48.         GetMem4 ByVal pNTHdr + &H128, lLength
49.         pEnd = pStart + lLength - 8
50.      
51.         Do While pStart <= pEnd
52.          
53.             GetMem8 ByVal pStart, cSign
54.          
55.             If cSign = 511398171365990.4051@ Then
56.          
57.                 GetMemPtr ByVal pStart + &H11, pStart
58.                 GetMemPtr ByVal pStart + &H44, pStart
59.                 GetMemPtr ByVal pStart + &H1, s_pCurObject
60.                 Exit Do
61.              
62.             End If
63.          
64.             pStart = pStart + 1
65.          
66.         Loop
67.     End If
68.  
69.     If s_pCurObject = 0 Then
70.         Err.Raise 51
71.     End If
72.  
73.     GetMemPtr ByVal s_pCurObject, ReplaceDebugObject
74.     PutMemPtr ByVal s_pCurObject, pObj
75.  
76. End Function
77. Private Sub Form_Load()
78.     Dim pOriginal   As PTR
79.  
80.     Me.AutoRedraw = True
81.  
82.     pOriginal = ReplaceDebugObject(ObjPtr(Me))
83.  
84.     Debug.Print "test"
85.     Debug.Print "Hello", "world", Spc(10); "1234"; Tab(3); "vb6"
86.     ReplaceDebugObject pOriginal
87.  
88. End Sub

--- Сообщение объединено, 21 июн 2026 в 22:16 ---

Как определить что объект является пользовательским VB объектом?

Любой пользовательский объект поддерживает интерфейс AreYouABasicInstance (IID_AreYouABasicInstance = {0B6C9465-D082-11CF-8B4F-00A0C90F2704}). Для тех кто не любит библиотеки типов можно использовать следующий код:

Код (Visual Basic):

1. Option Explicit
2. Private Const AreYouABasicInstance  As String = "{0B6C9465-D082-11CF-8B4F-00A0C90F2704}"
3. Private Declare Function vbaCheckType Lib "msvbvm60" Alias "__vbaCheckType" (ByVal pObj As Any, ByRef pIID As Any) As Boolean
4. Private Declare Function IIDFromString Lib "ole32" (ByRef lpsz As Any, ByRef lpiid As Any) As Long
5. Private Sub Form_Load()
6.     Dim bIID(15)    As Byte
7.    
8.     IIDFromString ByVal StrPtr(AreYouABasicInstance), bIID(0)
9.     If vbaCheckType(Me, bIID(0)) Then
10.         MsgBox "VB obj"
11.     End If
12.    
13. End Sub

--- Сообщение объединено, 21 июн 2026 в 22:29 ---

Умножение 64 битных целых с индикацией переполнения.

Обычно когда мне нужно работать с 64 битными целыми числами я использую тип Currency. Для сложений и вычитаний можно использовать обычные + и -. Для умножения и деления можно использовать _allmul, _alldiv:

Код (Visual Basic):

1. Option Explicit
2. Private Declare Function allmul Lib "ntdll" _
3.                          Alias "_allmul" ( _
4.                          ByVal cMultiplicand As Currency, _
5.                          ByVal cMultiplier As Currency) As Currency
6. Private Declare Function alldiv Lib "ntdll" _
7.                          Alias "_alldiv" ( _
8.                          ByVal cDivident As Currency, _
9.                          ByVal cDivisor As Currency) As Currency
10.                      
11. Private Sub Form_Load()
12.     Debug.Print alldiv(5, 0.08) ' // 50000 / 800 = 62
13.     Debug.Print allmul(500, 8)  ' // 5000000 * 80000 = 400000000000
14. End Sub

Проблема функции _allmul в том что она не сигнализирует о переполнении, для этого я написал 2 функции mul64 и imul64 которые выполняют соответствующее умножение беззнаковых и знаковых 64 битных целых, а также сигнализируют о переполнении если результат не помещается в 64 битный результат. Функции реализованы в виде ассемблерной вставки. В архиве тест производительности данных функции и функции _allmul:



Сами функции:

Код (ASM):

1. format PE GUI 4.0 DLL
2. entry EntryPoint
3. include 'win32wx.inc'
4. section '.code' code readable executable
5. proc EntryPoint hinstDLL,fdwReason,lpvReserved
6.         mov     eax,1
7.         ret
8. endp
9. mul64:
10.     mov eax, [esp + 0x10]       ; bh
11.     cmp dword [esp + 0x08], 0   ; ah
12.     je .no_ah
13.     test eax, eax
14.     jnz .set_overflow
15.     mov eax, [esp + 0x0c]       ; bl
16.     mul dword [esp + 0x08]      ; bl * ah
17.     jmp .continue
18.   .no_ah:
19.     test eax, eax
20.     jnz .has_bh
21.     mov eax, [esp + 0x04]       ; al
22.     mul dword [esp + 0x0c]      ; bl
23.     jmp .remove_overflow
24.   .has_bh:
25.     mul dword [esp + 0x04]      ; bh * al
26.   .continue:
27.     test edx, edx
28.     jnz .set_overflow
29.     mov ecx, eax
30.     mov eax, [esp + 0x04]   ; al
31.     mul dword [esp + 0x0c]  ; bl
32.     add edx, ecx
33.     jc .set_overflow
34. .remove_overflow:
35.     mov ecx, [esp + 0x14]
36.     mov [ecx], dword 0
37.     ret 0x14
38. .set_overflow:
39.     mov ecx, [esp + 0x14]
40.     mov [ecx], dword 1
41.     ret 0x14
42. imul64:
43.     push ebx
44.     xor ebx, ebx
45.     mov eax, [esp + 0x0c]       ; ah
46.     bt eax, 31
47.     jnc .check_b
48.     xor ecx, ecx
49.     neg dword [esp + 0x08]      ; - al
50.     sbb ecx, [esp + 0x0c]
51.     mov [esp + 0x0c], ecx
52.     inc ebx
53.   .check_b:
54.     mov eax, [esp + 0x14]       ; bh
55.     bt eax, 31
56.     jnc .mul_start
57.     xor ecx, ecx
58.     neg dword [esp + 0x10]      ; - bl
59.     sbb ecx, [esp + 0x14]
60.     mov [esp + 0x14], ecx
61.     inc ebx
62.     mov eax, ecx
63.   .mul_start:
64.     cmp dword [esp + 0x0c], 0   ; ah
65.     je .no_ah
66.     test eax, eax
67.     jnz .set_overflow
68.     mov eax, [esp + 0x10]       ; bl
69.     mul dword [esp + 0x0c]      ; bl * ah
70.     jmp .continue
71.   .no_ah:
72.     test eax, eax
73.     jnz .has_bh
74.     mov eax, [esp + 0x08]       ; al
75.     mul dword [esp + 0x10]      ; bl
76.     jmp .check_negate
77.   .has_bh:
78.     mul dword [esp + 0x08]      ; bh * al
79.   .continue:
80.     jc .set_overflow
81.     mov ecx, eax
82.     mov eax, [esp + 0x08]   ; al
83.     mul dword [esp + 0x10]  ; bl
84.     add edx, ecx
85.     jc .set_overflow
86.   .check_negate:
87.     jns .process_negate
88.     test eax, eax
89.     jnz .set_overflow
90.     cmp edx, 0x80000000
91.     jnz .set_overflow
92.     test bl, 1
93.     jnz .negate_result
94.     jmp .set_overflow
95.   .process_negate:
96.     test bl, 1
97.     jz .remove_overflow
98.   .negate_result:
99.     xor ecx, ecx
100.     xchg ecx, edx
101.     neg eax
102.     sbb edx, ecx
103. .remove_overflow:
104.     mov ecx, [esp + 0x18]
105.     mov [ecx], dword 0
106.     pop ebx
107.     ret 0x14
108. .set_overflow:
109.     mov ecx, [esp + 0x18]
110.     mov [ecx], dword 1
111.     pop ebx
112.     ret 0x14
113. section '.edata' export data readable
114. export 'mul64.dll', mul64, 'mul64', \
115.                     imul64, 'imul64'
116. section '.reloc' fixups data discardable
117. if $=$$
118.     dd 0,8
119. end if