Option Explicit
 
#Const INSERTCRC32TOEXE = False
 
Public Function itsOkCRC32() As Boolean
'   //
'   //  Funcion itsOkCRC32 creada por BlackZeroX (http://infrangelux.hostei.com)
'   //
'   //  Instrucciones:
'   //  * COMPILA TU EXE FINAL con la constante INSERTCRC32TOEXE = false.
'   //  * Cambia INSERTCRC32TOEXE de false a true ( #Const INSERTCRC32TOEXE = true )
'   //  * Cambia la linea  {Open "c:\testCRC32.exe" For Binary As hFile} de este proceso con
'   //  la ruta del exe que compilaste anteriormente, por ejemplo {Open "c:\testCRC32.exe" For Binary As hFile}
'   //  * Ejecuta el proyecto desde este IDE, si todo a ido correctamente les aparecera un mensaje {"CRC32 configurado Correctamente"}.
'   //  * Comprube tu EXE Final {c:\testCRC32.exe} ejecutandolo directamente.
'   //  Si todo a hido correctamente el exe te mostrara {"CRC32 Correcto"} si solo has generado el exe y no cambiaste {INSERTCRC32TOEXE a true} te mostrara {"CRC32 erroneo"} en este ejemplo.
 
Dim byteData()              As Byte
Dim dwSizeFile              As Long
Dim dwCRC32ReadFile         As Long
Dim dwCRC32Generate         As Long
Dim oCRC32                  As cCRC32
Dim hFile                   As Integer
 
    hFile = FreeFile
#If (INSERTCRC32TOEXE = False) Then
    Open App.Path & "\" & App.EXEName & ".exe" For Binary As hFile
#Else
    Open "c:\testCRC32.exe" For Binary As hFile
#End If
        dwSizeFile = LOF(hFile)
        If ((dwSizeFile - 4) > 0) Then
#If (INSERTCRC32TOEXE = True) Then
            ReDim byteData(0 To (dwSizeFile - 1))
#Else
            ReDim byteData(0 To (dwSizeFile - 1 - 4))
#End If
            Get 1, , byteData
            Get 1, , dwCRC32ReadFile
 
            Set oCRC32 = New cCRC32
            dwCRC32Generate = oCRC32.GetByteArrayCrc32(byteData)
            Set oCRC32 = Nothing
 
            If (dwCRC32Generate = dwCRC32ReadFile) Then
                itsOkCRC32 = True
#If (INSERTCRC32TOEXE = True) Then
                MsgBox "CRC32 Ya se encontraba configurado."
            Else
                Put hFile, , dwCRC32Generate
                MsgBox "CRC32 configurado Correctamente."
                End
#End If
            End If
        End If
    Close hFile
 
End Function
 
 

Option Explicit

' This code is taken from the VB.NET CRC32 algorithm
' provided by Paul (wpsjr1@succeed.net) - Excellent work!

Private crc32Table() As Long

Public Function GetByteArrayCrc32(ByRef buffer() As Byte) As Long
Dim crc32Result     As Long:    crc32Result = &HFFFFFFFF
Dim i               As long
Dim iLookup         As long
   
   For i = LBound(buffer) To UBound(buffer)
      iLookup = (crc32Result And &HFF) Xor buffer(i)
      crc32Result = ((crc32Result And &HFFFFFF00) \ &H100) And 16777215 ' nasty shr 8 with vb :/
      crc32Result = crc32Result Xor crc32Table(iLookup)
   Next i
   
   GetByteArrayCrc32 = Not (crc32Result)

End Function



Private Sub Class_initialize()

    ' This is the official polynomial used by CRC32 in PKZip.
    ' Often the polynomial is shown reversed (04C11DB7).
    Dim dwPolynomial As Long
    dwPolynomial = &HEDB88320
    Dim i As Integer, j As Integer

    ReDim crc32Table(256)
    Dim dwCrc As Long

    For i = 0 To 255
        dwCrc = i
        For j = 8 To 1 Step -1
            If (dwCrc And 1) Then
                dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
                dwCrc = dwCrc Xor dwPolynomial
            Else
                dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
            End If
        Next j
        crc32Table(i) = dwCrc
    Next i

End Sub

Private Sub Class_Terminate()
    Erase crc32Table
End Sub

 
option explicit
 
Sub main()
    If (itsOkCRC32) Then
        MsgBox "CRC32 Correcto"
    Else
        MsgBox "CRC32 erroneo"
    End If
End Sub
 
 

 
Private Sub Form_Load()
    MsgBox numberToName(InputBox("Ingresa un numero cualquiera", "numberToName", "87984516512"))
End Sub
 
 

 
'
'   /////////////////////////////////////////////////////////////
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandecido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////
'   // http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=8:arrtnum2string&catid=2:catprocmanager&Itemid=3
'   /////////////////////////////////////////////////////////////
 
Option Explicit
 
Public Function numberToName(ByVal sNumber As String) As String
'   //  MAXIMO  --> 999999999999999999999999999999999999999999999999999999999999999999 ' sección Decillones...
 
'   //  Millon          1 * 10^6
'   //  Billon          1 * 10^12
'   //  Trillon         1 * 10^18
'   //  Cuatrillón      1 * 10^24
'   //  Quintillón      1 * 10^30
'   //  Sextillón       1 * 10^36
'   //  Sptillon        1 * 10^42
'   //  Octillón        1 * 10^48
'   //  Sextillón       1 * 10^54
'   //  Octillón        1 * 10^60
'   //  <--Son bastantes numeros... como para seguirle no creen?-->
 
Dim i           As Long
Dim lLn         As Long
Dim sTmp        As String
Dim bCentena    As Byte
Dim bDecena     As Byte
Dim bUnidad     As Byte
Const MAXLEN    As Long = &H42
 
    lLn = Len(sNumber)
    If (lLn > MAXLEN) Or (lLn = 0) Then Exit Function
 
    sTmp = String$(MAXLEN, "0")
 
    Mid$(sTmp, MAXLEN - lLn + 1) = Mid$(sNumber, 1, lLn)
 
    For i = 1 To MAXLEN Step 3
 
        bCentena = CByte(Mid$(sTmp, i, 1))
        bDecena = CByte(Mid$(sTmp, i + 1, 1))
        bUnidad = CByte(Mid$(sTmp, i + 2, 1))
 
        numberToName = numberToName & centena(bUnidad, bDecena, bCentena) & _
                                      decena(bUnidad, bDecena) & _
                                      unidad(bUnidad, bDecena) & _
                                      IIf(Not (i = (MAXLEN - &H2)), getLeyenda(sNumber, i, bUnidad, bDecena, bCentena), "")
    Next
 
End Function
 
Private Function getLeyenda(ByRef sTmp As String, ByVal i As Long, ByVal bUnidad As Byte, ByVal bDecena As Byte, ByVal bCentena As Byte) As String
'   //  Se obtiene la leyenda con referencia a la ESCALA CORTA.
 
    Select Case i
        Case &H4
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "decillon "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "decillones "
            End If
 
        Case &HA
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "nonillon "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "nonillones "
            End If
 
        Case &H10
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "octillón "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "octillónes "
            End If
 
        Case &H16
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "septillon "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "septillones "
            End If
 
        Case &H1C
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "sextillón "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "sextillónes "
            End If
 
        Case &H22
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "quintillón "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "quintillónes "
            End If
 
        Case &H28
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "cuatrillón "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "cuatrillónes "
            End If
 
        Case &H2E
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "trillon "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "trillones "
            End If
 
        Case &H34
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "billón "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "billones "
            End If
 
        Case &H3A
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "millón "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "millones "
            End If
 
        Case Else
            If ((bCentena + bDecena + bUnidad) > 1) Then getLeyenda = "mil "
 
    End Select
 
End Function
 
Private Function centena(ByVal bUnidad As Byte, ByVal bDecena As Byte, ByVal bCentena As Byte) As String
    Select Case bCentena
        Case 1: If (bDecena + bUnidad) = 0 Then centena = "cien " Else centena = "ciento "
        Case 2: centena = "doscientos "
        Case 3: centena = "trescientos "
        Case 4: centena = "cuatrocientos "
        Case 5: centena = "quinientos "
        Case 6: centena = "seiscientos "
        Case 7: centena = "setecientos "
        Case 8: centena = "ochocientos "
        Case 9: centena = "novecientos "
    End Select
End Function
 
Private Function decena(ByVal bUnidad As Byte, ByVal bDecena As Byte) As String
    Select Case bDecena
        Case 1
            Select Case bUnidad
                Case 0: decena = "diez "
                Case 1: decena = "once "
                Case 2: decena = "doce "
                Case 3: decena = "trece "
                Case 4: decena = "catorce "
                Case 5: decena = "quince "
                Case 6 To 9: decena = "dieci "
            End Select
        Case 2
            If bUnidad = 0 Then
                decena = "veinte "
            ElseIf bUnidad > 0 Then
                decena = "veinti "
            End If
        Case 3: decena = "treinta "
        Case 4: decena = "cuarenta "
        Case 5: decena = "cincuenta "
        Case 6: decena = "sesenta "
        Case 7: decena = "setenta "
        Case 8: decena = "ochenta "
        Case 9: decena = "noventa "
    End Select
    If bUnidad > 0 And bDecena > 2 Then decena = decena + "y "
End Function
 
Private Function unidad(ByVal bUnidad As Byte, ByVal bDecena As Byte) As String
    If bDecena <> 1 Then
        Select Case bUnidad
            Case 1: unidad = "un "
            Case 2: unidad = "dos "
            Case 3: unidad = "tres "
            Case 4: unidad = "cuatro "
            Case 5: unidad = "cinco "
        End Select
    End If
    Select Case bUnidad
            Case 6: unidad = "seis "
            Case 7: unidad = "siete "
            Case 8: unidad = "ocho "
            Case 9: unidad = "nueve "
    End Select
End Function
 
 

 
'
'   /////////////////////////////////////////////////////////////
'   //                                                         //
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandesido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////
'  // http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=35:cspectrumcolor&catid=15:catmoduloscls&Itemid=24
'   /////////////////////////////////////////////////////////////
 
Option Explicit
 
Private lRGBA       As Long
 
Public Property Get color() As Long
    color = lRGBA
End Property
 
Public Property Let color(ByVal lColor As Long)
    lRGBA = lColor
End Property
 
Public Function spectrumEqualL(ByVal lColorRGBA As Long, Optional ByVal lTolerance As Long = 10) As Boolean
Dim oSpectrum       As cSpectrumColor
    Set oSpectrum = New cSpectrumColor
    oSpectrum.color = lColorRGBA
    spectrumEqualL = spectrumEqualC(oSpectrum)
    Set oSpectrum = Nothing
End Function
 
Public Function spectrumEqualC(ByVal oSpectrum As cSpectrumColor, Optional ByVal lTolerance As Long = 10) As Boolean
Dim lRed(1)             As Long
Dim lGreen(1)           As Long
Dim lBlue(1)            As Long
Dim lBackColor          As Long
 
    lBackColor = oSpectrum.spectrumScale(oSpectrum.scaleFactorL(lRGBA) - 100)
    Call oSpectrum.componentsRGBA(lRed(1), lGreen(1), lBlue(1), &H0)
    oSpectrum.color = lBackColor
 
    Call componentsRGBA(lRed(0), lGreen(0), lBlue(0), &H0)
 
    If (max(lRed(0), lRed(1)) - min(lRed(0), lRed(1)) < lTolerance) Then
        If (max(lGreen(0), lGreen(1)) - min(lGreen(0), lGreen(1)) < lTolerance) Then
            If (max(lBlue(0), lBlue(1)) - min(lBlue(0), lBlue(1)) < lTolerance) Then
                spectrumEqualC = True
            End If
        End If
    End If
End Function
 
Public Function spectrumScale(ByVal lScale As Double) As Long
Dim lRed                As Long
Dim lGreen              As Long
Dim lBlue               As Long
'Dim lAlpha              As Long
 
    spectrumScale = lRGBA
    Call componentsRGBA(lRed, lGreen, lBlue, &H0)
    Call Me.colorFromRGBA(((lRed * (lScale / 100)) + lRed), ((lGreen * (lScale / 100)) + lGreen), ((lBlue * (lScale / 100)) + lBlue), &H0)
End Function
 
Public Function scaleFactorL(ByVal lColorRGBA As Long) As Double
Dim lRed                As Long
Dim lGreen              As Long
Dim lBlue               As Long
'Dim lAlpha              As Long
 
    Call componentsRGBA(lRed, lGreen, lBlue, &H0)
 
    Select Case max3(lRed, lGreen, lBlue)
        Case lRed: If (lRed) Then scaleFactorL = (lColorRGBA And &HFF&) * 100 / lRed
        Case lGreen: If (lGreen) Then scaleFactorL = ((lColorRGBA And &HFF00&) \ &H100&) * 100 / lGreen
        Case lBlue: If (lBlue) Then scaleFactorL = ((lColorRGBA And &HFF0000) \ &H10000) * 100 / lBlue
    End Select
 
End Function
 
Public Function scaleFactorC(ByVal oSpectrum As cSpectrumColor) As Double
    scaleFactorC = scaleFactorL(oSpectrum.color())
End Function
 
Private Function max(ByVal lVal1 As Long, ByVal lval2 As Long) As Long
    If (lVal1 > lval2) Then
        max = lVal1
    Else
        max = lval2
    End If
End Function
 
Private Function min(ByVal lVal1 As Long, ByVal lval2 As Long) As Long
    If (lVal1 < lval2) Then
        min = lVal1
    Else
        min = lval2
    End If
End Function
 
Private Function max3(ByVal lVal1 As Long, ByVal lval2 As Long, ByVal lval3 As Long) As Long
    max3 = max(max(lVal1, lval2), lval3)
End Function
 
Public Sub componentsRGBA(ByRef lRed As Long, ByRef lGreen As Long, ByRef lBlue As Long, ByRef lAlpha As Long)
    lRed = (lRGBA And &HFF&)
    lGreen = ((lRGBA And &HFF00&) / &H100&)
    lBlue = ((lRGBA And &HFF0000) / &H10000)
    lAlpha = ((lRGBA And &HFF000000) / &H1000000)
End Sub
 
Public Sub colorFromRGBA(ByVal lRed As Long, ByVal lGreen As Long, ByVal lBlue As Long, ByVal lAlpha As Long)
    lRGBA = (lRed)
    lRGBA = (lRGBA Or ((lGreen And &HFF&) * &H100&))
    lRGBA = (lRGBA Or ((lBlue And &HFF&) * &H10000))
    lRGBA = (lRGBA Or ((lAlpha And &HFF&) * &H1000000))
End Sub
 
 

 
 
'   //  En un form...
'   //  Se requieren 6 VScroll (con propiedad Index).
'   //  Se requieren 2 PictureBox (con propiedad Index)
 
Option Explicit
 
Dim oSpectrum(1)    As cSpectrumColor
 
Private Sub Form_Load()
Dim i           As Long
    Set oSpectrum(0) = New cSpectrumColor
    Set oSpectrum(1) = New cSpectrumColor
 
    For i = VScroll1.LBound To VScroll1.UBound
        VScroll1(i).min = 0
        VScroll1(i).max = 255
    Next
End Sub
 
Private Sub Form_Terminate()
    Set oSpectrum(0) = Nothing
    Set oSpectrum(1) = Nothing
End Sub
 
Private Sub VScroll1_Change(Index As Integer)
    Call VScroll1_Scroll(Index)
End Sub
 
Private Sub VScroll1_Scroll(Index As Integer)
Dim i           As Long
    If (Index > &H2) Then i = 1
    Picture1(i).BackColor = RGB(Int(VScroll1((i * 3)).Value), _
                                Int(VScroll1((i * 3) + 1).Value), _
                                Int(VScroll1((i * 3) + 2).Value))
    oSpectrum(i).color = Picture1(i).BackColor
    Debug.Print oSpectrum(i).spectrumEqualC(oSpectrum(i Xor 1)), i, i Xor 1
End Sub
 
 

 
'
'   /////////////////////////////////////////////////////////////
'   //                                                         //
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandesido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////
 
Option Explicit
 
Private lMem()          As Long
Private lCount          As Long
Private bDuplicate      As Boolean
 
Public Sub clear()
    Erase lMem()
    lCount = 0
End Sub
 
Public Property Get Count() As Long
    Count = lCount
End Property
 
'   //  Retorna la cantidad de elementos restantes.
Public Function Remove(ByVal lIndex As Long) As Long
    Remove = RemoveInArrayLong(lIndex, lMem())
End Function
 
Public Property Get DuplicateElements() As Boolean
    DuplicateElements = bDuplicate
End Property
 
Public Property Let DuplicateElements(ByVal bBool As Boolean)
    bDuplicate = bBool
End Property
 
'   //  Agrega un array a la coleccion y retorna la cantidad de elementos agregados a ella.
Public Function AddArray(ByRef lArray() As Long) As Long
Dim i                   As Long
Dim c                   As Long
    If Not (ItsArrayINI(VarPtrA(lArray))) Then Exit Function
    c = lCount
    For i = LBound(lArray()) To UBound(lArray())
        Me.Add lArray(i)
    Next
    AddArray = (lCount - c) '   //  Cantidad de elementos REALMENTE AGREGADOS: es igual a la direfencia del valor anterior y el actual de lCount.
End Function
 
'   //  Inserta en el Array el elemento Dado de manera Ascendente.
'   //  Agrega lVal en la coleccion de manera ordenada, y retorna el indice de su hubicacion.
'   //  Se retorna el indice de la hubicacion (...cambia este indice si se agrega otro y es menor a este...).
Public Function Add(ByVal lVal As Long) As Long
Dim lRetPos             As Long
    '   //  Buscamos la posicion en donde insertar...
    If ExitsInArray(lVal, lMem(), lRetPos) And Not bDuplicate Then Exit Function
    ReDim Preserve lMem(lCount)
    lCount = (lCount + 1)
    If ((lCount - 1) - lRetPos) Then '   //  Recorremos a la derecha TODOS los elementos.
        CopyMemory VarPtr(lMem(lRetPos + 1)), VarPtr(lMem(lRetPos)), ((lCount - lRetPos) * &H4)
    End If
    lMem(lRetPos) = lVal
    Add = lRetPos
End Function
 
'   //  Obtenemos una copia de la coleccion de elementos.
Public Function GetArray() As Long()
    GetArray = lMem()
End Function
 
Public Function IndexOf(ByVal lVal As Long) As Long
    If Not ExitsInArray(lVal, lMem, IndexOf) Then IndexOf = INVALIDVALUEARRAY
End Function
 
Public Function GetElement(ByVal lIndex As Long) As Long
    If (lIndex < lCount) Then GetElement = lMem(lIndex)
End Function
 
Private Function ExitsInArray(ByRef lVal As Long, ByRef lArray() As Long, ByRef lRetPos As Long) As Boolean
Dim lLIndex                 As Long
Dim lUIndex                 As Long
Dim iSortType               As Long
 
    If Not (ItsArrayINI(VarPtrA(lArray))) Then lRetPos = 0: Exit Function
 
    lLIndex = LBound(lArray())
    lUIndex = UBound(lArray())
 
    If (lArray(lUIndex) < lArray(lLIndex)) Then
        SwapLong lLIndex, lUIndex
        iSortType = 1
    End If
 
    If (lVal < lArray(lLIndex)) Then
        lRetPos = lLIndex
    ElseIf (lVal = lArray(lLIndex)) Then
        lRetPos = lLIndex
        ExitsInArray = True
    Else
        If (lVal > lArray(lUIndex)) Then
            lRetPos = lUIndex
        ElseIf (lVal = lArray(lUIndex)) Then
            lRetPos = lUIndex
            ExitsInArray = True
        Else
            Do Until ExitsInArray
                lRetPos = ((lLIndex + lUIndex) \ 2)
                If ((lRetPos <> lLIndex) And (lRetPos <> lUIndex)) Then
                    If (lArray(lRetPos) < lVal) Then
                        lLIndex = lRetPos
                    ElseIf (lArray(lRetPos) > lVal) Then
                        lUIndex = lRetPos
                    ElseIf (lArray(lRetPos) = lVal) Then
                        ExitsInArray = True
                    End If
                Else
                    Exit Do
                End If
            Loop
        End If
    End If
 
    If Not (ExitsInArray) Then              '   //  Obtenemos la posicion donde deberia estar dicho elemento.
        If (iSortType = 1) Then
            If (lArray(lRetPos) > lVal) Then lRetPos = (lRetPos - 1)
        Else
            If (lArray(lRetPos) < lVal) Then lRetPos = (lRetPos + 1)
        End If
    End If
 
End Function
 
Private Sub Class_Terminate()
    Call Me.clear
End Sub
 
 

 
Option Explicit
 
Public Const INVALIDVALUEARRAY As Long = (-1)
 
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal pDest As Long, ByVal pSrc As Long, ByVal ByteLen As Long)
Public Declare Function VarPtrA Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
 
Public Function ItsArrayINI(ByVal lngPtr As Long, Optional LnBytes As Long = 4) As Boolean
Dim lng_PtrSA                   As Long
    If ((lngPtr <> 0) And (LnBytes > 0)) Then
        Call CopyMemory(ByVal VarPtr(lng_PtrSA), ByVal lngPtr, LnBytes)
        ItsArrayINI = (Not (lng_PtrSA = 0))
    End If
End Function
 
Public Sub SwapLong(ByRef lVal1 As Long, ByRef lval2 As Long)
    lval2 = lval2 Xor lVal1
    lVal1 = lVal1 Xor lval2
    lval2 = lval2 Xor lVal1
End Sub
 
'   //  Return (Cantidad de elementos).
Public Function RemoveInArrayLong(ByVal lIndex As Long, ByRef lArray() As Long) As Long
    If (ItsArrayINI(VarPtrA(lArray)) = True) Then
        RemoveInArrayLong = UBound(lArray)
        If Not ((lIndex < 0) Or (lIndex > RemoveInArrayLong)) Then
            If Not (lIndex = RemoveInArrayLong) Then
                Call CopyMemory(ByVal VarPtr(lArray(lIndex)), ByVal VarPtr(lArray(lIndex + 1)), (RemoveInArrayLong - lIndex) * 4)
            End If
            If ((RemoveInArrayLong - 1) > INVALIDVALUEARRAY) Then
                ReDim Preserve lArray(RemoveInArrayLong - 1)
            Else
                Erase lArray()
            End If
        End If
    End If
End Function