You need to enable JavaScript to run this app.
最新活动
大模型
产品
解决方案
定价
生态与合作
支持与服务
开发者
了解我们

VBA中CredReadW读取Windows凭据管理器内Jira集成PAT失败的问题排查及解决方法求助

VBA中CredReadW读取Windows凭据管理器内Jira集成PAT失败的问题排查及解决方法求助

大家好,我正在做Excel VBA和Jira的集成开发,为了安全起见不想把个人访问令牌(PAT)硬编码在Excel文件里,所以选择用Windows凭据管理器来存储和读取这个令牌。目前写入凭据的CredWriteW代码已经能正常工作,但读取部分的CredReadW实现始终无法正确获取到存储的令牌,想请各位帮忙排查下问题所在。

环境信息

  • Windows 11 操作系统
  • Microsoft Office 2019(64位版本)

可正常工作的凭据写入代码

我用以下代码成功将凭据写入Windows凭据管理器:

Private Declare PtrSafe Function CredWrite Lib "advapi32.dll" Alias "CredWriteW" (ByRef credential As CREDENTIALW, ByVal Flags As Long) As Long

Private Const CRED_TYPE_GENERIC = 1
Private Const TargetName = "JIRA_Excel_Integration"

Private Type CREDENTIALW
    Flags As Long
    Type As Long
    TargetName As LongPtr
    Comment As LongPtr
    LastWritten As Currency
    CredentialBlobSize As Long
    CredentialBlob As LongPtr
    Persist As Long
    AttributeCount As Long
    Attributes As LongPtr
    TargetAlias As LongPtr
    UserName As LongPtr
End Type

Sub SaveCredentials(ByVal email As String, ByVal token As String)
    Dim cred As CREDENTIALW
    
    If email = "" Or token = "" Then Exit Sub
    
    With cred
        .Type = CRED_TYPE_GENERIC
        .TargetName = StrPtr(TargetName)
        .CredentialBlobSize = LenB(token)
        .CredentialBlob = StrPtr(token)
        .UserName = StrPtr(email)
        .Persist = 2  ' CRED_PERSIST_LOCAL_MACHINE
        .Flags = 0
    End With
    
    If CredWrite(cred, 0) Then
        MsgBox "Credential saved.", vbInformation
    Else
        MsgBox "Error saving credential.", vbCritical
    End If
End Sub

存在问题的凭据读取代码

以下是我目前的读取凭据代码,CredReadW会返回True,但最终无法获取到令牌内容:

Private Declare PtrSafe Function CredRead Lib "advapi32.dll" Alias "CredReadW" (ByVal TargetName As String, ByVal CredType As Long, ByVal Flags As Long, ByVal CREDENTIAL As LongPtr) As Boolean
Private Declare PtrSafe Function lstrlen Lib "kernel32.dll" Alias "lstrlenW" (ByVal lpString As LongPtr) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)

Private Const CRED_TYPE_GENERIC = 1
Private Const TargetName = "JIRA_Excel_Integration"

Private Type CREDENTIALW
    Flags As Long
    Type As Long
    TargetName As LongPtr
    Comment As LongPtr
    LastWritten As Currency
    CredentialBlobSize As Long
    CredentialBlob As LongPtr
    Persist As Long
    AttributeCount As Long
    Attributes As LongPtr
    TargetAlias As LongPtr
    UserName As LongPtr
End Type

Function GetCredentials() As String
    Dim credPtr As LongPtr
    Dim cred As CREDENTIALW
    Dim TokenBytes() As Byte
    Dim token As String
    
    credPtr = VarPtr(cred)

    If CredRead(TargetName, CRED_TYPE_GENERIC, 0, credPtr) = 0 Then
        CopyMemory cred, ByVal credPtr, LenB(cred)
        
        If cred.CredentialBlobSize > 0 Then
            ReDim TokenBytes(cred.CredentialBlobSize - 1)
            CopyMemory TokenBytes(0), ByVal cred.CredentialBlob, cred.CredentialBlobSize
            token = StrConv(TokenBytes, vbUnicode)
        End If
        
        GetCredentials = token
    Else
        GetCredentials = ""
    End If
End Function

具体问题现象

  • 调用CredRead时返回值为True,直接进入了Else分支返回空字符串,完全没执行读取CredentialBlob的核心逻辑
  • 我尝试调整过CopyMemory的参数传递方式,但始终没解决问题
  • 已经确认TargetName和写入时的完全一致,凭据确实已经存储在Windows凭据管理器中

想请教各位,我的读取代码逻辑哪里出错了?应该如何修改才能正确读取到存储的PAT令牌?

火山引擎 最新活动