السلام عليكم ورحمة الله وبركاته ، أتشرف بتلبية دعوتكم للمشاركة أخي @سلمان الشهراني .
واسمحوا لي بالبدء بأول تفاعل بعد معلمي الفاضل @ابوخليل ، وبانتظار أساتذتي للدعم وتصحيح مفاهيمي إن كانت خاطئة .
بداية أعتقد وجوب وجود المكتبة Microsoft Script Runtime ، هذا الكود الذي خلصت به ولا أعلم إن كانت النتيجة صحيحة كما تريدون أم لا ، إلا أنني قمت بالتجربة على الموقعين في الفيديو وكانت النتيجة مرضية ومطابقة ( الموقع الأول ، الموقع الثاني ) .
فيما يلي ، الكود الأول لتحويل النص إلى SHA256 Hex
Function TextToBase64(ByVal text As String) As String
Dim sha As Object
Dim utf8Bytes() As Byte
Dim hash() As Byte
Dim i As Integer
Dim hashHex As String
Set sha = CreateObject("System.Security.Cryptography.SHA256Managed")
utf8Bytes = StrConv(text, vbFromUnicode)
hash = sha.ComputeHash_2(utf8Bytes)
hashHex = ""
For i = LBound(hash) To UBound(hash)
hashHex = hashHex & Right("0" & Hex(hash(i)), 2)
Next i
TextToBase64 = Base64Encode(hashHex)
Set sha = Nothing
End Function
Function Base64Encode(ByVal strData As String) As String
Dim objXML As Object
Set objXML = CreateObject("MSXML2.DOMDocument").createElement("b64")
objXML.DataType = "bin.base64"
objXML.nodeTypedValue = strData
Base64Encode = objXML.text
Set objXML = Nothing
End Function
والنتيجة يتكون في مربع النص ( الهدف الأول ) عن طريق زر الإستدعاء كما يلي :-
Private Sub btnComputeHash_Click()
If IsNull(Me.txtInput) Then
MsgBox "يرجى إدخال قيمة ليتم تشفيرها", , ""
Me.txtInput.SetFocus
Exit Sub
End If
Dim myText As String
myText = Me.txtInput
Dim base64Hash As String
base64Hash = TextToBase64(myText)
Me.txtHashOutput = base64Hash
End Sub
ثم باستخدام هذا الكود وبعد عدة تجارب يتم تحويل الـ Hex إلى Base64 :
Function HexToBase64(ByVal hexString As String) As String
Dim bytes() As Byte
Dim objXML As Object
bytes = HexStringToBytes(hexString)
Set objXML = CreateObject("MSXML2.DOMDocument").createElement("b64")
objXML.DataType = "bin.base64"
objXML.nodeTypedValue = bytes
HexToBase64 = objXML.text
Set objXML = Nothing
End Function
Function HexStringToBytes(ByVal hexString As String) As Byte()
Dim bytes() As Byte
Dim i As Integer
ReDim bytes(Len(hexString) \ 2 - 1)
For i = 1 To Len(hexString) Step 2
bytes((i + 1) \ 2 - 1) = Val("&H" & Mid(hexString, i, 2))
Next i
HexStringToBytes = bytes
End Function
ويتم الاستدعاء في الزر كالآتي :-
Private Sub Btn_Base64_Click()
If IsNull(Me.txtHashOutput) Then
MsgBox "لم يتم حساب قيمة Hex بعد.", , ""
Exit Sub
End If
Dim base64Value As String
base64Value = HexToBase64(Me.txtHashOutput)
Me.Txt_Base64 = base64Value
End Sub
وفي النهاية أترك التجربة للحكم والتعديل .
Hash Con.accdb