frmmain.frm

用visual basic语言开发的进行RSA加密的代码

VERSION 5.00
Begin VB.Form FrmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "RSA!"
   ClientHeight    =   5415
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5655
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   361
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   377
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox TxtInput 
      Alignment       =   2  'Center
      Height          =   270
      Left            =   1560
      TabIndex        =   4
      Text            =   "9"
      Top             =   4980
      Width           =   735
   End
   Begin VB.CommandButton CmdCheck 
      Caption         =   "C&heck"
      Height          =   375
      Left            =   2400
      TabIndex        =   2
      Top             =   4920
      Width           =   1335
   End
   Begin VB.CommandButton CmdCreate 
      Caption         =   "&Create"
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   4920
      Width           =   1335
   End
   Begin VB.TextBox TxtInfo 
      Height          =   3855
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   120
      Width           =   5415
   End
   Begin VB.Label LblTime 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Height          =   495
      Left            =   3840
      TabIndex        =   5
      Top             =   4800
      Width           =   1695
   End
   Begin VB.Label LblInfo 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Height          =   735
      Left            =   120
      TabIndex        =   3
      Top             =   4080
      Width           =   5415
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'RSA运算模块
'作者：刺猬
'修改：陨落雕(刘留)
'本模块您可以任意使用或传播，但是请不要删除上面的说明文字，
'如用于商业用途，请在Credit里面注明使用本模块，谢谢合作！
'RSA算法内容请参阅RSA-Demo
'N、E、D的生成也请使用这个方便的工具RSA-Demo

Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Const n As String = "4CF9BDEFF09FB7C5628E0AC82DDDD765"
Const e As String = "3A3A44E2870BDAB001300D15D5D8AF15"
Const d As String = "10001"

Const n_lng As Long = 4161
Const e_lng As Long = 1613
Const d_lng As Long = 5

Function CreateKey(InputStr As String) As String
Dim Arrn() As Long, Arre() As Long, ArrInput() As Long
Arrn = HexToArr(n)
Arre = HexToArr(e)
ArrInput = HexToArr(InputStr)
CreateKey = ArrToHex(ArrMiMod(ArrInput, Arre, Arrn))
End Function

Function CheckKey(InputStr As String) As String
Dim Arrn() As Long, Arrd() As Long, ArrInput() As Long
Arrn = HexToArr(n)
Arrd = HexToArr(d)
ArrInput = HexToArr(InputStr)
CheckKey = ArrToHex(ArrMiMod(ArrInput, Arrd, Arrn))
End Function

Function CreateKey_Lng(InputLng As Long) As Long 'RSA编码，Long型
CreateKey_Lng = Mod_Power_Op_Lng(InputLng, e_lng, n_lng)
End Function

Function CheckKey_Lng(InputLng As Long) As Long 'RSA解码，Long型
CheckKey_Lng = Mod_Power_Op_Lng(InputLng, d_lng, n_lng)
End Function

Private Sub CmdCheck_Click()
Dim GenKey As String
On Error GoTo ERROR
TempLng = timeGetTime
GenKey = CheckKey(TxtInfo.Text)
TxtInfo.Text = GenKey
ERROR:
LblTime.Caption = "Ck: " & CStr(timeGetTime - TempLng) & "ms"
End Sub

Private Sub CmdCreate_Click()
Dim GenKey As String
TempLng = timeGetTime
GenKey = CreateKey(TxtInput.Text)
TxtInfo.Text = GenKey
LblTime.Caption = "Ct: " & CStr(timeGetTime - TempLng) & "ms"
End Sub

Function Mod_Power_Op_Lng(a As Long, b As Long, n As Long) As Long
Dim ModNum As Long, TempNum As Long, c As Long
c = "1"
Do While b > 0
  If b Mod 2 = 0 Then
    b = b \ 2
    a = a * a Mod n
  Else
    b = b - 1
    c = c * a Mod n
  End If
Loop
Mod_Power_Op_Lng = c
End Function

Private Sub Form_Load()
LblInfo.Caption = "N: " & n & vbCrLf & "E: " & e & vbCrLf & "D: " & d
End Sub