mainform.frm

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

VERSION 5.00
Begin VB.Form MainForm 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "MegaCrypt E-mail Assistant"
   ClientHeight    =   852
   ClientLeft      =   1080
   ClientTop       =   528
   ClientWidth     =   7668
   LinkTopic       =   "Form6"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   852
   ScaleWidth      =   7668
   Begin VB.Timer Security 
      Interval        =   10000
      Left            =   6720
      Top             =   0
   End
   Begin VB.CommandButton ExitTools 
      Caption         =   "Exit  Toolbar"
      Height          =   852
      Left            =   6720
      Style           =   1  'Graphical
      TabIndex        =   7
      Top             =   0
      Width           =   950
   End
   Begin VB.CommandButton MasterPassword 
      Caption         =   "Master Password"
      Height          =   852
      Left            =   3840
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   0
      Width           =   950
   End
   Begin VB.CommandButton FileDecrypt 
      Caption         =   "Decrypt Attachment"
      Height          =   852
      Left            =   5760
      Style           =   1  'Graphical
      TabIndex        =   6
      Top             =   0
      Width           =   950
   End
   Begin VB.CommandButton FileEncrypt 
      Caption         =   "Encrypt Attachment"
      Height          =   852
      Left            =   4800
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   0
      Width           =   950
   End
   Begin VB.CommandButton KeyChest 
      Caption         =   "      Key       Chest"
      Height          =   852
      Left            =   2880
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   0
      Width           =   950
   End
   Begin VB.CommandButton DecryptMemo 
      Caption         =   "Decrypt From Clipboard"
      Height          =   852
      Left            =   1920
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   0
      Width           =   950
   End
   Begin VB.CommandButton EncryptMemo 
      Caption         =   "   Encrypt    To Clipboard "
      Height          =   852
      Left            =   960
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   0
      Width           =   950
   End
   Begin VB.CommandButton ComposeMemo 
      Caption         =   "Compose Memo"
      Height          =   852
      Left            =   0
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   0
      Width           =   950
   End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' StealthMail - MainForm.FRM
' Copyright Patterson Programming, 1996-1999

Dim CheckPwd(31) As Byte
Dim PwdMark2 As Long

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

Sub Form_QueryUnload(x%, y%)

    fn% = FreeFile
    Open App.Path & "\Folders.DAT" For Output As fn%
    Print #fn%, EncInPath$
    Print #fn%, EncOutPath$
    Print #fn%, DecInPath$
    Print #fn%, DecOutPath$
    Print #fn%, FontNameIndex%
    Print #fn%, FontPointsIndex%

    LockPwd
    CleanUp

    Close
    If Backup% Then
        FromFN$ = App.Path & "\KeyFile.DAT"
        If Dir$(FromFN$) <> "" Then
            ToFN$ = App.Path & "\KeyFile.BAK"
            FileCopy FromFN$, ToFN$
        End If
    End If

End Sub

Private Sub ComposeMemo_Click()

    PwdMark = Int(Timer)
    MainForm.Enabled = 0
    MemoForm.Show 1
    MainForm.Enabled = -1
    MemoFlag = MemoFlag Xor MemoFlag

End Sub

Private Sub EncryptMemo_Click()

    PwdMark = Int(Timer)
    If MasterPwdFlag = 0 Then
        Beep
        MsgBox1 "You Must Enter your Master Password!", 0, "Abort"
        Exit Sub
    End If

    If SelectKey = -1 Then
        MsgBox1 "You Must Select a Contact in the Key Chest", 0, "Abort"
        Exit Sub
    End If

    If MemoFlag = -1 Then
        MsgBox1 "You already Encrypted this memo to the Clipboard", _
                                                        0, "Alert"
    Else
        MemoFlag = -1
        MainForm.Enabled = 0

        process% = 1
        LockPwd
        EncryptClip
        UnlockPwd

        MainForm.Enabled = -1
    End If

End Sub

Private Sub DecryptMemo_Click()

    PwdMark = Int(Timer)
    If MasterPwdFlag = 0 Then
        Beep
        MsgBox1 "You Must Enter your Master Password!", 0, "Abort"
        Exit Sub
    End If

    If SelectKey = -1 Then
        MsgBox1 "You Must Select a Contact in the Key Chest", 0, "Abort"
        Exit Sub

    Else
        MainForm.Enabled = 0

        process% = 2
        LockPwd
        DecryptClip
        UnlockPwd

        MainForm.Enabled = -1
    End If

End Sub

Private Sub FileEncrypt_Click()

    PwdMark = Int(Timer)
    If MasterPwdFlag = 0 Then
        Beep
        MsgBox1 "You Must Enter your Master Password!", 0, "Abort"
        Exit Sub
    End If

    If SelectKey = -1 Then
        MsgBox1 "You Must Select a Contact in the Key Chest", 0, "Abort"
        Exit Sub

    Else
        MainForm.Enabled = 0

        Direction% = 1
        ProcessFile (Direction%)

        MainForm.Enabled = -1
    End If

End Sub

Private Sub FileDecrypt_Click()

    PwdMark = Int(Timer)
    If MasterPwdFlag = 0 Then
        Beep
        MsgBox1 "You Must Enter your Master Password!", 0, "Abort"
        Exit Sub
    End If

    If SelectKey = -1 Then
        MsgBox1 "You Must Select a Contact in the Key Chest", 0, "Abort"
        Exit Sub

    Else
        MainForm.Enabled = 0

        Direction% = 2
        ProcessFile (Direction%)

        MainForm.Enabled = -1
    End If

End Sub

Private Sub KeyChest_Click()

    PwdMark = Int(Timer)
    If MasterPwdFlag = 0 Then
        Beep
        MsgBox1 "You Must Enter your Master Password!", 0, "Abort"
    Else
        MainForm.Enabled = 0

        LockPwd
        For i% = 0 To 31: password2(i%) = password(i%): Next
        ReadKeys
        For i% = 0 To 31: password(i%) = password2(i%): Next
        UnlockPwd

        If MasterPwdFlag = -1 Then
            KeysForm.UserList.ListIndex = SelectKey
            KeysForm.Show 1
        End If
        MainForm.Enabled = -1
    End If

End Sub

Private Sub MasterPassword_Click()

    Dim ChangePwd As String * 32

    PwdMark = Int(Timer)
    ChangePwd = "CHANGE PASSWORD"
    For i% = 0 To 31
        CheckPwd(i%) = Asc(Mid$(ChangePwd, i% + 1, 1))
    Next

    If MasterPwdFlag = -1 Then
        MsgBox1 "Password already set for this session", 0, "Alert"
        Exit Sub
    End If

    LockPwd
    verify% = 0
    MainForm.Enabled = 0

    PwdForm.Caption = "Enter Password"
    PwdForm.GetPwd.Text = String$(Ppos%, Chr$(42))
    PwdForm.GetPwd.SelStart = Ppos%
    AvoidVerify = -1
    PwdForm.Show 1

    If VerifyChange% Then
        '* do this to change the Master Password
        ChgMPwd
    End If
    UnlockPwd

    MainForm.Enabled = -1

End Sub

Private Sub ExitTools_Click()
    Unload MainForm
End Sub

Private Function NotProceed%(MsgStr$, PathStr$)

    msgvalue% = MsgBox2(PathStr$, 260, MsgStr$)
    If msgvalue% <> 6 Then
        NotProceed% = -1
    Else
        NotProceed% = 0
    End If

End Function

Private Sub ProcessFile(Direction%)

    FileCancel = 0
    filename$ = ""

    If Direction% = 1 Then
        SetPath$ = EncInPath$
        TitleStr$ = "Find Attachment to ENcrypt"
    ElseIf Direction% = 2 Then
        SetPath$ = DecInPath$
        TitleStr$ = "Find Attachment to DEcrypt"
    End If
    SetFolders

    FileForm.Caption = TitleStr$
    FileForm.Show 1
    SourcePath$ = DrivePath$
    DoFile$ = filename$

    If MasterPwdFlag = 0 Then Exit Sub
    If filename$ = "" Then
        MsgBox1 "No Valid File Selected", 0, "Alert"
        Exit Sub
    End If

    If FileCancel Then
        MsgBox1 "File Process Aborted", 0, ""
        Exit Sub
    End If

    If Direction% = 1 Then
        EncInPath$ = DrivePath$
    ElseIf Direction% = 2 Then
        DecInPath$ = DrivePath$
    End If

    MsgFlag% = -1
    If Direction% <> 2 Then
        CompFlag = 0
        Find$ = UCase$(Right$(DoFile$, 3))
        If InStr(1, Search$, Find$) < 1 Then
            Beep
            MsgFlag% = 0
            Msg1$ = "Compress File? This may be slower."
            Mv% = MsgBox2(Msg1$, 260, "")
            If Mv% = 6 Then
                CompFlag = -1
            Else
                CompFlag = 0
            End If
        End If
    End If

    If MasterPwdFlag = 0 Then Exit Sub
    If MsgFlag% = -1 Then
        If NotProceed%("Is this the correct file?", DoFile$) Then
            MsgBox1 "File Process Aborted", 0, ""
            Exit Sub
        End If
    End If

    If MasterPwdFlag = 0 Then Exit Sub
    If Direction% = 1 Then
        SetPath$ = EncOutPath$
        TitleStr$ = "Find Folder to Place Attachment"
    ElseIf Direction% = 2 Then
        SetPath$ = DecOutPath$
        TitleStr$ = "Find Folder to Place Attachment"
    End If
    SetFolders

    FileForm.Caption = TitleStr$
    FileForm.FileList.Enabled = 0
    FileForm.Show 1
    OutPutPath$ = DrivePath$
    FileForm.FileList.Enabled = -1

    If MasterPwdFlag = 0 Then Exit Sub
    If FileCancel Then
        MsgBox1 "File Process Aborted", 0, ""
        Exit Sub
    Else
        process% = Direction%
        DoProcess
    End If

    If Direction% = 1 Then
        EncOutPath$ = DrivePath$
    ElseIf Direction% = 2 Then
        DecOutPath$ = DrivePath$
    End If

End Sub

Sub SetFolders()

    On Local Error GoTo InvalidPath

    DrivePath$ = SetPath$
    FileForm.DriveBox.Drive = SetPath$
    FileForm.DirList.Path = SetPath$
    Exit Sub

InvalidPath:
    FileForm.DriveBox.Drive = CurDir$
    FileForm.DirList.Path = CurDir$

End Sub

Sub ReadKeys()

    Dim UserName As String * 40
    Dim NameCode As Byte
    Dim PadLength As Byte

    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 KeyFile is Empty!", 0, "Warning"
        Exit Sub
    End If

    '* get 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)

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

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

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

    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 "Error Reading Key File - " & _
                        "ReEnter Master Password", 0, "Error"
                '* reInit password
                MasterPwdFlag = 0
                For p% = 0 To 31: MasterPwd(i%) = 32: Next
                Ppos% = 0
                Exit Sub
            End If
        Next
        '* put names in list
        For j% = 0 To 39
            NameCode = (KeyArray(j% + 32, i%))
            Mid$(UserName, j% + 1, 1) = Chr$(NameCode)
        Next
        KeysForm.UserList.AddItem UserName
    Next

End Sub

Private Function VerifyChange%()
    CmpFlag% = 0
    If Ppos% <> 15 Then  '* length of "CHANGE PASSWORD"
        CmpFlag% = -1
    Else
        For i% = 0 To Ppos% - 1
            If MasterPwd(i%) <> CheckPwd(i%) Then
                CmpFlag% = -1
            End If
        Next
    End If
    VerifyChange% = (Not CmpFlag%)
End Function

Sub Security_Timer()

    If Int(Timer - PwdMark) < 0 Then PwdMark = Int(Timer)
    If Int(Timer - PwdMark2) < 0 Then PwdMark2 = Int(Timer)

    If PwdLocked% Then
        Exit Sub
    ElseIf Int(Timer - PwdMark) >= 1200 Then
        Unload InputForm
        Unload MsgForm
        Unload KeysForm
        Unload FileForm
        DoEvents
        CleanUp
        PwdLocked% = -1: MasterPwdFlag = 0: SelectKey = -1
        Ppos% = 0: KeysFound = -1: NotFlag% = 0
        MsgBox "Master Password Removed from Memory"
        PwdMark = Int(Timer)
        Exit Sub
    ElseIf Int(Timer - PwdMark2) >= 25 Then
        NotPassword
        PwdMark2 = Int(Timer)
    End If

End Sub

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX