frmmypad.frm

加密日记,解密与加密隐私文件!~~~~~~~~~~~~~~~~

    Discode2
End Sub

Private Sub menuEncode1_Click()
    Encode1
End Sub

Private Sub menuEncode2_Click()
    Encode2
End Sub

Private Sub menuExit_Click()
    If RichTextBox1.Text <> "" And SaveFlag = False Then
        If MsgBox("是否保存当前文件?", vbYesNo, "注意") = vbYes Then
           menuSave_Click
        End If
    End If
    End
End Sub

Private Sub menuFont_Click()
    On Error Resume Next
    With CommonDialog1
        .Flags = cdlCFBoth Or cdlCFEffects
        If .FontName = "" Then FontName = "宋体"
        .CancelError = True
        .ShowFont
    End With
    With RichTextBox1
        .SelFontName = CommonDialog1.FontName
        .SelFontSize = CommonDialog1.FontSize
        .SelBold = CommonDialog1.FontBold
        .SelItalic = CommonDialog1.FontItalic
        .SelUnderline = CommonDialog1.FontUnderline
        .SelStrikeThru = CommonDialog1.FontStrikethru
        .SelColor = CommonDialog1.Color
    End With
    

End Sub

Private Sub menuItalic_Click()
    RichTextBox1.SelItalic = Not RichTextBox1.SelItalic
End Sub

Private Sub menuLeft_Click()
    RichTextBox1.SelAlignment = rtfLeft

End Sub

Private Sub menuNew_Click()
    If RichTextBox1.Text <> "" And SaveFlag = False Then
        If MsgBox("是否保存当前文件?", vbYesNo, "注意") = vbYes Then
           menuSave_Click
        End If
    End If
    
    RichTextBox1.Enabled = True
    RichTextBox1.Text = ""
    RichTextBox1.Font.Name = "宋体"
    RichTextBox1.Font.Size = 14
    
    Toolbar1.Buttons(3).Enabled = True
    Toolbar1.Buttons(5).Enabled = True
    Toolbar1.Buttons(6).Enabled = True
    Toolbar1.Buttons(7).Enabled = True
    
    menuSave.Enabled = True
    menuSaveAs.Enabled = True
    menuPrint.Enabled = True
    menuEdit.Enabled = True
    
    SaveFlag = True
    MyDocName = ""
    
    
    


End Sub

Private Sub menuOpen_Click()
    If RichTextBox1.Text <> "" And SaveFlag = False Then
        If MsgBox("是否保存当前文件?", vbYesNo, "注意") = vbYes Then
           menuSave_Click
        End If
    End If
    CommonDialog1.CancelError = True
    On Error GoTo errhandler
    CommonDialog1.FileName = ""
    CommonDialog1.Filter = "RTF文件(*.rtf )| *.rtf |文本文件(*.txt)|*.txt|所有文件(*.*)|(*.*)"
    CommonDialog1.FilterIndex = 1
    CommonDialog1.DefaultExt = "*.rtf"
    CommonDialog1.ShowOpen
    
    If CommonDialog1.FileName <> "" Then
        MyDocName = CommonDialog1.FileName
        Me.Caption = "我的日记————" + CommonDialog1.FileName
        RichTextBox1.LoadFile (MyDocName)
    End If
    
    
    RichTextBox1.Enabled = True

    
    Toolbar1.Buttons(3).Enabled = True
    Toolbar1.Buttons(5).Enabled = True
    Toolbar1.Buttons(6).Enabled = True
    Toolbar1.Buttons(7).Enabled = True
    
    menuSave.Enabled = True
    menuSaveAs.Enabled = True
    menuPrint.Enabled = True
    menuEdit.Enabled = True
    
    SaveFlag = True
errhandler:
    Exit Sub
    
    
    
    
End Sub

Private Sub menuPaste_Click()
    SendKeys "^V", True '模拟组合键盘 Ctrl+V
End Sub

Private Sub menuPrint_Click()
    On Error Resume Next
    CommonDialog1.CancelError = True
    CommonDialog1.Flags = &H40
    CommonDialog1.ShowPrinter
    
    'printer.pri
    
End Sub

Private Sub menuRight_Click()
    RichTextBox1.SelAlignment = rtfRight
End Sub

Private Sub menuSave_Click()
    If MyDocName <> "" Then
        If SaveFlag = False Then
            RichTextBox1.SaveFile (MyDocName)
            
        
        End If
    Else
        menuSaveAs_Click
    End If
    SaveFlag = True
    
    
    
End Sub

Private Sub menuSaveAs_Click()
    CommonDialog1.CancelError = True
    On Error GoTo errhandler
    CommonDialog1.Filter = "RTF文件(*.rtf )| *.rtf |文本文件(*.txt)|*.txt|所有文件(*.*)|(*.*)"
    CommonDialog1.DefaultExt = "*.rtf"
    CommonDialog1.ShowSave
    
    
    If CommonDialog1.FileName <> "" Then
        MyDocName = CommonDialog1.FileName
        Me.Caption = "我的日记————" + CommonDialog1.FileName
        RichTextBox1.SaveFile (MyDocName)
      
    
    End If
    
       
errhandler:
    Exit Sub

End Sub

Private Sub menuSelectAll_Click()
    RichTextBox1.SelStart = 0
    RichTextBox1.SelLength = Len(RichTextBox1.Text)
End Sub

Private Sub menuUnderline_Click()
    RichTextBox1.SelUnderline = Not RichTextBox1.SelUnderline
End Sub

Private Sub RichTextBox1_Change()
    SaveFlag = False
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
            Case "new"
                menuNew_Click
            Case "open"
                menuOpen_Click
            Case "save"
                menuSave_Click
            Case "copy"
                menuCopy_Click
            Case "cut"
                menuCut_Click
            Case "paste"
                menuPaste_Click

    End Select
    
End Sub



Private Sub Encode2()
 
    '针对 汉字 与 字母 加密，格式与其它数据（图片）将会丢失
    Dim l As Long
    Dim i As Long
    Dim c As String
    Dim p As String
    Dim a As String * 1
    
    p = RichTextBox1.Text
    l = Len(RichTextBox1.Text)
    c = ""
    For i = 1 To l
      a = Mid(p, i, 1)
      
      Select Case Asc(a)
         Case Is < 0  '汉字
            a = Chr(Asc(a) - 20)
        Case 1 To 64 '字母
            a = Chr(Asc(a) + 64)
                          
        Case 65 To 128  '字母
            a = Chr(Asc(a) - 64)
          
      End Select
      
      c = c + a
    Next i
    RichTextBox1.Text = c


End Sub

Private Sub Discode2()
  '针对 汉字 与 字母 加密，格式与其它数据（图片）将会丢失
    Dim l As Long
    Dim i As Long
    Dim c As String
    Dim p As String
    Dim a As String * 1
    
    p = RichTextBox1.Text
    l = Len(RichTextBox1.Text)
    c = ""
    For i = 1 To l
      a = Mid(p, i, 1)
      
      Select Case Asc(a)
        Case Is < 0  '汉字
            a = Chr(Asc(a) + 20)
        
        Case 1 To 64 '字母
            a = Chr(Asc(a) + 64)
                          
        Case 65 To 128  '字母
            a = Chr(Asc(a) - 64)
          
      End Select
      
      c = c + a
    Next i
    RichTextBox1.Text = c

End Sub

Private Sub Discode1()
    Dim l As Long
    Dim i As Long
    Dim c As String
    Dim p As String
    Dim a As String * 1
    p = RichTextBox1.Text
    l = Len(RichTextBox1.Text)
    c = ""
    For i = 1 To l
      a = Mid(p, i, 1)
      Select Case Asc(a)
        Case Is < 0
            a = Chr(Asc(a) + 50)
        Case Asc("f") To Asc("z"), Asc("F") To Asc("Z")
             a = Chr(Asc(a) - 5)
                          
        Case Asc("a") To Asc("e"), Asc("A") To Asc("Z")
              a = Chr(Asc(a) + 21)
              
      End Select
      
      c = c + a
    Next i
    RichTextBox1.Text = c
End Sub

Private Sub Encode1()
    '针对 汉字 与 字母 加密，格式与其它数据（图片）将会丢失
    Dim l As Long
    Dim i As Long
    Dim c As String
    Dim p As String
    Dim a As String * 1
    
    p = RichTextBox1.Text
    l = Len(RichTextBox1.Text)
    c = ""
    For i = 1 To l
      a = Mid(p, i, 1)
      
      Select Case Asc(a)
        Case Is < 0
            a = Chr(Asc(a) - 50)
        Case Asc("a") To Asc("u"), Asc("A") To Asc("U")
             a = Chr(Asc(a) + 5)
                          
        Case Asc("v") To Asc("z"), Asc("V") To Asc("Z")
              a = Chr(Asc(a) - 21)
        
              
      End Select
      
      c = c + a
    Next i
    RichTextBox1.Text = c
End Sub