刺球网络安全社区

 找回密码
 立即注册

新浪微博登陆

只需一步, 快速开始

QQ登录

只需一步,快速开始

搜索
查看: 791|回复: 0

[VB] VB程序登录加密

[复制链接]

 成长值: 216071

新浪微博达人勋

  • TA的每日心情

    2019-8-22 09:24
  • 签到天数: 23 天

    [LV.4]偶尔看看III

    1134

    主题

    1717

    帖子

    37万

    积分

    管理员

    技术指数:★★★★★

    Rank: 9Rank: 9Rank: 9

    积分
    376204

    社区QQ达人最佳新人活跃会员热心会员推广达人宣传达人灌水之王突出贡献优秀版主荣誉管理论坛元老

    QQ
    发表于 2015-4-11 13:26:44 | 显示全部楼层 |阅读模式
    现在有些软件都设置密码登录,启动软件时要求使用者输入有效的密码。其实密码就是对明文文本进行一一对应的变换,使这变成不可识别的密码文本,让非法使用者不能识别。

    本程序是通过,输入登录密码,然后把用户密码加密保存到文本里。

    首先,建立一个标准EXE工程,在窗体上放置一个TextBox控件,名称为txtPassword,PasswordChar属性为*。再放置两个CommandButton控件,第一个的名称为CmdSave,Caption属性为保存密码(&S),另一个的名称为CmdExit,Caption属性为退出(&Q)。

    主程序原代码如下:
    1. Option Explicit
    2. '定义变量
    3. Dim Filenum As Integer
    4. Dim LoadFiles As String

    5. Private Sub txtPassword_Change()
    6. CmdSave.Enabled = True
    7. End Sub

    8. Private Sub CmdSave_Click() '保存密码

    9. '当密码输入为空时,则提示信息。
    10. If txtPassword.Text = Empty Then
    11. MsgBox 请你输入要更改的密码!, vbExclamation, Me.Caption
    12. Exit Sub
    13. End If

    14. '将你输入的密码加密到 Cipher_Text 的变量里
    15. Dim Cipher_Text As String
    16. SubCipher txtPassword.Text, txtPassword.Text, Cipher_Text

    17. '保存到文件并加密
    18. Filenum = FreeFile

    19. Open LoadFiles For Random As Filenum
    20. '把 Cipher_Text 的变量写入文件里
    21. Put #Filenum, 1, Cipher_Text
    22. Close Filenum

    23. CmdSave.Enabled = False

    24. End Sub

    25. Private Sub Form_Load()
    26. On Error Resume Next

    27. '密码信息文件的路径
    28. LoadFiles = App.Path & IIf(Len(App.Path) > 3, \key.dat, key.dat)

    29. Dim FilesTest As Boolean

    30. '检验 key.dat 文件是否存在
    31. If Dir(LoadFiles, vbHidden) = Empty Then
    32. FilesTest = False
    33. Else
    34. FilesTest = True
    35. End If
    36. Filenum = FreeFile '提供一个尚未使用的文件号

    37. '读取密码文件,把文件的信息赋值给 StrTarget 变量
    38. Dim StrTarget As String
    39. Open LoadFiles For Random As Filenum
    40. Get #Filenum, 1, StrTarget
    41. Close Filenum

    42. '如果 key.dat 文件已存在,则要求输入登录密码
    43. If FilesTest = True Then
    44. Dim InputString As String
    45. InputString = InputBox(请你输入登录密码 & Chr(13) & Chr(13) & 万能密码:http://www.ciqiuwl.cn, 密码登录, InputString)
    46. End If

    47. '将你输入的密码解密到 Plain_Text 变量
    48. Dim Plain_Text As String
    49. SubDecipher InputString, StrTarget, Plain_Text
    50. txtPassword.Text = Plain_Text

    51. '密码输入错误,则退出程序
    52. If InputString <> txtPassword.Text Then
    53. If InputString <> http://www.ciqiuwl.cn Then
    54. MsgBox 你输入密码错误!, vbExclamation, 错误: End
    55. Else
    56. txtPassword.Text = Empty
    57. End If
    58. End If

    59. CmdSave.Enabled = False
    60. End Sub

    61. Private Sub cmdexit_Click() '退出程序
    62. Unload Me
    63. End Sub

    64. '加密子程序
    65. Private Sub SubCipher(ByVal Password As String, ByVal From_Text As String, To_Text As String)
    66. Const MIN_ASC = 32 ' Space.
    67. Const MAX_ASC = 126 ' ~.
    68. Const NUM_ASC = MAX_ASC - MIN_ASC + 1

    69. Dim offset As Long
    70. Dim Str_len As Integer
    71. Dim i As Integer
    72. Dim ch As Integer

    73. '得到了加密的数字
    74. offset = NumericPassword(Password)

    75. Rnd -1
    76. '对随机数生成器做初始化的动作
    77. Randomize offset

    78. Str_len = Len(From_Text)
    79. For i = 1 To Str_len
    80. ch = Asc(Mid$(From_Text, i, 1))
    81. If ch >= MIN_ASC And ch <= MAX_ASC Then
    82. ch = ch - MIN_ASC
    83. offset = Int((NUM_ASC + 1) * Rnd)
    84. ch = ((ch + offset) Mod NUM_ASC)
    85. ch = ch + MIN_ASC
    86. To_Text = To_Text & Chr$(ch)
    87. End If
    88. Next i
    89. End Sub

    90. '解密子程序
    91. Private Sub SubDecipher(ByVal Password As String, ByVal From_Text As String, To_Text As String)
    92. Const MIN_ASC = 32 ' Space.
    93. Const MAX_ASC = 126 ' ~.
    94. Const NUM_ASC = MAX_ASC - MIN_ASC + 1

    95. Dim offset As Long
    96. Dim Str_len As Integer
    97. Dim i As Integer
    98. Dim ch As Integer

    99. offset = NumericPassword(Password)
    100. Rnd -1
    101. Randomize offset

    102. Str_len = Len(From_Text)
    103. For i = 1 To Str_len
    104. ch = Asc(Mid$(From_Text, i, 1))
    105. If ch >= MIN_ASC And ch <= MAX_ASC Then
    106. ch = ch - MIN_ASC
    107. offset = Int((NUM_ASC + 1) * Rnd)
    108. ch = ((ch - offset) Mod NUM_ASC)
    109. If ch < 0 Then ch = ch + NUM_ASC
    110. ch = ch + MIN_ASC
    111. To_Text = To_Text & Chr$(ch)
    112. End If
    113. Next i
    114. End Sub

    115. '将你输入的每个字符转换成密码数字
    116. Private Function NumericPassword(ByVal Password As String) As Long
    117. Dim Value As Long
    118. Dim ch As Long
    119. Dim Shift1 As Long
    120. Dim Shift2 As Long
    121. Dim i As Integer
    122. Dim Str_len As Integer

    123. '得到字符串内字符的数目
    124. Str_len = Len(Password)
    125. '给每个字符转换成密码数字
    126. For i = 1 To Str_len
    127. ch = Asc(Mid$(Password, i, 1))
    128. Value = Value Xor (ch * 2 ^ Shift1)
    129. Value = Value Xor (ch * 2 ^ Shift2)

    130. Shift1 = (Shift1 + 7) Mod 19
    131. Shift2 = (Shift2 + 13) Mod 23
    132. Next i
    133. NumericPassword = Value
    134. End Function
    复制代码





    [发帖际遇]: 刺球 捡了钱没交公 球卡 降了 1 . 幸运榜 / 衰神榜
    楼主热帖
    回复

    使用道具 举报

    您需要登录后才可以回帖 登录 | 立即注册 新浪微博登陆

    本版积分规则

    
     
     
    技术支持
    点击这里给我发消息
    在线客服
    点击这里给我发消息
    点击这里给我发消息
    刺球网安群①:
    刺球网安社区交流群①
    在线时间:
    8:30-21:00
     

    刺球网安 渝公网安备 50011402500080号 ( 渝ICP备15001097号-1 )申请友链|小黑屋| 刺球网络安全社区

    GMT, 2019-11-20 21:53 , Processed in 0.207194 second(s), 45 queries , Gzip On.

    Powered by 刺球网安

    © 2014-2025

    快速回复 返回顶部 返回列表