frmencrypt.frm

Good security provider by using biometric feature as key. This is the program of server.

VERSION 5.00
Begin VB.Form frmencrypt 
   Caption         =   "Form1"
   ClientHeight    =   3120
   ClientLeft      =   60
   ClientTop       =   420
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3120
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
End
Attribute VB_Name = "frmencrypt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim lin As String
Dim dsize As Double
Dim i As Integer
Dim pdata(), pout, filepout, Fsave As String
Dim adata(100000) As Integer
Dim out(100000), q As Double
Dim linefeed, rlinefeed As String
Dim tryI, tryJ, jval As Long
Dim i1, a1 As Long
Dim GetRndA, GetRndB, indexA, indexB, RndValA, RndValB, primeA, primeB, opA, opB As Long
Dim chkA, chkB, tstA, tstB As Boolean
Dim cont As Boolean
Dim PRIME1, PRIME2, PROD, PHIE, PUBLICKEY, SECRETKEY, POS As Long
Dim CIPHER As String
Dim y, X, n As Long
Dim store(9999), mtp, temp, flmt, disp(15), t, rvf(15), res, pcnt, suma(15) As Long
Dim pow(15), ch(14), a, c, il, cnt, j, jp, kt, lt, L, j1, ic, jc As Long
Dim op, t2 As String
Dim gt(15), rv(15), lent, chlen, dval As Integer
Dim gate, fin As Boolean
Dim Fname As Variant

Private Sub Form_Load()
Dim FileName11 As String
Dim FName_Only As String
Dim delay As Long
         If cont = False Then
             While (chkA = False)
                 tstA = False
                 Randomize
                 GetRndA = Rnd() * 100
                 RndValA = Round(GetRndA, 1)
                 For indexA = 2 To RndValA - 1
                     primeA = RndValA Mod indexA
                     If (primeA = 0) Then
                         tstA = True
                     End If
                 Next indexA
                 If (tstA = False) Then
                     If RndValA <= 2 Then
                     Else
                         PRIME1 = Round(RndValA, 0)
                         chkA = True
                     End If
                 End If
             Wend
             While (chkB = False)
                 tstB = False
                 Randomize
                 GetRndB = Rnd() * 100
                 RndValB = Round(GetRndB, 1)
                 For indexB = 2 To RndValB - 1
                     primeB = RndValB Mod indexB
                     If (primeB = 0) Then
                         tstB = True
                     End If
                 Next indexB
                 If (tstB = False) Then
                     If RndValB <= 2 Then
                     Else
                         PRIME2 = Round(RndValB, 0)
                         chkB = True
                     End If
                 End If
             Wend
             If (PRIME1 = PRIME2) Then
             ElseIf (PRIME1 <= 2) Then
             ElseIf (PRIME2 <= 2) Then
             Else
                 cont = True
             End If
         End If
         PROD = PRIME1 * PRIME2
         PHIE = (PRIME1 - 1) * (PRIME2 - 1)
         cont = False
         For i1 = 2 To (PHIE - 1)
            If cont = False Then
                a1 = PHIE Mod i1
                If a1 = 0 Then
                Else
                    PUBLICKEY = i1
                    cont = True
                End If
            End If
         Next i1
         cont = False
         For q = 1 To 100000
             If cont = False Then
                 If ((PUBLICKEY * q) Mod PHIE) = 1 Then
                     SECRETKEY = q
                     cont = True
                 End If
             End If
         Next q
            lin = frmServer.txtPassword.Text
            dsize = Len(lin)
            If dsize > 0 Then
                ReDim pdata(1 To dsize)
            Else
                ReDim pdata(i)
            End If
            linefeed = ""
            i = 1
            Do Until i = dsize + 1
                 pdata(i) = Mid(lin, i, 1)
                i = i + 1
            Loop
        For i = 1 To dsize
           adata(i) = Asc(pdata(i))
        Next i
        Open App.Path & "\" & "4_encryptedpassword.txt" For Output As #1
            For jval = 1 To dsize
                X = adata(jval)
                y = PUBLICKEY
                n = PROD
                Powers
                CIPHER = res
        Print #1, CIPHER
            Next jval
        Close #1
    Open App.Path & "\" & "4_encryptedpassword.txt" For Append As #2
       Print #2, "," + CStr(SECRETKEY) + "," + CStr(PROD) + "end"
    Close #2
    frmServer.txtFileName = App.Path & "\" & "4_encryptedpassword.txt"
    If frmServer.txtFileName = "" Then
       MsgBox "No file selected to send...", vbCritical
    Else
       If frmWSK.tcpServer.State <> sckClosed Then
          FName_Only$ = GetFileName(frmServer.txtFileName)
          SendFile FName_Only$
       End If
    End If
End Sub

Private Sub Powers()
    t2 = ""
    a = y
    Do While a >= 2
        c = a Mod 2
        a = Fix(a / 2)
        t2 = t2 & c
    Loop
    t2 = t2 & a
    op = StrReverse(t2)
     a = 1
    Do While (gate = False)
        c = Mid$(op, a, 1)
        gt(a) = c
        If (c <> 1 And c <> 0) Then
            gate = True
        End If
        cnt = a
        a = a + 1
    Loop
    lent = cnt - 1
    a = 1
    For c = lent To 1 Step -1
       rv(a) = gt(c)
       a = a + 1
    Next c
   L = 2
   j = 1
   kt = 2
   pow(1) = rv(1)
   ch(1) = pow(1)
   lt = 2
   chlen = 1
    Do While (lt <= lent)
        pow(j + 1) = rv(kt) * 2 ^ j
        ch(L) = pow(j + 1)
        chlen = chlen + 1
        j = j + 1
        kt = kt + 1
        L = L + 1
        lt = lt + 1
    Loop
    store(1) = X Mod n
    temp = store(1)
    disp(1) = temp
    mtp = 2
    flmt = 1
    t = 2
    Do While ((flmt / 2) <= Val(y))
        store(mtp) = (temp ^ 2) Mod n
        temp = store(mtp)
        disp(t) = (store(mtp))
        mtp = mtp * 2
        flmt = mtp * 2
        t = t + 1
    Loop
     i1 = 1
    j1 = 2
    rvf(1) = pow(1)
    Do While (i1 < 15)
        If ch(i1) <> 0 Then
            rvf(j1) = ch(i1)
            j1 = j1 + 1
        End If
        i1 = i1 + 1
    Loop
    pcnt = 1
    jc = 1
    For ic = 1 To chlen
        If ch(ic) <> 0 Then
            suma(jc) = (disp(ic))
            pcnt = pcnt + 1
            jc = jc + 1
        End If
    Next ic
    res = 1
    Dim q1 As Integer
    res = (suma(1) * suma(2)) Mod n
    For q1 = 2 To (pcnt - 2)
        res = (res * suma(q1 + 1)) Mod n
    Next q1
End Sub