' by Donald, donald@xbeat.net, 20011209 ' needs BStrApi.tlb (BStrAPI - Guido's VB-Speed API-Interface) Option Explicit ' VB5 -> msvbvm50.dll Private Declare Function ArrPtr& Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any) Private Declare Sub RtlMoveMemory Lib "kernel32" (dst As Any, src As Any, ByVal nBytes&) Private Declare Sub RtlZeroMemory Lib "kernel32" (dst As Any, ByVal nBytes&) ' under Win95/98 the code for CharLowerBuffW/CharUpperBuffW is stubbed out ' if you got NT/2000 tell me whether it works! Private Declare Function CharLowerBuffW& Lib "user32" (lpsz As Any, ByVal cchLength&) Private Declare Function CharUpperBuffW& Lib "user32" (lpsz As Any, ByVal cchLength&) Private Declare Function CharLowerBuffA& Lib "user32" (lpsz As Any, ByVal cchLength&) Private Declare Function CharUpperBuffA& Lib "user32" (lpsz As Any, ByVal cchLength&) Private aSrc() As Integer, saSrc As BStrAPI.SafeArray1D Private aDst() As Integer, saDst As BStrAPI.SafeArray1D Private aLChars(&H8000 To &H7FFF) As Integer Private aUChars(&H8000 To &H7FFF) As Integer Private Sub Class_Initialize() Dim c As Long Dim ret As Long saSrc.cDims = 1 saSrc.cbElements = 2 saSrc.cElements1D = &H7FFFFFFF RtlMoveMemory ByVal ArrPtr(aSrc), VarPtr(saSrc), 4 saDst = saSrc: RtlMoveMemory ByVal ArrPtr(aDst), VarPtr(saDst), 4 ' init LCase LUT For c = -32768 To 32767: aLChars(c) = c: Next If CharLowerBuffW(aLChars(-32768), &H10000) = 0 Then ' for 0 to 255 CharUpperBuffA <=> Asc(UCase$(Chr$(c))) ret = CharLowerBuffA(aLChars(0), 256 * 2) '2 bytes/char End If ' patch the stooges ' Š 138/352 š 154/353 ' Œ 140/338 œ 156/339 ' Ž 142/381 ž 158/382 ' Ÿ 159/376 ÿ 255/255 aLChars(352) = 353 aLChars(338) = 339 aLChars(381) = 382 aLChars(376) = 255 ' init UCase LUT For c = -32768 To 32767: aUChars(c) = c: Next If CharUpperBuffW(aUChars(-32768), &H10000) = 0 Then ' if W-API does not work let's go for the ANSI set ' for 0 to 255 CharUpperBuffA <=> Asc(UCase$(Chr$(c))) ret = CharUpperBuffA(aUChars(0), 256 * 2) '2 bytes/char End If ' patch the stooges ' š 154/353 Š 138/352 ' œ 156/339 Œ 140/338 ' ž 158/382 Ž 142/381 ' ÿ 255/255 Ÿ 159/376 aUChars(353) = 352 aUChars(339) = 338 aUChars(382) = 381 aUChars(255) = 376 End Sub Private Sub Class_Terminate() ' clear the fake array pointers before VB does RtlZeroMemory ByVal ArrPtr(aSrc), 4 RtlZeroMemory ByVal ArrPtr(aDst), 4 End Sub Friend Function UCase04(ByRef sString As String) As String ' by Donald, donald@xbeat.net, 20011209 Dim c As Long Dim lLen As Long lLen = Len(sString) UCase04 = BStrAPI.SysAllocStringLenPtr(ByVal 0&, lLen) saSrc.pvData = StrPtr(sString) saDst.pvData = StrPtr(UCase04) For c = 0 To lLen - 1 aDst(c) = aUChars(aSrc(c)) Next End Function Friend Function LCase04(ByRef sString As String) As String ' by Donald, donald@xbeat.net, 20011209 Dim c As Long Dim lLen As Long lLen = Len(sString) LCase04 = BStrAPI.SysAllocStringLenPtr(ByVal 0&, lLen) saSrc.pvData = StrPtr(sString) saDst.pvData = StrPtr(LCase04) For c = 0 To lLen - 1 aDst(c) = aLChars(aSrc(c)) Next End Function Friend Function LCase05(ByRef sString As String) As String ' by Paul, wpsjr1@syix.com, 20011209 Dim lLen As Long lLen = Len(sString) LCase05 = FastString.SysAllocStringLenBstr(sString, lLen) saDst.pvData = StrPtr(LCase05) Do While lLen lLen = lLen - 1 aDst(lLen) = aLChars(aDst(lLen)) Loop End Function Friend Function UCase05(ByRef sString As String) As String ' by Paul, wpsjr1@syix.com, 20011209 Dim lLen As Long lLen = Len(sString) UCase05 = FastString.SysAllocStringLenBstr(sString, lLen) saDst.pvData = StrPtr(UCase05) Do While lLen lLen = lLen - 1 aDst(lLen) = aUChars(aDst(lLen)) Loop End Function