'Vampire numbers.
'FreeBASIC version 24. Windows
'Vampire.bas
Function WithinString(n As Ulongint,f As Ulongint) As Integer
    var m=Str(n),p=Str(f)
    For z As Integer=0 To Len(p)-1
        var i=Instr(m,Chr(p[z]))
        If i Then
            m=Mid(m,1,i-1)+Mid(m,i+1)
        Else
            Return 0
        End If
    Next z
    Return -1
End Function

Sub AllFactors(N As Ulongint,factors() As Ulongint)
    Dim As String Sn=Str(n)
    Dim As Integer half=Len(sn)\2
    Redim factors(1 To 1)
    #macro bsort(array)
    For p1 As Integer  = 1 To Ubound(array) - 1
        For p2 As Integer  = p1 + 1 To Ubound(array)
            If array(p1)>array(p2) Then Swap array(p1),array(p2)
        Next p2
    Next p1
    #endmacro

    Dim As Ulongint c
    For i As Ulongint = 1 To Sqr(N)
        If N Mod i=0 Then
            If Len(Str(i))=half Then
                If WithinString(N,i) Then
                    c=c+1
                    Redim Preserve factors(1 To c)
                    factors(c)=i
                End If
            End If
            If N <> i*i Then
                If Len(Str(n\i))=half Then
                    If WithinString(N,n\i) Then
                        c=c+1
                        Redim Preserve factors(1 To c)
                        factors(c)=n\i
                    End If
                End If
            End If
        End If
    Next i
    bsort(factors)
End Sub

Function VampireNumbers(N As Ulongint) As Integer
    Dim As Integer flag
    Dim As Ulongint LastFactor
    Redim As Ulongint Factor()
    AllFactors(N,Factor())
    For p1 As Integer = 1 To Ubound(Factor)
        For p2 As Integer=1 To Ubound(Factor)
            If Factor(p1)*Factor(p2)=n Then
                If Factor(p1) Mod 10<>0 Or Factor(p2) Mod 10 <>0 Then
                    If WithinString(n,valulng(Str(Factor(p1))+Str(Factor(p2)))) Then
                        If LastFactor=Factor(p2) Then Exit For,For
                        flag=1
                        Print n;": [";Factor(p1);",";Factor(p2);"]"
                        LastFactor=Factor(p1)
                    End If
                End If
            End If
        Next p2
    Next p1
    If flag Then Return -1
End Function

'============== IMPLEMENT ==============================
print "First 28 Vampire numbers"
print
Print "Number: [fangs]"
Print
Dim As Ulongint n=1000
Dim As Integer count
Dim As Double t1,t2
t1=Timer
Do
    n=n+1
    Var s=Str(n)
    If Len(s) Mod 2<>0 Then n=n*10
    If vampireNumbers(n) Then count=count+1
Loop Until count=27
Print
print "Individual tests:"
print
'individual tests
n=16758243290880ull
If Not vampirenumbers(n) Then Print n;": [returns no fangs]"
Print
n=24959017348650ull
If Not vampirenumbers(n) Then Print n;": [returns no fangs]"
print
n=14593825548650ull
If Not vampirenumbers(n) then print n;": [returns no fangs]"
t2=Timer
print
Print "Completed in ";
Print t2-t1;" Seconds"
Sleep