Foro de elhacker.net

Private Function FirstWord7913(W1 As String, W2 As String) As Long
 
    If LenB(W1) = 0 Then
            FirstWord7913 = 0
            Exit Function
    End If
 
    If LenB(W2) = 0 Then
            FirstWord7913 = 0
            Exit Function
    End If
 
Dim ST1 As Byte
Dim ST2 As Byte
    ST1 = LCase$(W1)
    ST2 = LCase$(W2)
    If LenB(ST1) = LenB(ST2) Then
        If InStrB(1, ST1, ST2, vbBinaryCompare) Then
            FirstWord7913 = 3
            Exit Function
        End If
    End If
 
Dim B1() As Byte
Dim B2() As Byte
B1 = ST1
B2 = ST2
Dim X As Long
    If UBound(B1) > UBound(B2) Then
        For X = 1 To UBound(B2) Step 2
            If B1(X) < B2(X) Then
                FirstWord7913 = 1
                Exit Function
            ElseIf B1(X) > B2(X) Then
                FirstWord7913 = 2
                Exit Function
            End If
        Next
        FirstWord7913 = 2
        Exit Function
    Else
        For X = 1 To UBound(B1) Step 2
            If B1(X) < B2(X) Then
                FirstWord7913 = 1
                Exit Function
            ElseIf B1(X) > B2(X) Then
                FirstWord7913 = 2
                Exit Function
            End If
        Next
        FirstWord7913 = 1
        Exit Function
    End If
 
End Function

LenB(W1) / 2 = 0

Option Explicit
 
Sub Main()
    Debug.Print kCompare("rana", "")
    Debug.Print kCompare("hola", "holas")
    Debug.Print kCompare("bienvenido", "bienvenida")
    Debug.Print kCompare("Ejemplo", "eJempLIficar")
    Debug.Print kCompare("igual", "igual")
    Debug.Print kCompare("PALABRA", "palabra")
End Sub
 
Public Static Function kCompare(ByRef s1 As String, ByRef s2 As String) As Long
    Dim b()     As Long
    If (LenB(s1) <> 0) And (LenB(s2) <> 0) Then
        If (Not Not b) = False Then
            ReDim b(-1 To 1)
            b(-1) = 1
            b(1) = 2
            b(0) = 3
        End If
        kCompare = b(StrComp(s1, s2, vbTextCompare))
    End If
End Function

Option Explicit
 
Private Sub Form_Load()
 
    Debug.Print CheckWord("elfo", "elefante")
    Debug.Print CheckWord("ave", "zorro")
    Debug.Print CheckWord("hola", "")
    Debug.Print CheckWord("zero", "zerocool")
    Debug.Print CheckWord("feo", "    ")
    Debug.Print CheckWord("frog", "frog")
    Debug.Print CheckWord("faso", "fasa")
    Debug.Print CheckWord("JOJO", "jojo")
 
 
End Sub
 
Function CheckWord(sFirst As String, sSecond As String) As Long
    Dim i       As Integer
    Dim max     As Integer
 
    sFirst = LCase$(Trim$(sFirst))
    sSecond = LCase$(Trim$(sSecond))
 
' Verificar error
    If sFirst = "" Or sSecond = "" Then
        CheckWord = 0: Exit Function
    End If
 
' Establecer valor maximo del bucle
    If Len(sFirst) < Len(sSecond) Then
        max = Len(sFirst)
    Else
        max = Len(sSecond)
    End If
 
'Bucle
For i = 1 To max
 
    If (Left(sFirst, i) < Left(sSecond, i)) Then
        CheckWord = 1
        Exit Function
 
    ElseIf (Left(sFirst, i) > Left(sSecond, i)) Then
        CheckWord = 2
        Exit Function
 
' Si por ahora es igual..
    ElseIf (Left(sFirst, i) = Left(sSecond, i)) Then
 
        If i = max Then ' Si ya termina el bucle comprobamos..
 
            If Len(sFirst) > Len(sSecond) Then
                CheckWord = 2
                Exit Function
            End If
 
            If Len(sFirst) < Len(sSecond) Then
                CheckWord = 1
                Exit Function
            End If
 
' Por descarte..
 
            CheckWord = 3
            Exit Function
 
        End If
    End If
 
Next i
 
End Function
 

 2 
 1 
 0 
 1 
 1 
 3 
 2 
 3 

Option Explicit
Option Compare Text
 
Private Declare Function lstrcmpW Lib "kernel32.dll" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
 
' -1 > Error
' 1  > Iguales
' 0  > primera palabra
' 2  > segunda palabra
Public Static Function CompareMrFrog(ByRef strWord1$, ByRef strWord2$) As Long
    If LenB(strWord1) = 0 Or LenB(strWord2) = 0 Then
        CompareMrFrog = -1
        Exit Function
    End If
 
    If strWord1 = strWord2 Then
        CompareMrFrog = 1
        Exit Function
    End If
 
    CompareMrFrog = lstrcmpW(StrPtr(strWord1), StrPtr(strWord2)) + 1
End Function

    Debug.Print kCompare("feo", "    ")

Option Explicit
Option Base 0
 
Private Declare Sub PutMem4 Lib "msvbvm60.dll" (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 IsCharUpperW Lib "user32.dll" (ByVal lngChar As Long) As Long
 
Private lngAscHeader1&(5), lngAscHeader2&(5)
Private intAsc1%(), intAsc2%()
 
' 0 -> Error
' 1 -> First Word
' 2 -> Equal
' 3 -> Secon Word
Friend Static Function Compare(ByRef strWord1$, ByRef strWord2$) As Long
Dim Q&, L&
 
    L = LenB(strWord1) \ 2
    If L = 0 Or LenB(strWord2) = 0 Then Exit Function
 
    lngAscHeader1(3) = StrPtr(strWord1)
    lngAscHeader2(3) = StrPtr(strWord2)
 
    For Q = 0 To L
        If IsCharUpperW(intAsc1(Q)) Then
            intAsc1(Q) = intAsc1(Q) + 32
        End If
 
        If IsCharUpperW(intAsc2(Q)) Then
            intAsc2(Q) = intAsc2(Q) + 32
        End If
 
        If intAsc2(Q) > intAsc1(Q) Then
            Compare = 1
            Exit Function
        ElseIf intAsc2(Q) < intAsc1(Q) Then
            Compare = 3
            Exit Function
        ElseIf Q = L Then
            Compare = 2
            Exit Function
        End If
    Next Q
End Function
 
Private Sub Class_Initialize()
    lngAscHeader1(0) = &H1&
    lngAscHeader1(1) = &H2&
    lngAscHeader1(4) = &H7FFFFFFF
    PutMem4 VarPtrArray(intAsc1), VarPtr(lngAscHeader1(0))
 
    lngAscHeader2(0) = &H1&
    lngAscHeader2(1) = &H2&
    lngAscHeader2(4) = &H7FFFFFFF
    PutMem4 VarPtrArray(intAsc2), VarPtr(lngAscHeader2(0))
End Sub
 
Private Sub Class_Terminate()
    PutMem4 VarPtrArray(intAsc1), 0&
    PutMem4 VarPtrArray(intAsc2), 0&
End Sub

Private Sub Form_Load()
Dim c As New Class1
 
    Debug.Print "---------------------------------------------"
    Debug.Print c.Compare("rana", "")
    Debug.Print c.Compare("hola", "holas")
    Debug.Print c.Compare("bienvenido", "bienvenida")
    Debug.Print c.Compare("Ejemplo", "eJempLIficar")
    Debug.Print c.Compare("igual", "igual")
    Debug.Print c.Compare("PaLaBrA", "palabra")
    Debug.Print "---------------------------------------------"
    Debug.Print c.Compare("elfo", "elefante")
    Debug.Print c.Compare("ave", "zorro")
    Debug.Print c.Compare("hola", "")
    Debug.Print c.Compare("zero", "zerocool")
    Debug.Print c.Compare("feo", "    ")
    Debug.Print c.Compare("frog", "frog")
    Debug.Print c.Compare("faso", "fasa")
    Debug.Print c.Compare("JOJO", "jojo")
End Sub

---------------------------------------------
 0 
 1 
 3 
 3 
 2 
 2 
---------------------------------------------
 3 
 1 
 0 
 1 
 3 
 2 
 3 
 2 

Private Sub Form_Load()
    With List1
        .AddItem "4paleto"
        .AddItem "paleto"
        .AddItem " paleto"
    End With
End Sub

Private Sub Form_Load()
Dim a() As String
Dim vItem
    a = Split("karcrack es un pesado 4ejemplo %ejemplo", " ")
    QuickSort a
 
    For Each vItem In a
        Debug.Print vItem
    Next
End Sub

%ejemplo
4ejemplo
es
karcrack
pesado
un