<%
''........................................
'' RSA插件
'' author Flc 2021-02-02
'' Version v1.0
''........................................
Public Publickey, Privatekey
Private SB, Rsa
Private s_B, s_R, s_U
Private Sub Class_Initialize()
Set SB = App.Str.StringBuilder()
Set Rsa = Server.CreateObject("System.Security.Cryptography.RSACryptoServiceProvider")
s_B = 0
s_R = 0
s_U = 0
End Sub
Private Sub Class_Terminate()
Rsa.Clear()
Set Rsa = Nothing
Set SB = Nothing
End Sub
''前置簡寫，base64不進行編碼轉換
Public Function B()
s_B = 1 : Set B = Me
End Function
''前置簡寫，xml轉pem 私匙pkcs8轉換
Public Function R()
s_R = 1 : Set R = Me
End Function
''前置簡寫，xml轉pem 公匙轉換
Public Function U()
s_U = 1 : Set U = Me
End Function
''Rsa密匙初始化
Public Sub Rsakey()
With Rsa
Publickey = .ToXmlString(False) 'xml格式
Privatekey = .ToXmlString(True) 'xml格式
'App.Fso.CreateFile RsaFile & "Rsa-Publickey.xml", Publickey
'App.Fso.CreateFile RsaFile & "Rsa-Privatekey.xml", Privatekey
End With
End Sub
''密匙pem格式轉xml格式
''Ascii 密匙
Public Function Xml(ByVal Ascii)
Dim Header, Footer, Kind
If Ascii = "" Then Xml = "" : Exit Function
If Instr(Ascii, "BEGIN") > 0 And Instr(Ascii, "END") > 0 Then
If Instr(Ascii, "PUBLIC") Then
Header = "-----BEGIN PUBLIC KEY-----"
Footer = "-----END PUBLIC KEY-----"
ElseIf Instr(Ascii, "RSA PRIVATE") Then
Header = "-----BEGIN RSA PRIVATE KEY-----"
Footer = "-----END RSA PRIVATE KEY-----"
Else
Header = "-----BEGIN PRIVATE KEY-----"
Footer = "-----END PRIVATE KEY-----"
End If
Dim P0, P1
P0 = Instr( 1, Ascii, Header, vbTextCompare) + Len(Header)
P1 = Instr(P0, Ascii, Footer, vbTextCompare)
Ascii = Mid(Ascii, P0, (P1 - P0))
End If
Kind = App.IIF(Len(Ascii) > 800, 1, 0)
Xml = Encryption(App.Crypt.H.Base64Decode(Ascii), Kind)
End Function
''密匙xml格式轉pem格式
''Ascii 密匙
Public Function Pem(ByVal Str)
Dim I, Filter, Data : Data = Empty : I = 0
If s_U = 0 Then
''pkcs1 私匙
Filter = "RSA PRIVATE"
Str = Node(Str, 1)
Str = B.KeyLength("020100" & Str, "30")
''pkcs8 私匙
If s_R = 1 Then
Filter = "PRIVATE"
Str = B.KeyLength(Str, "04")
Str = B.KeyLength("020100300d06092a864886f70d0101010500" & Str, "30")
s_R = 0
End if
Else
''公匙
Filter = "PUBLIC"
Str = Node(Str, 0)
Str = B.KeyLength(Str, "0030")
Str = B.KeyLength(Str, "03")
Str = B.KeyLength("300d06092a864886f70d0101010500" & Str, "30")
s_U = 0
End If
Data = App.Crypt.H.Base64Encode(Str)
SB.Append "-----BEGIN " & Filter & " KEY-----" & VbCrlf
While I < Len(Data) / 64
SB.Append Mid(Data, I * 64 + 1, 64) & vbCrlf
I = I + 1
Wend
SB.Append "-----END " & Filter & " KEY-----"
Pem = SB.ToString
SB.Clear
End Function
''RSA XML節點轉換
Private Function Node(ByVal Str, ByVal Ascii)
Dim N, E, P, D, DP, DQ, InverseQ, Q, Xml
App.Xml.Load Str
If Ascii = 1 Then
N = KeyLength(App.Xml("Modulus").Text, "02")
E = KeyLength(App.Xml("Exponent").Text, "02")
P = KeyLength(App.Xml("P").Text, "02")
Q = KeyLength(App.Xml("Q").Text, "02")
DP = KeyLength(App.Xml("DP").Text, "02")
DQ = KeyLength(App.Xml("DQ").Text, "02")
InverseQ = KeyLength(App.Xml("InverseQ").Text, "02")
D = KeyLength(App.Xml("D").Text, "02")
Node = Join(Array(N, E, D, P, Q, DP, DQ, InverseQ), "")
Else
N = KeyLength(App.Xml("Modulus").Text, "02")
E = KeyLength(App.Xml("Exponent").Text, "02")
Node = N & E
End If
App.Xml.Close
End Function
''拼接數據長度計算
Public Function KeyLength(ByVal Str, ByVal Ascii)
If s_B = 0 Then Str = App.Crypt.H.Base64Decode(Str)
If CLng("&H" & Mid(Str, 1, 2)) >= 128 Then Str = "00" & Str
Dim Obj : Obj = Hex(Cint(Len(Str) / 2))
If Len(Obj) > 2 Then
KeyLength = Join(Array(Ascii, App.IIF(Len(Obj) = "3", "820", "82"), Obj, Str), "")
Else
If CLng("&H" & Obj) < 128 Then
KeyLength = Join(Array(Ascii, App.IIF(Len(Obj) = "1", "0", ""), Obj, Str), "")
Else
KeyLength = Join(Array(Ascii, App.IIF(Len(Obj) = "1", "810", "81"), Obj, Str), "")
End if
End If
s_B = 0
End Function
''pem轉xml節點分析
''目前只支持[1024bit],[2048bit]位數pem密匙轉換
Private Function Encryption(ByVal Str, ByVal Format)
Dim Text, Obj, Entry
Dim N, E, D, P, Q, DP, DQ, Inverseq
If Left(Migration(Str, 2), 2) = "30" Then
If CLng("&H" & Leng(Str)) = Len(Str) / 2 Then
If Format = 1 Then
If Left(Migration(Str, 2), 2) = "02" Then Text = Migration(Str, 4)
End If
Select Case Left(Migration(Str, 2), 2)
Case "30"
Text = CLng("&H" & Left(Migration(Str, 2), 2))
Obj = Left(Migration(Str, 2), 2)
''OBJECT_IDENTIFIER版本號，未輸出
If Obj = "06" Then
Text = Left(Migration(Str, 2), 2)
Text = Migration(Str, CLng("&H" & Text) * 2)
End If
''UNLL
If Left(Migration(Str, 2), 2) = "05" And Left(Migration(Str, 2), 2) = "00" Then
Obj = Left(Migration(Str, 2), 2) : Text = Leng(Str)
''2048密匙下多出一位
If Left(Str, 2) = "00" Then Text = Migration(Str, 2)
End If
If Left(Migration(Str, 2), 2) = "30" Then
Text = Leng(Str)
If Format = 1 Then
If Left(Migration(Str, 2), 2) = "02" Then Text = Leng(Str)
If Text <> "00" Then
''Encryption = "{""code"": 1001, ""msg"": ""密匙錯誤,請檢查!"", ""data"": """"}"
App.Console "密匙 ["& App.IIf(Format = 1, "Privatekey", "Publickey") &"] 格式錯誤"
App.Error.FunctionName = "Rsa.Encryption"
App.Error.Detail = App.IIf(Format = 1, "Privatekey", "Publickey")
App.Error.Raise "error-crypt-rsa"
'Exit Function
End If
End If
If Left(Migration(Str, 2), 2) = "02" Then N = Identifier(Str)
End If
Case "02"
N = Identifier(Str)
If N = "" Then Text = Migration(Str, 2) : N = Identifier(Str)
Case Else
App.Console "密匙 ["& App.IIf(Format = 1, "Privatekey", "Publickey") &"] 格式錯誤"
App.Error.FunctionName = "Rsa.Encryption"
App.Error.Detail = App.IIf(Format = 1, "Privatekey", "Publickey")
App.Error.Raise "error-crypt-rsa"
End Select
If Left(Migration(Str, 2), 2) = "02" Then E = Identifier(Str)
If Format = 1 Then
If Left(Migration(Str, 2), 2) = "02" Then D = Identifier(Str)
If Left(Migration(Str, 2), 2) = "02" Then P = Identifier(Str)
If Left(Migration(Str, 2), 2) = "02" Then Q = Identifier(Str)
If Left(Migration(Str, 2), 2) = "02" Then DP = Identifier(Str)
If Left(Migration(Str, 2), 2) = "02" Then DQ = Identifier(Str)
If Left(Migration(Str, 2), 2) = "02" Then Inverseq = Identifier(Str)
Encryption = Join(Array("<RSAKeyValue><Modulus>", N, "</Modulus><Exponent>", E, "</Exponent><P>", P, "</P><Q>", Q, "</Q><DP>", DP, "</DP><DQ>", DQ, "</DQ><InverseQ>", Inverseq, "</InverseQ><D>", D, "</D></RSAKeyValue>"), "")
Else
Encryption = Join(Array("<RSAKeyValue><Modulus>", N, "</Modulus><Exponent>", E, "</Exponent></RSAKeyValue>"), "")
End If
End If
Else
App.Console "密匙 ["& App.IIf(Format = 1, "Privatekey", "Publickey") &"] 格式錯誤"
App.Error.FunctionName = "Rsa.Encryption"
App.Error.Detail = App.IIf(Format = 1, "Privatekey", "Publickey")
App.Error.Raise "error-crypt-rsa"
End If
End Function
''節點數據提取
Private Function Identifier(ByRef Str)
Dim Text
If Left(Str, 2) = "81" Or Left(Str, 2) = "82" Then
Text = Leng(Str)
Else
Text = Left(Migration(Str, 2), 2)
End If
Text = CLng("&H" & Text) * 2
Text = Left(Migration(Str, Text), Text)
If Left(Text, 2) = "00" Then Text = Right(Text, Len(Text) - 2)
Identifier = App.Crypt.B.Base64Encode(App.Crypt.D.Base(Text))
End Function
''節點長度
Private Function Leng(ByRef Str)
Dim I, Lo, Text : I = 1
Text = Left(Migration(Str, 2), 2)
Lo = CLng("&H" & Text)
If Lo >= 128 Then I = I - 1 + (Lo - 128)
Leng = Left(Migration(Str, I * 2), I * 2)
End Function
''數據偏移
Private Function Migration(ByRef Str, ByVal Length)
Migration = Str
Str = Right(Str, Len(Str) - Length)
End Function
''rsa簽名 私匙簽名
''4.5以上版本需改.SignHash_2, 以下為SignHash
''Hash 加密內容
''Length sha1 or sha256
Public Function Sign(ByVal Hash, ByVal Length)
With Rsa
.FromXmlString(Privatekey)
Hash = App.Crypt.Middleware(Hash, "System.Security.Cryptography." & UCase(Length) & "Managed", "")
Sign = App.Crypt.B.Base64Encode(.SignHash_2(App.Crypt.D.Base(Hash), Length))
End With
End Function
''rsa驗證 公匙驗證
''4.5以上版本需改.VerifyHash_2, 以下為.VerifyHash
''Hash 加密內容
''Signature 簽名內容
''Length sha1 or sha256
Public Function Verify(ByVal Hash, ByVal Signature, ByVal Length)
With Rsa
.FromXmlString(Publickey)
Hash = App.Crypt.Middleware(Hash, "System.Security.Cryptography." & UCase(Length) & "Managed", "")
Verify = .VerifyHash_2(App.Crypt.D.Base(Hash), Length, App.Crypt.B.Base64Decode(Signature))
End With
End Function
''Rsa加密 公匙加密
''需要.net framework4.5版本庫的支持，系統最低要求win7，win2008
''4.5以上版本需改.Encrypt_2
''Str 加密內容
Public Function Encrypt(ByVal Str)
Dim I, MAX_ENCRYPT_BLOCK : I = 0
With Rsa
.FromXmlString(Publickey)
MAX_ENCRYPT_BLOCK = (.KeySize / 8 - 11) * 2
'Str = App.Crypt.Base(App.Str.ToByte(Server.UrlEncode(Str)))
Str = App.Crypt.Base(App.Str.ToByte(Str))
While I < Len(Str) / MAX_ENCRYPT_BLOCK
''如果為 true OAEP 填充, 為 false PKCS#1 v1.5 填充。
SB.Append App.Crypt.Base(.Encrypt_2(App.Crypt.D.Base(Mid(Str, I * MAX_ENCRYPT_BLOCK + 1, MAX_ENCRYPT_BLOCK)), False))
I = I + 1
Wend
Encrypt = App.Crypt.B.Base64Encode(App.Crypt.D.Base(SB.ToString))
'RsaEncrypt = SB.ToString
SB.Clear
End With
End Function
''Rsa解密 私匙解密
''需要.net framework4.5版本庫的支持，系統最低要求win7，win2008
''4.5以上版本需改.Decrypt_2
''Str 解密內容
Public Function Decrypt(ByVal Str)
Dim I, MAX_ENCRYPT_BLOCK : I = 0
With Rsa
.FromXmlString(Privatekey)
MAX_ENCRYPT_BLOCK = .KeySize / 8 * 2
Str = App.Crypt.H.Base64Decode(Str)
While I < Len(Str) / MAX_ENCRYPT_BLOCK
SB.Append App.Str.ToString(.Decrypt_2(App.Crypt.D.Base(Mid(Str, I * MAX_ENCRYPT_BLOCK + 1, MAX_ENCRYPT_BLOCK)), False))
I = I + 1
Wend
'Decrypt = App.UrlDecode(SB.ToString)
Decrypt = SB.ToString
SB.Clear
End With
End Function
%>
您發布的評論即表示同意遵守以下條款:
一、不得利用本站危害國家安全、泄露國家秘密,不得侵犯國家、社會、集體和公民的合法權益;
二、不得發布國家法律、法規明令禁止的內容;互相尊重,對自己在本站的言論和行為負責;
三、本站對您所發布內容擁有處置權。
蘇公網安備 32070502010230號