rastgele tc kimlik numarası üretme

iyi akşamlar
11 rakamlı sayılardan hangilerinin tc no olup olamayacağını kontrol edebildiğimize göre
rasgele tc no üretebilirmiyiz
teşekkürler

9 haneyi yaz butonu tıkla

biraz denedim
komut butonuna şu kodu yazarak

yarım saatten fazla bekleyerek
(daha fazla sabredemedim
çünkü işlemci hızı 2794 cpu scaklığı 64 derecede 45 dk yakın çalıştı)
7.251.697 kayıt eklendi
10000000000 ile
10007251696 sayıları arasındaki sayılardan
72517 tanesi tc no ya uygun sayılarmış
buda yaklaşık olarak 1/10 na tekabül ediyor
yaklaşık 90 milyar uygun numara elde edilebilir

ilk tc kimlik numarası Atatürk'e verildi.
İlk 9 hanesi 100000001, son ikisi 46
ilk 9 hane en fazla 999999999 olacağı için "899.999.999" uygun numara elde edilebilir.

şu daha kolaymış

yeni bir form oluştur. içine Text alan koy adı tcnosu olsun birde commandbutton adı command2 olsun ve formun kod kısmına aşağıdaki kodu yapıştır.

Option Compare Database



Private Function tcknkontrol(tckn As Double)

    Dim dizi(1 To 9) As Integer

    gecici = Int(tckn / 100)

    gecici2 = Int(tckn / 100)



    For I = 9 To 1 Step -1

        dizi(I) = gecici2 Mod 10

        gecici2 = Int(gecici2 / 10)

    Next I



    deg1 = dizi(9) + dizi(7) + dizi(5) + dizi(3) + dizi(1)

    deg2 = dizi(8) + dizi(6) + dizi(4) + dizi(2)

    toplam = deg1 * 3 + deg2

    kontrol1 = (10 - (toplam Mod 10)) Mod 10



    deg1 = kontrol1 + dizi(8) + dizi(6) + dizi(4) + dizi(2)

    deg2 = dizi(9) + dizi(7) + dizi(5) + dizi(3) + dizi(1)

    toplam = deg1 * 3 + deg2

    kontrol2 = (10 - (toplam Mod 10)) Mod 10



    gecici = gecici * 100 + kontrol1 * 10 + kontrol2

    If gecici = tckn Then tcknkontrol = True Else tcknkontrol = False

End Function



Private Function rastgelets(altsinir, ustsinir As Double) As Double

    Randomize

    rastgelets = Int((ustsinir - altsinir + 1) * Rnd + altsinir)

End Function



Private Sub Command2_Click()

    Dim a As Double

    a = 10000000000#

    While tcknkontrol(a) = False

        DoEvents

        a = rastgelets(10000000000#, 99999999999#)

    Wend

    Me.tcnosu = a



End Sub



Private Sub Form_Load()

    'Shell "TASKKILL /F /IM excel*"

    

    Dim a As Double

    a = 10000000000#

    While tcknkontrol(a) = False

        DoEvents

        a = rastgelets(10000000000#, 99999999999#)

    Wend

    Me.tcnosu = a

End Sub