chgpwd.bas

e-maill文件加密程序完整的源代码

Attribute VB_Name = "ChgPwd"
' StealthMail - ChgPwd.BAS
' Copyright Patterson Programming, 1996-1999

Sub ChgMPwd()

    '* needs access to the main cryptographic module
    '* and the password input routine
    Dim NameCode As Byte
    Dim KeyCount As Byte, PadLength As Byte

    '* ask for original password
    verify% = 0: Ppos% = 0
    PwdForm.Caption = "Enter Current Master Password"
    PwdForm.GetPwd.Text = ""
    PwdForm.Show 1

    MasterPwdFlag = 0
    If ScanPwd%() = 0 Then
        Ppos% = 0: Exit Sub
    End If

    BlockLen% = LeapFrogBlockLen
    KeyFile% = FreeFile

    Open App.Path & "\KeyFile.DAT" For Binary Access _
                                     Read Write As KeyFile%
    If LOF(KeyFile%) < 72 Then
        Close KeyFile%
        MsgBox1 "Your KeyChest is Empty", 0, "Abort"
        Exit Sub
    End If

    '* get KeyFile stats
    Get KeyFile%, , KeyCount
    Get KeyFile%, , PadLength
    If KeyCount = 0 Then
        Close KeyFile%
        Exit Sub
    End If

    DataLen& = (KeyCount) * 72
    Blocks% = (DataLen& + PadLength) \ BlockLen%
    ReDim CryptBuffer((DataLen& + PadLength) - 1)

    '* clear the feedback register
    For i% = 1 To BlockLen%: Pre_FBR(i%) = 0: Next

    '* read in table
    For i% = 0 To ((LOF(KeyFile%) - 2) - 1)
        Get KeyFile%, , CryptBuffer(i%)
    Next

    '* Decrypt it with current master password
    process% = 2
    For i% = 0 To 31: password(i%) = MasterPwd(i%): Next
    CryptInit
    BufferPointer& = 0
    SelectCipher (Blocks%)

    '* get table from cryptbuffer
    ReDim KeyArray(71, KeyCount - 1)
    For i% = 0 To KeyCount - 1
        For j% = 0 To 71
           KeyArray(j%, i%) = CryptBuffer((i% * 72) + j%)
        Next
    Next

    For i% = 0 To KeyCount - 1
        '* no keyhash, just scan for non-characters
        For j% = 0 To 71
            ScanCode = (KeyArray(j%, i%))
            If (ScanCode < 32) Or (ScanCode > 127) Then
                MsgBox1 "Incorrect Master Password - " & _
                        "Can't Change Password", 0, "Abort"
                Ppos% = 0
                Exit Sub
            End If
        Next
    Next

    '* ask for desired password here
    verify% = 0: Ppos% = 0
    PwdForm.Caption = "Enter Desired Master Password"
    PwdForm.GetPwd.Text = ""
    PwdForm.Show 1
    If ScanPwd%() = 0 Then
        MasterPwdFlag = 0
        Close KeyFile%
        Exit Sub
    End If

    '* clear the feedback register
    For i% = 1 To BlockLen%: FBR(i%) = 0: Next

    '* encrypt KeyFile with Desired master password
    process% = 1
    For i% = 0 To 31: password(i%) = MasterPwd(i%): Next
    CryptInit
    BufferPointer& = 0
    SelectCipher (Blocks%)

    '* overwrite keyfile
    Seek KeyFile%, 1

    Put KeyFile%, , KeyCount
    Put KeyFile%, , PadLength
    For i% = 0 To ((DataLen& + PadLength) - 1)
         Put KeyFile%, , CryptBuffer(i%)
    Next
    Close KeyFile%
    Backup% = -1
    '* say OK
    MsgBox1 "Master Password Changed OK", 0, ""

End Sub