2008年6月25日星期三

凯撒密码转换器 2.0.1

这个……MS上校我好久以前的作品了,初三的时候写的,仅供娱乐~

源代码就贴frmMain好了,其他自己看吧。

Option Explicit

Dim bytLogsAct As Byte


Private Sub cmdAbout_Click()

  Load frmAbout
  
  frmAbout.Show 1

End Sub


Private Function CaesarChange(OriginalText As String, MoveNum As Integer) As String

  '************************************************************
  
  '///加密/解密核心函数
  
  '************************************************************

  Dim strOrgText As String, bytArrayText() As Byte, lngTime  As Long, bytMoveNum As Integer, bytArrayTextLong As Long
    
  strOrgText = OriginalText '//////////获取文本
  
  bytArrayText = strOrgText  '//////////自动将要转换的字符转为UniCode值

  bytArrayTextLong = LenB(strOrgText) - 1  '//////////获取字节数
  
  bytMoveNum = MoveNum  '//////////获取要转换的位数
  
  For lngTime = 0 To bytArrayTextLong Step 2   '//////////使用For遍历读取已转换好的每一项Unicode值,合法的转换,不合法的保留
    
    If bytArrayText(lngTime + 1) <> 0 Then GoTo Doop   '//////////非英文
    
    If (bytArrayText(lngTime) >= 97 And bytArrayText(lngTime) <= 122) Then      '//////////小写a-z
    
      bytArrayText(lngTime) = bytArrayText(lngTime) + bytMoveNum      '//////////转换
      
      If bytArrayText(lngTime) < 97 Then
      
        bytArrayText(lngTime) = bytArrayText(lngTime) + 26
        
      ElseIf bytArrayText(lngTime) > 122 Then
      
        bytArrayText(lngTime) = bytArrayText(lngTime) - 26
        
      End If
         
    ElseIf bytArrayText(lngTime) >= 65 And bytArrayText(lngTime) <= 90 Then     '//////////字符在A-Z中
    
      bytArrayText(lngTime) = bytArrayText(lngTime) + bytMoveNum
    
      If bytArrayText(lngTime) > 90 Then
      
        bytArrayText(lngTime) = bytArrayText(lngTime) - 26
        
      ElseIf bytArrayText(lngTime) < 65 Then
      
        bytArrayText(lngTime) = bytArrayText(lngTime) + 26
        
      End If
    
    End If
    
Doop:
       
  Next
  
  CaesarChange = bytArrayText    '///返回转换结果

End Function


Private Sub cmdDecrypt_Click()

  '************************************************************
  
  '///解密操作

  '************************************************************

  If (Val(txtMoveNum.Text) > 25 Or Val(txtMoveNum.Text) < 1) Then
    
    txtMoveNum.Text = "3"

  ElseIf Len(txtOrgText.Text) = 0 Then
    
    Exit Sub
  
  End If

  txtPass.Text = CaesarChange(txtOrgText.Text, -Val(txtMoveNum.Text))   '//////////显示
  
  bytLogsAct = 2
  
  Call Logs
  
  Call CopyToClbrd
  
  Call AutoCls
  
  Exit Sub
  
Fal:
  
  MsgBox "密码转换出错,请检查所输入的数据!", vbExclamation  '//////////容错处理
  
End Sub


Private Sub cmdOption_Click()

  Load frmOption
  
  frmOption.Show 1

End Sub


Private Sub Form_Initialize()
  
  InitCommonControls
  
End Sub


Private Sub cmdEncrypt_Click()

  '************************************************************
  
  '///加密操作

  '************************************************************

  If (Val(txtMoveNum.Text) > 25 Or Val(txtMoveNum.Text) < 1) Then
    
    txtMoveNum.Text = "3"
     
  ElseIf Len(txtOrgText.Text) = 0 Then
    
    Exit Sub
  
  End If
  
  On Error GoTo Fal
  
  txtPass.Text = CaesarChange(txtOrgText.Text, Val(txtMoveNum.Text)) '//////////显示
  
  bytLogsAct = 1
  
  Call Logs
  
  Call CopyToClbrd
  
  Call AutoCls
  
  Exit Sub
  
Fal:
  
  MsgBox "密码转换出错,请检查所输入的数据!", vbExclamation  '//////////容错处理
  
End Sub


Private Sub CopyToClbrd()

  '************************************************************
  
  '///自动复制到剪切板
  
  '************************************************************
  
  If bytAutoCopy = 0 Then Exit Sub    '///没选中就退出
  
  Clipboard.Clear    '///清空剪切板
  
  Clipboard.SetText txtPass.Text    '///复制

End Sub


Private Sub AutoCls()

  '************************************************************
  
  '///加密/解密后自动清空原文
  
  If bytAutoCls = 0 Then Exit Sub
  
  txtOrgText.Text = ""    '///清空
  
End Sub


Private Sub Logs()

  '************************************************************
  
  '///记录加密/解密操作

  If bytLogs = 0 Then Exit Sub    '///该选项未被选中,退出函数
  
  Dim strAct As String, strOne As String, strTow As String, FileName As String, bytFirst As Byte
  
  If bytLogsAct = 1 Then    '///加密操作
    
    strAct = "加密": strOne = "明文:": strTow = "密文:"
    
  Else    '///解密
  
    strAct = "解密": strOne = "密文:": strTow = "明文:"
    
  End If
  
  FileName = App.Path & "\Logs.txt"
  
  If Dir(FileName) = "" Then bytFirst = 1    '///是否已存在日志记录,纯粹为了记录的文字美观而构建的Code
  
  Open FileName For Append As #1
  
  If bytFirst = 0 Then Print #1, ""    '///如果已经存在,先加入一空行再写入数据。PS:纯粹为了好看
  
  Print #1, Date & " " & Time & "  " & "执行"; strAct & "操作"    '///操作的时间以及操作内容
  
  Print #1, ""
      
  Print #1, strOne
  
  Print #1, txtOrgText.Text
  
  Print #1, ""
  
  Print #1, strTow
  
  Print #1, txtPass.Text
      
  Close #1
  
  '///清空各项数据
  
  strAct = "": strOne = "": strTow = "": FileName = "": bytFirst = 0
  
End Sub


Private Sub Form_Load()

  '************************************************************
  
  '///读取程序设置
  
  Call LoadOptions    '///获取给项信息

  txtMoveNum.Text = bytMoveNum    '///转移位数

End Sub


Private Sub Form_Unload(Cancel As Integer)

  '************************************************************
  
  '///获取各项数据,并写入cfg文件

  bytMoveNum = Val(txtMoveNum.Text)    '///获取转移位数

  Call WriteOption    '///向cfg文件写入设置

End Sub


恺撒密码转换器.rar

没有评论:

发表评论

1、可以使用<b>、<i>、<a>等Html标志,让评论更有特色...
2、支持OpenID登录,技术达到国际先进水平。但切记,评论内容不代表本站观点!
3、当遇到“连接被重置”、“连接超时”和“此网页无法访问”等而发表不了评论的话,请多刷新几次页面,或迟三分钟后再试;
4、对你的浏览造成不便,站长在此代表全国G.FW工作人员向你鞠躬致歉!!!