Option Explicit
Option Base 0
 
Dim ManagerPrime    As clsPrime
 
Private Sub Form_Load()
    Set ManagerPrime = New clsPrime
 
    Call ManagerPrime.Clear
    MsgBox ManagerPrime.ItsPrime(6857)
    MsgBox "Para calcular si fue primo se calcularon " & ManagerPrime.CountPrime() & " numeros primos."
    Call ManagerPrime.Clear
 
    ManagerPrime.BufferLimitIndex(7000) = &H7FFFFFFF
    MsgBox ProyectEuler3_ByBlack
 
    Set ManagerPrime = Nothing
End Sub
 
Public Function ProyectEuler3_ByBlack(Optional ByVal lNumber As Double = 600851475143#) As Double
'Dim ManagerPrime    As clsPrime
Dim auxn            As Double
Dim auxd            As Double
Dim i               As Long
    'Set ManagerPrime = New clsPrime
    While lNumber > 1
        DoEvents
        auxd = lNumber / ManagerPrime.Prime(i)
        auxn = Fix(auxd)
        If (auxd = auxn) Then
            lNumber = auxn
        Else
            i = (i + 1)
        End If
    Wend
    ProyectEuler3_ByBlack = ManagerPrime.Prime(i)
    'Set ManagerPrime = Nothing
End Function
 

Option Explicit
Option Base 0
 
Private m_N             As Long
Private m_Now           As Long
Private m_Arr()         As Long
Const MAX_LIMIT_VALUE   As Long = &H7FFFFFFF
 
Private Sub Class_Initialize()
    Clear
End Sub
 
Private Function Calculate(ByVal Start As Long, Optional ByVal MaxLimitValue As Long = MAX_LIMIT_VALUE) As Long
Dim j As Long
 
    For m_Now = Start To MaxLimitValue
 
        j = (m_Now - 1)
 
        Do While (m_Now Mod j <> 0)
            j = (j - 1)
        Loop
 
        If (j < 2) Then
            Calculate = m_Now
            Exit Function
        End If
    Next
 
    Calculate = &H80000000
 
End Function
 
Public Sub Clear()
    m_N = 0
    m_Now = 2
    ReDim m_Arr(m_N)
    m_Arr(m_N) = 2
End Sub
 
Public Property Let BufferLimitIndex(Optional ByVal MaxLimitValue As Long = MAX_LIMIT_VALUE, ByVal n As Long)
Dim lRes        As Long
Dim lNow        As Long
 
    Do While (m_N < n)
        lRes = Calculate(m_Now + 1, MaxLimitValue)
        If (lRes And &H80000000) Then
            Exit Do
        Else
            m_N = (m_N + 1)
            ReDim Preserve m_Arr(m_N)
            m_Arr(m_N) = lRes
        End If
    Loop
End Property
 
Public Property Get CountPrime() As Long
    CountPrime = (m_N + 1)
End Property
 
Public Property Get BufferLimitIndex(Optional ByVal MaxLimitValue As Long = MAX_LIMIT_VALUE) As Long
    BufferLimitIndex = m_N
End Property
 
Public Function Prime(ByVal Index As Long, Optional ByVal MaxLimitValue As Long = MAX_LIMIT_VALUE) As Long
Dim lRes        As Long
    Prime = &H80000000
    If Index > m_N Then
        BufferLimitIndex(MaxLimitValue) = Index
        If Not (Index = m_N) Then Exit Function
    End If
    Prime = m_Arr(Index)
End Function
 
Public Function ItsPrime(ByVal Value As Long) As Boolean
Dim i       As Long
Dim lRes    As Long
 
    ItsPrime = True
 
    If (m_Now < Value) Then
 
        Do
            lRes = Prime(m_N + 1, Value)
            If (lRes And &H80000000) Then Exit Do
        Loop While (m_Arr(m_N) < Value)
 
        If Not (m_Arr(m_N) = Value) Then ItsPrime = False
 
    Else
        For i = 0 To m_N
            If (m_Arr(i) = Value) Then Exit For
        Next
 
        ItsPrime = False
 
    End If
 
End Function
 
Private Sub Class_Terminate()
    Call Clear
End Sub