【已解决】VBA使用base64加密和解密，如何实现下面的效果？

约定的童话

Sub test()
    Dim m As String
    m = "执行标准：YBZ-PG-0015B-2022"
    mn = Base64Encode(m) '加密
    m = "5omn6KGM5qCH5YeG77yaWUJaLVBHLTAwMTVCLTIwMjI="
    nm = Base64Decode(m) '解密
End Sub
网上的代码试了很多，没发现好用的，js库的倒是可以...
解决方案：借用perfect131大佬的js文件实现加解密。


Sub 单个提取()
    Dim F, i, arr, s As String
    Dim WinHttp: Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    Dim HtmlDom: Set HtmlDom = CreateObject("htmlfile")
    Dim HtmlWin: Set HtmlWin = HtmlDom.parentWindow
    st = ReadFile(ThisWorkbook.Path & "\" & "crypto-js@4.0.0.js")
    HtmlWin.execScript st
    F = Application.GetOpenFilename("标签文件,*.lsdx", MultiSelect:=True)
    arr = Split(ReadFile(F(1)), Chr(10))
    For i = 2 To UBound(arr)
        If InStr(arr(i), "data=") > 0 Then
            s = Replace(Split(Split(arr(i), "data=")(1), " ")(0), """", "")
            nm = HtmlWin.eval("CryptoJS.enc.Base64.parse('" & s & "').toString(CryptoJS.enc.Utf8);") '解密
           'nm = HtmlWin.eval("CryptoJS.enc.Base64.stringify(CryptoJS.enc.Utf8.parse('你好123'));") '加密
        End If
    Next
    MsgBox "提取完成！", 48, "温馨提示"
End Sub

Public Function ReadFile(ByVal FileName As String) As String
    Dim objStream As Object
    Set objStream = CreateObject("ADODB.Stream")
    With objStream
        .Type = 2
        .mode = 3
        .Open
        .Charset = "UTF-8"
        .LoadFromFile FileName
        ReadFile = .ReadText
        .Close
    End With
End Function

perfect131

我早分享过 crypto-js
15 楼
https://club.excelhome.net/forum ... 10&pid=11056255

joforn

我很多年前应该发过源码，不过没有专门说明这个函数，因为其核心代码过于简单，所以只是以内部函数存在模块中了。详情请下载一楼的文件：https://club.excelhome.net/threa ... tml?_dsign=33faacfb
对了，没记错的话我这个函数默认把字符串转成了UTF-8编码字节数组后再转BASE64的，所以你要注意一下编码问题。

约定的童话

perfect131 发表于 2024-10-23 21:38
我早分享过 crypto-js
15 楼
https://club.excelhome.net/forum.php?mod=redirect&goto=findpost&ptid=15 ...

这个库咋用的？

perfect131

约定的童话 发表于 2024-10-23 21:53
这个库咋用的？

为什么这种你们不会的单 不让给我做呢

约定的童话

perfect131 发表于 2024-10-23 22:04
为什么这种你们不会的单 不让给我做呢

纯纯为了练手啊