[SRC] cFrogUCase.cls [by Mr. Frog ©]

[*PsyKE1*]

Hi all!
Here is my new class to change the case when is necessary.

Class

Option Explicit
'======================================================================
' º Class      : cFrogUCase.cls
' º Version    : 1.3
' º Author     : Mr.Frog ©
' º Country    : Spain
' º Mail       : [email protected]
' º Date       : 16/02/2011
' º Twitter    : http://twitter.com/#!/PsYkE1
' º Recommended Websites :
'       http://foro.h-sec.org
'       http://visual-coders.com.ar
'       http://InfrAngeluX.Sytes.Net
'======================================================================
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Function IsCharLowerA Lib "user32" (ByVal cChar As Integer) As Long
Private Declare Function IsCharAlphaNumericA Lib "user32" (ByVal cChar As Integer) As Long
Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal olestr As Long, ByVal BLen As Long) As Long
 
Private lngAscHeader&(0 To 5)
Private intAsc%()
 
Friend Function CorrectUCase(ByRef strText$) As String
Dim lngLength&, Q&
 
    lngLength = LenB(strText) \ 2
    If lngLength Then
        lngAscHeader(3) = StrPtr(strText)
 
        Do While Q < lngLength
            If IsCharAlphaNumericA(intAsc(Q)) Then
                If IsCharLowerA(intAsc(Q)) Then intAsc(Q) = intAsc(Q) - 32
                Exit Do
            End If
            Q = Q + 1
        Loop
 
        Q = Q + 1
        Do While Q < lngLength
            If intAsc(Q) < 64 Then
                Select Case intAsc(Q)
                    Case 33, 46, 63 '! . ?
                        Do
                            Q = Q + 1
                            Select Case intAsc(Q)
                                Case 59, 44, 46 '; , .
                                    Q = Q + 1
                                    GoTo Next_:
                            End Select
                        Loop While Q < lngLength And IsCharAlphaNumericA(intAsc(Q)) = 0
 
                        If IsCharLowerA(intAsc(Q)) Then intAsc(Q) = intAsc(Q) - 32
                End Select
            End If
Next_:      Q = Q + 1
        Loop
 
        PutMem4 VarPtr(CorrectUCase), SysAllocStringByteLen(VarPtr(intAsc(0)), lngLength + lngLength)
    End If
End Function
 
Private Sub Class_Initialize()
    lngAscHeader(0) = &H1&: lngAscHeader(1) = &H2&: lngAscHeader(4) = &H7FFFFFFF
    PutMem4 VarPtrArray(intAsc), VarPtr(lngAscHeader(0))
End Sub
 
Private Sub Class_Terminate()
    PutMem4 VarPtrArray(intAsc), 0&
End Sub

Example:

Private Sub Form_Load()
Dim c As New cFrogUCase
Const s  As String = " hi, i'm a frog, you do not believe me? ok, doesn't matters. special thanks to Merri and LaVolpe! you help me a lot."
 
    Debug.Print c.CorrectUCase(s)
 
    Set c = Nothing
End Sub

Returns:

 Hi, i'm a frog, you do not believe me? Ok, doesn't matters. Special thanks to Merri and LaVolpe! You help me a lot.

See you