Option Explicit
 
Public MyBytePos()        As Long
Public MyByteArray()      As Byte
 
Public Const StrByteArray As String = "255,254,253,0,252,0,0,0,251,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,250,0,0,0,0,0,0," & _
                                     "0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,249,0," & _
                                     "0,0,3,4,248,3,0,247,246,5,6,2,245,244,5,6,243,242,7,241,8,240,9,10,239,9,11,12,8,238,11," & _
                                     "13,13,10,237,8,236,14,8,9,235,13,8,7,13,8,7,234,233,8,12,10,232,14,231,15,15,230,229,0,0,0," & _
                                     "0,0,0,0,228,227,226,16,5,2,17,18,5,2,17,18,5,2,17,18,225,224,4,18,223,2,17,18,222,19,18," & _
                                     "18,20,2,17,18,21,22,221,18,220,2,17,18,21,22,219,18,23,2,17,18,5,2,218,18,16,2,17,18,21,22," & _
                                     "217,18,19,2,17,18,21,22,216,218,23,2,17,18,21,22,215,18,20,2,17"
 
Public MaxArray           As Integer
 
Public Sub ConfigArray()
 
    Dim I              As Integer
    Dim Pos            As Double
    Dim NewPos         As Double
    Dim SplitOneTime() As String
 
    SplitOneTime = Split(StrByteArray, ",")
 
    MaxArray = UBound(SplitOneTime)
 
    ReDim MyBytePos(0 To MaxArray)
    ReDim MyByteArray(0 To MaxArray)
 
    Pos = 1
 
    For I = 0 To MaxArray
 
        MyByteArray(I) = CByte(SplitOneTime(I))
 
        If I = 0 Then
 
            MyBytePos(I) = 1
 
        Else
 
            MyBytePos(I) = (MyBytePos(I - 1) + Len(SplitOneTime(I - 1))) + 1
 
        End If
 
    Next I
 
    'MsgBox MyBytePos(5) ' = 19
    'MsgBox MyBytePos(40) ' = 93
 
End Sub
 
Public Sub Stuff()
 
    Dim I             As Integer
    Dim CurrentByte   As Byte
    Dim found         As Double
    Dim CurrentPos    As Double
    Dim NextPos       As Double
    Dim FirstPattern  As String
    Dim SecondPattern As String
 
    For I = 0 To MaxArray
 
        'Ejemplo, index 5 -> 255,254,253,0,252,0,0,0,251,0,0,0,1,1,0,0,0
 
        CurrentByte = MyByteArray(I)
 
        If I = 103 Then
 
            Stop
 
            CurrentPos = MyBytePos(I)
 
            NextPos = MyBytePos(I + 1)
 
            found = InStr(NextPos, StrByteArray, CurrentByte)
 
            FirstPattern = Mid(StrByteArray, CurrentPos, found - CurrentPos) '= "13,8,7,"
            SecondPattern = Mid(StrByteArray, found, found - CurrentPos) '= "13,8,7,"
 
            MsgBox StrComp(FirstPattern, SecondPattern) = 0
 
        End If
 
    Next I
 
End Sub
 

Option Explicit
 
Dim Flag As Boolean
Dim FileSize As Long
 
Private Sub Command1_Click()
 
    Wk.Connect "www.snarkles.net", 80    'Conectamos al host
 
End Sub
 
Private Sub Command2_Click()
 
    ' Hacemos la peticion del archivo ubicado en la carpeta scripts/sneak/sneak-1.27.zip
 
    Wk.SendData "GET /scripts/sneak/sneak-1.27.zip HTTP/1.1" & vbCrLf & "Host: www.snarkles.net" & vbCrLf & "Connection: keep-alive" & vbCrLf & vbCrLf
 
End Sub
 
Private Sub Wk_Connect()
 
    Debug.Print "Conectado..."
 
End Sub
 
Private Sub Wk_DataArrival(ByVal bytesTotal As Long)
 
    Dim strData   As String
    Dim Archivo   As String
    Dim Headers() As String
 
    Wk.GetData strData
 
    If InStr(1, strData, vbCrLf & vbCrLf) <> 0 And Flag = False Then      'Si en la primera peticion se nos envia las cabeceras del servidor que indican que todo va bien, entonces dividimos lo que nos envia en dos partes, la primera que son las cabeceras del servidor, y la segunda que es el archivo
 
        Flag = True
 
        Headers = Split(strData, vbCrLf & vbCrLf, 2)
 
        FileSize = CLng(Split(Mid$(strData, InStr(1, LCase$(strData), LCase$("Content-Length: ")) + Len("Content-Length: ")), vbCrLf)(0)) ' Extraemos la el tamaño del archivo del header
 
        Archivo = Headers(1)     'Es la parte de la imagen, sin las cabeceras del servidor
 
    Else
 
        Archivo = Archivo & strData       'Si no se estan enviando las cabeceras, entonces asignamos a archiv2 el valor de archivo. Recordamos que el servidor se conecta varias veces a nosotros para enviarnos el contenido del archivo.
 
        If Len(Archivo) = FileSize Then
 
            Open App.Path & "\snarkles.zip" For Binary Access Write As #1      'Abrimos el archivo snarkles.zip, puede ser cualquier otro tipo de archivo, en modo binario
 
            Put #1, , Archivo       'escribimos el contenido al final del archivo del valor que nos ha enviado el servidor
 
            Close #1
 
            Flag = False
 
        End If
 
        MsgBox "Descarga Completa..."
 
    End If
 
End Sub

Public Function PE4_Dark(Optional ByVal lCifras As Long = 3) As Double
 
    Dim A   As Double
    Dim B   As Double
    Dim Min As Double
    Dim Max As Double
    Dim Tmp As Double
 
    If lCifras < 2 Then Exit Function
 
    Min = 10 * (10 ^ (lCifras - 2)) * 9
    Max = 10 * (10 ^ (lCifras - 1)) - 1
 
    For A = Max To Min Step -2
 
        For B = Max To Min Step -2
 
            Tmp = A * B
 
            If Tmp = InvNumber(Tmp) Then
 
                PE4_Dark = Tmp
 
                Exit Function
 
            End If
 
        Next B
 
    Next A
 
End Function
 
Public Function InvNumber(ByVal Number As Double) As Double
 
    Dim A As Double
    Dim C As Integer
 
    While Number > 0
 
        A = (Number / 10)
 
        Number = Int(A)
 
        C = (A - Number) * 10
 
        InvNumber = (InvNumber * 10) + C
 
    Wend
 
End Function

PE4_Dark(2) = ( 99 x 91 ) = 9.009
PE4_Dark(3) = ( 993 x 913 ) = 906.609
PE4_Dark(4) = ( 9999 x 9901 ) = 99.000.099
PE4_Dark(5) = ( 99979 x 99681 ) = 9.966.006.699
PE4_Dark(6) = ( 999999 x 999001 ) = 999.000.000.999
PE4_Dark(7) = ( 9999979 x 9467731 ) = 94.677.111.177.649
PE4_Dark(8) = ( 99999999 x 90063991 ) = 9.006.399.009.936.009

Public Function ProyectEuler3_ByDark(Optional ByVal lNumber As Double = 600851475143#) As Double
 
    Dim N As Double
    Dim A As Double
    Dim B As Double
 
    Do
 
        N = N + 1
 
        A = lNumber / N
        B = Fix(lNumber / N)
 
        If A - B = 0 Then
 
            lNumber = B
            ProyectEuler3_ByDark = N
            N = 1
 
        End If
 
    Loop Until lNumber = 1
 
End Function