Add support for Windows 98 SE

wqweto · Oct 12, 2024 · 496b6d9 · 496b6d9
1 parent 854df6b
commit 496b6d9
Show file tree

Hide file tree

Showing 11 changed files with 243 additions and 177 deletions.
diff --git a/.gitattributes b/.gitattributes
@@ -12,6 +12,7 @@
 *.vbp        working-tree-encoding=CP1251 text eol=crlf
 *.vbr        working-tree-encoding=CP1251 text eol=crlf
 *.vbw        working-tree-encoding=CP1251 text eol=crlf
+*.vbs        working-tree-encoding=CP1251 text eol=crlf
 
 # Other source files (show diff + LF only in zip download)
 

diff --git a/README.md b/README.md
@@ -14,7 +14,7 @@ Additionally there is a source-compatible `cTlsSocket` class for transparent TLS
 
 3. `mdTlsSodium` is a stripped down compact backend with dependency on libsodium for crypto primitives (no ASM thunking used) with a total compiled size of 64KB.
 
-The VB6 with thunks backend implementation auto-detects AES-NI and PCLMULQDQ instruction set availability on client machine and switches to [performance optimized implementation of AES](https://github.com/wqweto/VbAsyncSocket/blob/4b7f4d8bc650688e2b6ad5460c997ed1df26d2e0/lib/thunks/sshaes.c#L100-L240)[-GCM](https://github.com/wqweto/VbAsyncSocket/blob/4b7f4d8bc650688e2b6ad5460c997ed1df26d2e0/lib/thunks/gf128.c#L116-L165) which is even faster that OS native SSPI/Schannel implementation of this cipher suit. The VB6 with thunks backend and native backend support legacy OSes up to NT 4.0 while libsodium DLL is compiled with XP support only.
+The VB6 with thunks backend implementation auto-detects AES-NI and PCLMULQDQ instruction set availability on client machine and switches to [performance optimized implementation of AES](https://github.com/wqweto/VbAsyncSocket/blob/4b7f4d8bc650688e2b6ad5460c997ed1df26d2e0/lib/thunks/sshaes.c#L100-L240)[-GCM](https://github.com/wqweto/VbAsyncSocket/blob/4b7f4d8bc650688e2b6ad5460c997ed1df26d2e0/lib/thunks/gf128.c#L116-L165) which is even faster that OS native SSPI/Schannel implementation of this cipher suit. The VB6 with thunks backend and native backend support legacy OSes up to NT 4.0 and Windows 98 while libsodium DLL is compiled with XP support only.
 
 ### Usage
 
@@ -93,6 +93,12 @@ Cipher Suite | First&nbsp;In | Selection String | Notes
 
 Note that "exotic" cipher suites are included behind a conditional compilation flag only (off by default).
 
+### Legacy Support
+
+Screenshot from Windows 98 Second Edition running on Pentium II
+
+[<img src="https://dl.unicontsoft.com/upload/pix/ss_vbasyncsocket_win9x.png" width="250"/>](https://dl.unicontsoft.com/upload/pix/ss_vbasyncsocket_win9x.png)
+
 ### ToDo
 
  - [x] Allow client to assign client certificate for connection

diff --git a/contrib/cHttpDownload.cls b/contrib/cHttpDownload.cls
@@ -49,8 +49,10 @@ Private Const STGM_CREATE                   As Long = &H1000
 
 Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 Private Declare Function vbaObjSetAddref Lib "msvbvm60" Alias "__vbaObjSetAddref" (oDest As Any, ByVal lSrcPtr As Long) As Long
-Private Declare Function SHCreateStreamOnFile Lib "shlwapi" Alias "SHCreateStreamOnFileW" (ByVal pszFile As Long, ByVal grfMode As Long, ppstm As IUnknown) As Long
+Private Declare Function SHCreateStreamOnFileW Lib "shlwapi" (ByVal pszFile As Long, ByVal grfMode As Long, ppstm As IUnknown) As Long
+Private Declare Function SHCreateStreamOnFileA Lib "shlwapi" (ByVal pszFile As String, ByVal grfMode As Long, ppstm As IUnknown) As Long
 Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgVt As Any, prgpVarg As Any, pvargResult As Variant) As Long
+Private Declare Function GetVersion Lib "kernel32" () As Long
 
 '=========================================================================
 ' Constants and member variables
@@ -207,7 +209,11 @@ Private Sub pvInit(Url As String, LocalFileName As Variant, ByVal StreamFlags As
     Else
         m_sLocalFileName = LocalFileName
         m_lStreamFlags = StreamFlags
-        hResult = SHCreateStreamOnFile(StrPtr(m_sLocalFileName), m_lStreamFlags, m_pFileStream)
+        If IsNT Then
+            hResult = SHCreateStreamOnFileW(StrPtr(m_sLocalFileName), m_lStreamFlags, m_pFileStream)
+        Else
+            hResult = SHCreateStreamOnFileA(m_sLocalFileName, m_lStreamFlags, m_pFileStream)
+        End If
         If hResult < 0 Then
             On Error GoTo 0
             Err.Raise hResult
@@ -554,6 +560,10 @@ Private Function DispCallByVtbl(pUnk As IUnknown, ByVal lIndex As Long, ParamArr
     End If
 End Function
 
+Private Function IsNT() As Boolean
+    IsNT = (GetVersion() >= 0)
+End Function
+
 '=========================================================================
 ' Socket events
 '=========================================================================

diff --git a/contrib/cHttpRequest.cls b/contrib/cHttpRequest.cls
@@ -122,11 +122,13 @@ Private Declare Function IsBadReadPtr Lib "kernel32" (ByVal lp As Long, ByVal uc
 Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
 Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
 Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
+Private Declare Function GetVersion Lib "kernel32" () As Long
 Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgVt As Any, prgpVarg As Any, pvargResult As Variant) As Long
 Private Declare Function WinHttpGetDefaultProxyConfiguration Lib "winhttp" (pProxyInfo As Any) As Long
 '--- shlwapi
 Private Declare Function SHCreateMemStream Lib "shlwapi" Alias "#12" (pInit As Any, ByVal cbInit As Long) As stdole.IUnknown
-Private Declare Function UrlEscape Lib "shlwapi" Alias "UrlEscapeW" (ByVal pszURL As Long, ByVal pszEscaped As Long, pcchEscaped As Long, ByVal dwFlags As Long) As Long
+Private Declare Function UrlEscapeW Lib "shlwapi" (ByVal pszURL As Long, ByVal pszEscaped As String, pcchEscaped As Long, ByVal dwFlags As Long) As Long
+Private Declare Function UrlEscapeA Lib "shlwapi" (ByVal pszURL As String, ByVal pszEscaped As String, pcchEscaped As Long, ByVal dwFlags As Long) As Long
 '--- libarchive
 Private Declare Function archive_read_new Lib "archiveint" Alias "_archive_read_new@0" () As Long
 Private Declare Function archive_read_free Lib "archiveint" Alias "_archive_read_free@4" (ByVal hArchive As Long) As Long
@@ -140,8 +142,8 @@ Private Declare Function archive_read_data Lib "archiveint" Alias "_archive_read
     Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
     '--- for Modern Subclassing Thunk (MST)
     Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
-    Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcW" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
-    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal lpModuleName As Long) As Long
+    Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
+    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
     Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
     '--- end MST
 #End If
@@ -1143,10 +1145,18 @@ Private Function pvEscapePart(ByVal sPart As String, ByVal lFlags As Long) As St
 
     lSize = Len(sPart)
     sOutput = String$(lSize, 0)
-    hResult = UrlEscape(StrPtr(sPart), StrPtr(sOutput), lSize, lFlags)
+    If IsNT Then
+        hResult = UrlEscapeW(StrPtr(sPart), StrPtr(sOutput), lSize, lFlags)
+    Else
+        hResult = UrlEscapeA(sPart, sOutput, lSize, lFlags)
+    End If
     If hResult = E_POINTER Then
         sOutput = String$(lSize, 0)
-        hResult = UrlEscape(StrPtr(sPart), StrPtr(sOutput), lSize, lFlags)
+        If IsNT Then
+            hResult = UrlEscapeW(StrPtr(sPart), StrPtr(sOutput), lSize, lFlags)
+        Else
+            hResult = UrlEscapeA(sPart, sOutput, lSize, lFlags)
+        End If
     End If
     If hResult < 0 Then
         Err.Raise hResult, "UrlEscape", m_oSocket.GetErrorDescription(hResult)
@@ -1886,6 +1896,10 @@ Private Function DispCallByVtbl(pUnk As IUnknown, ByVal lIndex As Long, ParamArr
     End If
 End Function
 
+Private Function IsNT() As Boolean
+    IsNT = (GetVersion() >= 0)
+End Function
+
 Private Sub pvBufferWriteArray(uOutput As UcsBuffer, baSrc() As Byte)
     Dim lSize       As Long
 
@@ -1955,7 +1969,7 @@ Private Function InitAddressOfMethod(pObj As Object, ByVal MethodParamCount As L
     Dim lSize           As Long
 
     hThunk = pvThunkAllocate(STR_THUNK, THUNK_SIZE)
-    lSize = CallWindowProc(hThunk, ObjPtr(pObj), MethodParamCount, GetProcAddress(GetModuleHandle(StrPtr("kernel32")), "VirtualFree"), VarPtr(InitAddressOfMethod))
+    lSize = CallWindowProc(hThunk, ObjPtr(pObj), MethodParamCount, GetProcAddress(GetModuleHandle("kernel32"), "VirtualFree"), VarPtr(InitAddressOfMethod))
     Debug.Assert lSize = THUNK_SIZE
 End Function
 

diff --git a/contrib/cRateLimiter.cls b/contrib/cRateLimiter.cls
@@ -40,16 +40,16 @@ Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency A
 '--- for Modern Subclassing Thunk (MST)
 Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
-Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcW" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
-Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal lpModuleName As Long) As Long
+Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
+Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
 Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
 Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
 #If Not ImplNoIdeProtection Then
-    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExW" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As Long, ByVal lpszWindow As Long) As Long
+    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
     Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
 #End If
-Private Declare Function GetEnvironmentVariable Lib "kernel32" Alias "GetEnvironmentVariableW" (ByVal lpName As Long, ByVal lpBuffer As Long, ByVal nSize As Long) As Long
-Private Declare Function SetEnvironmentVariable Lib "kernel32" Alias "SetEnvironmentVariableW" (ByVal lpName As Long, ByVal lpValue As Long) As Long
+Private Declare Function GetEnvironmentVariable Lib "kernel32" Alias "GetEnvironmentVariableA" (ByVal lpName As String, ByVal lpBuffer As String, ByVal nSize As Long) As Long
+Private Declare Function SetEnvironmentVariable Lib "kernel32" Alias "SetEnvironmentVariableA" (ByVal lpName As String, ByVal lpValue As String) As Long
 '--- end MST
 
 '=========================================================================
@@ -156,7 +156,7 @@ Private Function InitAddressOfMethod(pObj As Object, ByVal MethodParamCount As L
     If hThunk = 0 Then
         Exit Function
     End If
-    lSize = CallWindowProc(hThunk, ObjPtr(pObj), MethodParamCount, GetProcAddress(GetModuleHandle(StrPtr("kernel32")), "VirtualFree"), VarPtr(InitAddressOfMethod))
+    lSize = CallWindowProc(hThunk, ObjPtr(pObj), MethodParamCount, GetProcAddress(GetModuleHandle("kernel32"), "VirtualFree"), VarPtr(InitAddressOfMethod))
     Debug.Assert lSize = THUNK_SIZE
 End Function
 
@@ -179,16 +179,16 @@ Private Function InitFireOnceTimerThunk(pObj As Object, ByVal pfnCallback As Lon
         If hThunk = 0 Then
             Exit Function
         End If
-        aParams(2) = GetProcAddress(GetModuleHandle(StrPtr("ole32")), "CoTaskMemAlloc")
-        aParams(3) = GetProcAddress(GetModuleHandle(StrPtr("ole32")), "CoTaskMemFree")
-        aParams(4) = GetProcAddress(GetModuleHandle(StrPtr("user32")), "SetTimer")
-        aParams(5) = GetProcAddress(GetModuleHandle(StrPtr("user32")), "KillTimer")
+        aParams(2) = GetProcAddress(GetModuleHandle("ole32"), "CoTaskMemAlloc")
+        aParams(3) = GetProcAddress(GetModuleHandle("ole32"), "CoTaskMemFree")
+        aParams(4) = GetProcAddress(GetModuleHandle("user32"), "SetTimer")
+        aParams(5) = GetProcAddress(GetModuleHandle("user32"), "KillTimer")
         '--- for IDE protection
         Debug.Assert pvThunkIdeOwner(aParams(6))
         If aParams(6) <> 0 Then
-            aParams(7) = GetProcAddress(GetModuleHandle(StrPtr("user32")), "GetWindowLongA")
-            aParams(8) = GetProcAddress(GetModuleHandle(StrPtr("vba6")), "EbMode")
-            aParams(9) = GetProcAddress(GetModuleHandle(StrPtr("vba6")), "EbIsResetting")
+            aParams(7) = GetProcAddress(GetModuleHandle("user32"), "GetWindowLongA")
+            aParams(8) = GetProcAddress(GetModuleHandle("vba6"), "EbMode")
+            aParams(9) = GetProcAddress(GetModuleHandle("vba6"), "EbIsResetting")
         End If
         #If ImplSelfContained Then
             pvThunkGlobalData("InitFireOnceTimerThunk") = hThunk
@@ -203,7 +203,7 @@ Private Function pvThunkIdeOwner(hIdeOwner As Long) As Boolean
         Dim lProcessId      As Long
 
         Do
-            hIdeOwner = FindWindowEx(0, hIdeOwner, StrPtr("IDEOwner"), 0)
+            hIdeOwner = FindWindowEx(0, hIdeOwner, "IDEOwner", vbNullString)
             Call GetWindowThreadProcessId(hIdeOwner, lProcessId)
         Loop While hIdeOwner <> 0 And lProcessId <> GetCurrentProcessId()
     #End If
@@ -246,12 +246,12 @@ Private Property Get pvThunkGlobalData(sKey As String) As Long
     Dim sBuffer     As String
 
     sBuffer = String$(50, 0)
-    Call GetEnvironmentVariable(StrPtr("_MST_GLOBAL" & GetCurrentProcessId() & "_" & sKey), StrPtr(sBuffer), Len(sBuffer) - 1)
+    Call GetEnvironmentVariable("_MST_GLOBAL" & GetCurrentProcessId() & "_" & sKey, sBuffer, Len(sBuffer) - 1)
     pvThunkGlobalData = Val(Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1))
 End Property
 
 Private Property Let pvThunkGlobalData(sKey As String, ByVal lValue As Long)
-    Call SetEnvironmentVariable(StrPtr("_MST_GLOBAL" & GetCurrentProcessId() & "_" & sKey), StrPtr(lValue))
+    Call SetEnvironmentVariable("_MST_GLOBAL" & GetCurrentProcessId() & "_" & sKey, lValue)
 End Property
 
 '=========================================================================

diff --git a/samples/vbscript examples/GetGoogle.vbs b/samples/vbscript examples/GetGoogle.vbs
@@ -1,22 +1,22 @@
-Option Explicit
-
-' This is a simple barebones GET for VBScript
-' It works for me in Win7-64.
-
-' I put the HttpRequest.dll from here into SysWOW64 and registered it with regsvr32.exe.
-
-' Be sure to run using the 32-bit cscript, if you have a 64-bit OS
-' C:\Windows\SysWOW64\cscript.exe GetGoogle.vbs
-
-Dim URL : URL = "https://www.google.com"
-
-With CreateObject("HttpRequest.cHttpRequest")
-  .Open_ "GET", URL
-  .Send
-
-  If .Status = 200 Then
-    msgbox "RESPONSE : " & .responseText
-  Else
-    msgbox "Oops, Status : " & .Status
-  End If
-End With
+Option Explicit
+
+' This is a simple barebones GET for VBScript
+' It works for me in Win7-64.
+
+' I put the HttpRequest.dll from here into SysWOW64 and registered it with regsvr32.exe.
+
+' Be sure to run using the 32-bit cscript, if you have a 64-bit OS
+' C:\Windows\SysWOW64\cscript.exe GetGoogle.vbs
+
+Dim URL : URL = "https://www.google.com"
+
+With CreateObject("HttpRequest.cHttpRequest")
+  .Open_ "GET", URL
+  .Send
+
+  If .Status = 200 Then
+    msgbox "RESPONSE : " & .responseText
+  Else
+    msgbox "Oops, Status : " & .Status
+  End If
+End With
diff --git a/samples/vbscript examples/TwitchVIP.vbs b/samples/vbscript examples/TwitchVIP.vbs
@@ -1,51 +1,51 @@
-Option Explicit
-
-' This script sets or unsets someone to be a VIP in a Twitch channel.
-' It works for me in Win7-64.
-' I put the HttpRequest.dll from here into SysWOW64 and registered it with regsvr32.exe.
-
-' Example:
-' C:\Windows\SysWOW64\cscript.exe TwitchVIP.vbs 1 username
-' will set username as VIP.  (0 to remove)
-
-Dim clientid, apioauth, broadcasterid
-' Note:  These need to be set, and the oAuth needs to permit this action,
-' but that's outside the scope of this example
-
-Dim URL, userid
-URL = "https://api.twitch.tv/helix/users?login=" & WScript.Arguments(1)
-
-With CreateObject("HttpRequest.cHttpRequest")
-  .Open_ "GET",URL
-  .setRequestHeader "Client-Id",clientid
-  .setRequestHeader "Authorization", "Bearer " & apioauth
-  .Send
-
-'   msgbox "RESPONSE : " & .responseText
-  If .Status = 200 Then
-      Dim y, html : Set html = CreateObject("htmlfile")
-      Dim w : Set w = html.parentWindow
-      w.execScript "var json=" & .responseText & ";var e=new Enumerator(json.data);", "JScript"
-      While Not w.e.atEnd()
-          Set y = w.e.item()
-          userid=y.id
-          w.e.moveNext
-      Wend
-  End If
-End With
-
-With CreateObject("HttpRequest.cHttpRequest")
-  URL = "https://api.twitch.tv/helix/channels/vips"
-  If WScript.Arguments(0) = 1 Then
-    .open_ "POST",URL
-  Else
-    .open_ "DELETE",URL
-  End If
-  .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
-  .setRequestHeader "Authorization", "Bearer " & apioauth
-  .setRequestHeader "Client-ID",clientid
-  .send "broadcaster_id=" & broadcasterid & "&user_id=" & userid
-
-' msgbox .responseText
-
+Option Explicit
+
+' This script sets or unsets someone to be a VIP in a Twitch channel.
+' It works for me in Win7-64.
+' I put the HttpRequest.dll from here into SysWOW64 and registered it with regsvr32.exe.
+
+' Example:
+' C:\Windows\SysWOW64\cscript.exe TwitchVIP.vbs 1 username
+' will set username as VIP.  (0 to remove)
+
+Dim clientid, apioauth, broadcasterid
+' Note:  These need to be set, and the oAuth needs to permit this action,
+' but that's outside the scope of this example
+
+Dim URL, userid
+URL = "https://api.twitch.tv/helix/users?login=" & WScript.Arguments(1)
+
+With CreateObject("HttpRequest.cHttpRequest")
+  .Open_ "GET",URL
+  .setRequestHeader "Client-Id",clientid
+  .setRequestHeader "Authorization", "Bearer " & apioauth
+  .Send
+
+'   msgbox "RESPONSE : " & .responseText
+  If .Status = 200 Then
+      Dim y, html : Set html = CreateObject("htmlfile")
+      Dim w : Set w = html.parentWindow
+      w.execScript "var json=" & .responseText & ";var e=new Enumerator(json.data);", "JScript"
+      While Not w.e.atEnd()
+          Set y = w.e.item()
+          userid=y.id
+          w.e.moveNext
+      Wend
+  End If
+End With
+
+With CreateObject("HttpRequest.cHttpRequest")
+  URL = "https://api.twitch.tv/helix/channels/vips"
+  If WScript.Arguments(0) = 1 Then
+    .open_ "POST",URL
+  Else
+    .open_ "DELETE",URL
+  End If
+  .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
+  .setRequestHeader "Authorization", "Bearer " & apioauth
+  .setRequestHeader "Client-ID",clientid
+  .send "broadcaster_id=" & broadcasterid & "&user_id=" & userid
+
+' msgbox .responseText
+
 End With