From dd9f88dc276c8c49e2175e721daf368d2cd8a083 Mon Sep 17 00:00:00 2001 From: Martin Leduc <31558169+DecimalTurn@users.noreply.github.com> Date: Fri, 19 Jul 2024 18:07:44 -0400 Subject: [PATCH 1/5] Add language annotation pattern to VB6 --- lib/linguist/heuristics.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/linguist/heuristics.yml b/lib/linguist/heuristics.yml index 8a6fcea078..1284033d31 100644 --- a/lib/linguist/heuristics.yml +++ b/lib/linguist/heuristics.yml @@ -92,6 +92,8 @@ disambiguations: pattern: '^[ \t]*#(?i)(?:define|endif|endmacro|ifn?def|include|lang|macro)(?:$|\s)' - language: BASIC pattern: '\A\s*\d' + - language: Visual Basic 6.0 + pattern: '''@Lang (VB\d|Visual Basic \d)' - language: VBA and: - named_pattern: vb-module From 4eaae137ef0ebf640896c92a652d464ee6a835e3 Mon Sep 17 00:00:00 2001 From: Martin Leduc <31558169+DecimalTurn@users.noreply.github.com> Date: Fri, 19 Jul 2024 18:10:57 -0400 Subject: [PATCH 2/5] Add sample --- samples/Visual Basic 6.0/mHook.bas | 83 ++++++++++++++++++++++++++++++ 1 file changed, 83 insertions(+) create mode 100644 samples/Visual Basic 6.0/mHook.bas diff --git a/samples/Visual Basic 6.0/mHook.bas b/samples/Visual Basic 6.0/mHook.bas new file mode 100644 index 0000000000..62076d913b --- /dev/null +++ b/samples/Visual Basic 6.0/mHook.bas @@ -0,0 +1,83 @@ +Attribute VB_Name = "mHook" +'Lang VB6 +Option Explicit + +'-- API: + +#If Win64 Then +Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As GWL_INDEX) As LongPtr +Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As GWL_INDEX, ByVal dwNewLong As LongPtr) As LongPtr +#Else +Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As GWL_INDEX) As Long +Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As GWL_INDEX, ByVal dwNewLong As Long) As Long +#End If +Private Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hWnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr +Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr) + +Private Enum GWL_INDEX + GWL_WNDPROC = (-4) + GWL_HINSTANCE = (-6) + GWL_HWNDPARENT = (-8) + GWL_ID = (-12) + GWL_STYLE = (-16) + GWL_EXSTYLE = (-20) + GWL_USERDATA = (-21) +End Enum + +Private Const WM_ACTIVATE As Long = &H6 +Private Const WM_MOUSEWHEEL As Long = &H20A + +'-- Private variables: + +Private m_lpPrevWndProcLems As LongPtr + + + +'======================================================================================== +' Methods +'======================================================================================== + +Public Sub InitializeHook(oForm As Form) + + m_lpPrevWndProcLems = SetWindowLong(fLems.hWnd, GWL_WNDPROC, AddressOf pvWindowProcLems) +End Sub + +'======================================================================================== +' Private +'======================================================================================== + +Private Sub SendKeysB(ByRef Text As String, Optional ByRef Wait As Boolean) + Static wsh As Object + If wsh Is Nothing Then + Set wsh = CreateObject("WScript.Shell") + End If + wsh.SendKeys Text, Wait +End Sub + +Private Function pvWindowProcLems( _ + ByVal hwnd As LongPtr, _ + ByVal uMsg As Long, _ + ByVal wParam As LongPtr, _ + ByVal lParam As LongPtr _ + ) As LongPtr + + Select Case uMsg + + Case WM_ACTIVATE + + Call mTiming.SetAppActive(CBool(wParam And &HFFFF&)) + + Case WM_MOUSEWHEEL + Dim noExt As Long + CopyMemory noExt, wParam, 4 + If (noExt > 0) Then + 'Call VBA.SendKeys("Z") + SendKeysB "Z" + Else + 'Call VBA.SendKeys("A") + SendKeysB "A" + End If + End Select + + pvWindowProcLems = CallWindowProc(m_lpPrevWndProcLems, hwnd, uMsg, wParam, lParam) +End Function \ No newline at end of file From 145a0558d68ec77356584a1c293dc8279648116e Mon Sep 17 00:00:00 2001 From: Martin Leduc <31558169+DecimalTurn@users.noreply.github.com> Date: Fri, 19 Jul 2024 18:14:58 -0400 Subject: [PATCH 3/5] And EOF linebreak --- samples/Visual Basic 6.0/mHook.bas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/samples/Visual Basic 6.0/mHook.bas b/samples/Visual Basic 6.0/mHook.bas index 62076d913b..2684d42c43 100644 --- a/samples/Visual Basic 6.0/mHook.bas +++ b/samples/Visual Basic 6.0/mHook.bas @@ -80,4 +80,4 @@ Private Function pvWindowProcLems( _ End Select pvWindowProcLems = CallWindowProc(m_lpPrevWndProcLems, hwnd, uMsg, wParam, lParam) -End Function \ No newline at end of file +End Function From 0f0bf0172dd672916deb917ad6a49f6a9c551a20 Mon Sep 17 00:00:00 2001 From: Martin Leduc <31558169+DecimalTurn@users.noreply.github.com> Date: Fri, 19 Jul 2024 18:23:48 -0400 Subject: [PATCH 4/5] local: temp fix for CI --- .github/workflows/ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 59b2233cf4..8c96c72d98 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -29,7 +29,7 @@ jobs: bundler-cache: true - name: Fetch grammar submodules run: | - git fetch origin master:master v2.0.0:v2.0.0 test/attributes:test/attributes test/master:test/master + git fetch origin master:master sed -i 's|git@github.com:|https://github.com/|' .gitmodules git submodule init git submodule sync --quiet From 01b8cab8a1c71366fe1ffe526fdfc5cde1dcda90 Mon Sep 17 00:00:00 2001 From: Martin Leduc <31558169+DecimalTurn@users.noreply.github.com> Date: Fri, 19 Jul 2024 18:30:24 -0400 Subject: [PATCH 5/5] Fix sample --- samples/Visual Basic 6.0/mHook.bas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/samples/Visual Basic 6.0/mHook.bas b/samples/Visual Basic 6.0/mHook.bas index 2684d42c43..4122372ce6 100644 --- a/samples/Visual Basic 6.0/mHook.bas +++ b/samples/Visual Basic 6.0/mHook.bas @@ -1,5 +1,5 @@ Attribute VB_Name = "mHook" -'Lang VB6 +'@Lang VB6 Option Explicit '-- API: