keysform.frm

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

VERSION 5.00
Begin VB.Form KeysForm 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Key Chest Contact List"
   ClientHeight    =   2460
   ClientLeft      =   2544
   ClientTop       =   2172
   ClientWidth     =   4824
   LinkTopic       =   "Form6"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2460
   ScaleWidth      =   4824
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton SelectButton 
      Caption         =   "Use Selected"
      Height          =   492
      Left            =   2760
      TabIndex        =   6
      Top             =   1680
      Width           =   1452
   End
   Begin VB.TextBox GetUserPwd 
      Height          =   372
      Left            =   2350
      TabIndex        =   5
      Top             =   1200
      Visible         =   0   'False
      Width           =   2250
   End
   Begin VB.TextBox GetUserName 
      Height          =   372
      Left            =   2350
      TabIndex        =   4
      Top             =   480
      Visible         =   0   'False
      Width           =   2250
   End
   Begin VB.CommandButton SaveAdd 
      Caption         =   "Save Name"
      Height          =   492
      Left            =   2760
      TabIndex        =   3
      Top             =   1800
      Visible         =   0   'False
      Width           =   1452
   End
   Begin VB.CommandButton DeleteButton 
      Caption         =   "Delete Selected"
      Height          =   492
      Left            =   2760
      TabIndex        =   2
      Top             =   720
      Width           =   1452
   End
   Begin VB.CommandButton AddButton 
      Caption         =   "Add Contact"
      Height          =   492
      Left            =   2760
      TabIndex        =   1
      Top             =   240
      Width           =   1452
   End
   Begin VB.ListBox UserList 
      Height          =   2352
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   2172
   End
   Begin VB.Label Label2 
      Caption         =   "Shared Key"
      Height          =   252
      Left            =   2440
      TabIndex        =   8
      Top             =   936
      Visible         =   0   'False
      Width           =   1452
   End
   Begin VB.Label Label1 
      Caption         =   "Contact Name"
      Height          =   252
      Left            =   2440
      TabIndex        =   7
      Top             =   204
      Visible         =   0   'False
      Width           =   1452
   End
End
Attribute VB_Name = "KeysForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' StealthMail - KeysForm.FRM
' Copyright Patterson Programming, 1996-1999

Dim UserName As String * 40, NameCode As Byte
Dim PadLength As Byte
Dim Pwd(31) As Byte
Dim Keychar As Integer
Dim KeyFile%

Private Sub Form_Load()
    KeysForm.Left = (Screen.Width - KeysForm.Width) / 2
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    KeysForm.GetUserPwd.Text = Space$(Ppos%)
    KeysForm.GetUserPwd.Text = ""
    For i% = 0 To 31: Pwd(i%) = 0: Next
End Sub

Private Sub SelectButton_Click()

    LockPwd
    If UserList.ListIndex = -1 Then
        MsgBox1 "No Contact is selected", 0, "Abort"
        Exit Sub
    Else
        SelectKey = UserList.ListIndex
        For i% = 0 To 31
            password(i%) = KeyArray(i%, SelectKey)
            If password(i%) = 0 Then password(i%) = 32
        Next
        UnlockPwd
        Unload KeysForm
    End If

End Sub

Private Sub AddButton_Click()

    '* init the password buffer
    For i% = 0 To 31: Pwd(i%) = 32: Next
    Ppos% = 0

    '* show add screen
    KeysForm.AddButton.Visible = 0
    KeysForm.DeleteButton.Visible = 0
    KeysForm.SelectButton.Visible = 0
    KeysForm.UserList.Enabled = 0

    KeysForm.GetUserName.Visible = -1
    KeysForm.GetUserPwd.Visible = -1
    KeysForm.Label1.Visible = -1
    KeysForm.Label2.Visible = -1
    SaveAdd.Visible = -1
    SelectKey = -1

End Sub

Private Sub SaveAdd_click()

    LockPwd
    KeyFile% = FreeFile
    BlockLen% = LeapFrogBlockLen

    UserName = Left$(KeysForm.GetUserName.Text, 40)
    If Len(RTrim$(LTrim$(UserName))) = 0 Then
        MsgBox1 "Invalid Contact Name, aborting", 0, ""
        Exit Sub
    End If
    Ppos% = Len(GetUserPwd.Text)
    If Ppos% < 20 Then
        MsgBox1 "Key Too Short for Security, aborting", 0, ""
        Exit Sub
    Else
        If Ppos% > 32 Then Ppos% = 32
        For i% = 1 To Ppos%
            Keychar = Asc(UCase$(Mid$(GetUserPwd.Text, i%, 1)))
            If Keychar <= 31 Or Keychar >= 96 Then
                MsgBox1 "Illegal characters for key", 0, ""
                Exit Sub
            Else
                Pwd(i% - 1) = Keychar
            End If
        Next
        KeysForm.UserList.AddItem UserName
        KeysForm.GetUserPwd.Text = Space$(Ppos%)
        KeysForm.GetUserPwd.Text = ""

        '* add to key table
        KeyCount = KeysForm.UserList.ListCount
        ReDim Preserve KeyArray(71, KeyCount - 1)
        For i% = 0 To 31
            KeyArray(i%, KeyCount - 1) = Pwd(i%)
        Next
        For i% = 0 To 39
            KeyArray(i% + 32, KeyCount - 1) = _
                               Asc(Mid$(UserName, i% + 1, 1))
        Next
        For i% = 0 To 31: Pwd(i%) = 0: Next

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

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

        '* clear the feedback register
        For i% = 1 To BlockLen%: FBR(i%) = 0: Next
        '* encrypt it with master password
        process% = 1
        For i% = 0 To 31: password(i%) = MasterPwd(i%): Next
        CryptInit
        BufferPointer& = 0
        SelectCipher (Blocks%)

        '* overwrite keyfile
        If Dir$(App.Path & "\KeyFile.DAT") <> "" Then
            Kill (App.Path & "\KeyFile.DAT")
        End If
        Open App.Path & "\KeyFile.DAT" For Binary Access _
                                              Write As KeyFile%
        Put KeyFile%, , KeyCount
        Put KeyFile%, , PadLength
        For i% = 0 To ((DataLen& + PadLength) - 1)
            Put KeyFile%, , CryptBuffer(i%)
        Next
        Close KeyFile%
        KeysForm.GetUserName.Text = ""

        '* say OK
        Backup% = -1
        MsgBox1 "Key Added to KeyFile", 0, ""
    End If

    KeysForm.AddButton.Visible = -1
    KeysForm.DeleteButton.Visible = -1
    KeysForm.SelectButton.Visible = -1
    KeysForm.UserList.Enabled = -1

    KeysForm.GetUserName.Visible = 0
    KeysForm.GetUserPwd.Visible = 0
    KeysForm.Label1.Visible = 0
    KeysForm.Label2.Visible = 0
    SaveAdd.Visible = 0
    UnlockPwd
    KeysForm.AddButton.SetFocus

End Sub

Private Sub DeleteButton_Click()

    LockPwd
    KeyFile% = FreeFile
    BlockLen% = LeapFrogBlockLen

    If UserList.ListIndex = -1 Then
        MsgBox1 "No Contact Name is Selected", 0, ""
        Exit Sub
    End If

    '* delete key from table
    DelIndex% = UserList.ListIndex
    KeyCount = KeysForm.UserList.ListCount
    For i% = (DelIndex% + 1) To (KeyCount - 1)
        For j% = 0 To 71
            KeyArray(j%, i% - 1) = KeyArray(j%, i%)
        Next
    Next

    KeysForm.UserList.RemoveItem DelIndex%
    KeyCount = KeyCount - 1

    If KeyCount = 0 Then
        Kill (App.Path & "\KeyFile.DAT")
        MsgBox1 "KeyFile is Now Empty", 0, ""
        Exit Sub
    End If

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

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

    '* clear the feedback register
    For i% = 1 To BlockLen%: FBR(i%) = 0: Next
    '* encrypt it with master password
    process% = 1
    For i% = 0 To 31: password(i%) = MasterPwd(i%): Next
    CryptInit
    BufferPointer& = 0
    SelectCipher (Blocks%)

    '* overwrite keyfile
    Kill (App.Path & "\KeyFile.DAT")
    Open App.Path & "\KeyFile.DAT" For Binary Access _
                                          Write As KeyFile%
    Put KeyFile%, , KeyCount
    Put KeyFile%, , PadLength
    For i% = 0 To ((DataLen& + PadLength) - 1)
        Put KeyFile%, , CryptBuffer(i%)
    Next
    Close KeyFile%
    SelectKey = -1: Backup% = -1

    '* say OK
    MsgBox1 "Key Deleted from KeyFile", 0, ""
    UnlockPwd

End Sub

Private Sub GetUserPwd_keypress(Keyascii As Integer)

    If Keyascii = 13 Then
        Keyascii = 0
        Exit Sub
    Else
        If Keyascii = 8 Then Exit Sub
        Keychar = Asc(UCase$(Chr$(Keyascii)))

        '* allow letters, numerals, and punctuation
        If Keychar > 31 And Keychar < 96 Then

            '* accept 32 characters
            Ppos% = Len(KeysForm.GetUserPwd.Text)
            If Ppos% >= 32 Then
                Keyascii = 0
                Beep
            End If
        Else
            Keyascii = 0
            Beep
        End If
    End If

End Sub