Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Szyfrowanie i deszyfrowanie RSA

Marecki · Wysłany: 17-05-2024, 19:53

Może to Ci pomoże

Cytat:

https://lapo.it/asn1js/

Tak wyglądają te offsety ze specyfikacji ASN.1:
SEQUENCE(2 elem) offset:0 length:4+290 (constructed)
SEQUENCE(2 elem)) offset:4 length:2+13 (constructed)
OBJECT IDENTIFIER 1.2.840.113549.1.1.1 rsaEncryption(PKCS #1) offset:6 length:2+9
NULL offset:17 length:2+0
BIT STRING(1 elem) offset:19 length:4+271 (encapsulates)
SEQUENCE(2 elem) offset:24 length:4+266 (constructed)

Marecki · Wysłany: 17-05-2024, 21:06

To mi wyszło to tak

Kod:

Option Explicit

Sub TestExtractModulus()
Dim pemKey As String
Dim Token As String
Dim modulus As String

pemKey = "MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAuWosgHSpiRLadA0fQbzshi5TluliZfDsJujPlyYqp6A3qnzS3WmHxtwgO58uTbemQ1HCC2qwrMwuJqR6l8tgA4ilBMDbEEtkzgbjkJ6xoEqBptgxivP/ovOFYYoAnY6brZhXytCamSvjY9KI0g0McRk24pOueXT0cbb0tlwEEjVZ8NveQNKT2c1EEE2cjmW0XB3UlIBqNqiY2rWF86DcuFDTUy+KzSmTJTFvU/ENNyLTh5kkDOmB1SY1Zaw9/Q6+a4VJ0urKZPw+61jtzWmucp4CO2cfXg9qtF6cxFIrgfbtvLofGQg09Bh7Y6ZA5VfMRDVDYLjvHwDYUHg2dPIk0wIDAQAB"
modulus = ExtractModulusFromPEM(pemKey)

Token = HexToBase64(modulus)
Debug.Print Token & vbNewLine
[B2] = Token
End Sub
Function HexToBytes(hexString As String, bOffset As Byte) As Byte()
Dim i As Long
Dim bytes() As Byte
Dim bOut() As Byte

ReDim bytes(Len(hexString) \ 2 - 1)
For i = 1 To Len(hexString) Step 2
bytes(i \ 2) = Val("&H" & Mid(hexString, i, 2))
Next i

ReDim bOut(UBound(bytes) - bOffset)
For i = 1 To UBound(bOut)
bOut(i - 1) = bytes(i + 32)
Next i

HexToBytes = bOut
End Function

Function HexToBase64(hexString As String) As String
Dim bytes() As Byte
Dim base64String As String

bytes = HexToBytes(hexString, 37)

base64String = EncodeBase64(bytes)
base64String = Replace(base64String, vbLf, "")
base64String = Left(base64String, Len(base64String) - 2) & "=="
HexToBase64 = base64String

End Function

Function ExtractModulusFromPEM(ByVal pemKey As String) As String
Dim i As Long
Dim decodedStr As String
Dim publicKeyBytes() As Byte

pemKey = Replace(pemKey, "-----BEGIN PUBLIC KEY-----", "")
pemKey = Replace(pemKey, "-----END PUBLIC KEY-----", "")
pemKey = Replace(pemKey, vbCrLf, "")
pemKey = Replace(pemKey, vbLf, "")

publicKeyBytes = DecodeBase64(pemKey)

For i = LBound(publicKeyBytes) To UBound(publicKeyBytes)
decodedStr = decodedStr & Right("00" & Hex(publicKeyBytes(i)), 2)
Next i
ExtractModulusFromPEM = decodedStr

End Function

Function DecodeBase64(ByVal base64String As String) As Byte()
Dim xml As Object
Dim node As Object

Set xml = CreateObject("MSXML2.DOMDocument.6.0")
Set node = xml.createElement("b64")
node.DataType = "bin.base64"
node.Text = base64String
DecodeBase64 = node.nodeTypedValue
End Function

Function EncodeBase64(bytes() As Byte) As String
Dim xmlDoc As Object
Dim byteArray() As Byte

Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")

ReDim byteArray(0 To UBound(bytes))
byteArray = bytes

With xmlDoc.createElement("b64")
.DataType = "bin.base64"
.nodeTypedValue = byteArray
EncodeBase64 = .Text
End With

Set xmlDoc = Nothing
End Function

Nie wiem czy nie namieszałem, ale działa.
A łeb już mam taki wielki od tych szyfrów, że śmiało mogę zacząć projektować nową enigmę. :lol:

Rafał wielkie dzięki za pomoc.
Jak będziesz miał zrobiony kod pod kontem klucza info RSA to z chęcią zobaczę jak to wygląda.
Jeszcze raz Thx.

Rafał B. · Wysłany: 18-05-2024, 14:20

No to świetnie, że ogarnąłeś to przekonwertowanie i śmiga :beer

Działam na razie w innym temacie, a wątek postaram się uzupełnić w późniejszym terminie. Na razie nawet nie mam ochoty wracać do tego, też mnie zmęczył ten temat okrutnie i to w dość krótkim czasie... :D