Error 31 - Calling CredUIPromptForWindowsCredentialW from VBA macro

Question

I recently asked this question but deleted due to insufficient information. I will attempt to ask it again hopefully with more information.

I am trying to call the Win32 API function CredUIPromptForWindowsCredentialsW() but have been failing for the past two days.

I have also read a few posts, such as:

VBA: Unicode Strings and the Windows API

Data type conversions for API calls from Visual Basic

How to convert Windows API declarations in VBA for 64-bit

My code at the end is how I think all of the parameters should be defined for the call, however this returns error code 31:

ERROR_GEN_FAILURE

31 (0x1F)

A device attached to the system is not functioning.

Public Declare PtrSafe Function CredUIPromptForWindowsCredentials Lib "credui" Alias "CredUIPromptForWindowsCredentialsW" ( _
ByRef pUiInfo As CREDUI_INFO, _
ByVal dwAuthError As LongPtr, _
ByRef pulAuthPackage As LongPtr, _
ByVal pvInAuthBuffer As Long, _
ByRef ulInAuthBufferSize As LongPtr, _
ByVal ppvOutAuthBuffer As Long, _
ByRef pulOutAuthBufferSize As LongPtr, _
ByVal iSave As Long, _
ByVal dwFlags As Long) _
As Long

Public Declare PtrSafe Function CredUnPackAuthenticationBuffer Lib "credui" Alias "CredUnPackAuthenticationBufferW" ( _
ByRef dwFlags As LongPtr, _
ByRef pAuthBuffer As LongPtr, _
ByRef cbAuthBuffer As LongPtr, _
ByRef pszUserName As LongPtr, _
ByRef pcchMaxUserName As LongPtr, _
ByRef pszDomainName As LongPtr, _
ByRef pcchMaxDomainName As LongPtr, _
ByRef pszPassword As LongPtr, _
ByRef pcchMaxPassword As LongPtr) _
As LongPtr

Public Enum CREDUI_FLAGS
            INCORRECT_PASSWORD = &H1
            DO_NOT_PERSIST = &H2
            REQUEST_ADMINISTRATOR = &H4
            EXCLUDE_CERTIFICATES = &H8
            REQUIRE_CERTIFICATE = &H10
            SHOW_SAVE_CHECK_BOX = &H40
            ALWAYS_SHOW_UI = &H80
            REQUIRE_SMARTCARD = &H100
            PASSWORD_ONLY_OK = &H200
            VALIDATE_USERNAME = &H400
            COMPLETE_USERNAME = &H800
            PERSIST = &H1000
            SERVER_CREDENTIAL = &H4000
            EXPECT_CONFIRMATION = &H20000
            GENERIC_CREDENTIALS = &H40000
            USERNAME_TARGET_CREDENTIALS = &H80000
            KEEP_USERNAME = &H100000
End Enum

Private Const BUFFER_SIZE As Integer = &H100
Private Const ERROR_CANCELLED As Integer = &H4C7
Private Const CREDUIWIN_GENERIC As Integer = &H1
Private Const CREDUIWIN_CHECKBOX As Integer = &H2
Private Const CREDUIWIN_ENUMERATE_CURRENT_USER As Integer = &H200
Private Const CREDUIWIN_IN_CRED_ONLY As Integer = &H20
Private Const CREDUIWIN_AUTHPACKAGE_ONLY As Integer = &H10
Private Const CREDUIWIN_ENUMERATE_ADMINS As Integer = &H100
Private Const CRED_PACK_PROTECTED_CREDENTIALS As Integer = &H1
Private Const CRED_PACK_GENERIC_CREDENTIALS As Integer = &H4
Private Const MAX_USER_NAME As Integer = 100
Private Const MAX_PASSWORD As Integer = 100
Private Const MAX_DOMAIN As Integer = 100

Public Type CREDUI_INFO
    cbSize As Long
    hwndParent As Long
    pszMessageText As LongPtr
    pszCaptionText As LongPtr
    hbmBanner As Long
End Type

Public Function GetCredentials()

    Dim pUiInfo As CREDUI_INFO

    Dim pulAuthPackage As LongPtr
    Dim iSave As Long
    Dim result As Long
    Dim dwFlags As Long
    Dim ulInAuthBufferSize As LongPtr
    Dim pulOutAuthBufferSize As LongPtr
    Dim pvInAuthBuffer As Long
    Dim ppvOutAuthBuffer As Long

    pUiInfo.cbSize = LenB(pUiInfo)
    pUiInfo.hwndParent = 0
    pUiInfo.pszMessageText = StrPtr("message")
    pUiInfo.pszCaptionText = StrPtr("title")

    pulAuthPackage = 0
    iSave = 0
    dwFlags = CREDUIWIN_CHECKBOX + CREDUIWIN_ENUMERATE_CURRENT_USER + CREDUIWIN_ENUMERATE_ADMINS
    ppvOutAuthBuffer = 0
    pvInAuthBuffer = 0
    ulInAuthBufferSize = 0
    pulOutAuthBufferSize = 0

    result = CredUIPromptForWindowsCredentials( _
    pUiInfo, _
    0, _
    authPackage, _
    pvInAuthBuffer, _
    ulInAuthBufferSize, _
    ppvOutAuthBuffer, _
    pulOutAuthBufferSize, _
    iSave, _
    dwFlags)

    MsgBox result

End Function

EDIT: This code now returns 31 error code, with thanks to the comment section for pointing out some changes in my declarations. It no longer crashes word, but the Error 31 is what I receive now.

like this? "ByRef ulInAuthBufferSize As LongPtr, _" - "Dim ulInAuthBufferSize As LongPtr" - "ulInAuthBufferSize = 0" ? — m57, Apr 02 '19 at 17:02
Made some edits regarding the ULONG specification as per @Anders response and this stops the word process crashing, now presented with my previous error 31 code. — m57, Apr 02 '19 at 17:31
You still have some wrong Long vs LongPtr in some places. Does this code run as 32 or 64-bit? — Anders, Apr 02 '19 at 18:03
Ideally I want to get it working first and then use compiler statements to work on both architectures. Currently this is x64 windows on x64 office. I had some Long and LongPtr because I thought I read online that theres no difference and it will be treated as either when compiled ? Its referenced in the last link in my post — m57, Apr 02 '19 at 18:32
Long is 4 bytes, LongPtr is 4 or 8. Your hwndParent needs to be LongPtr etc. Getting it to work in 32-bit Office first is better, everything after that is Long vs LongPtr bugs for the most part. — Anders, Apr 02 '19 at 18:37
I literally finished eating, came to my PC, changed HWND to LongPtr and it worked. Thanks a lot Anders Ill post the final code. — m57, Apr 02 '19 at 19:05

score 0 · Answer 1 · answered Apr 02 '19 at 19:06

'
' CREDUIAPI DWORD CredUIPromptForWindowsCredentialsW(
'  PCREDUI_INFOW pUiInfo,_
'  DWORD         dwAuthError,
'  ULONG         *pulAuthPackage,
'  LPCVOID       pvInAuthBuffer,
'  ULONG         ulInAuthBufferSize,
'  LPVOID        *ppvOutAuthBuffer,
'  ULONG         *pulOutAuthBufferSize,
'  BOOL          *pfSave,
'  DWORD dwFlags
');
'
Public Declare PtrSafe Function CredUIPromptForWindowsCredentials Lib "credui" Alias "CredUIPromptForWindowsCredentialsW" ( _
ByRef pUiInfo As CREDUI_INFO, _
ByVal dwAuthError As Long, _
ByRef pulAuthPackage As LongPtr, _
ByVal pvInAuthBuffer As Any, _
ByVal ulInAuthBufferSize As Long, _
ByRef ppvOutAuthBuffer As Any, _
pulOutAuthBufferSize As LongPtr, _
ByRef iSave As Long, _
ByVal dwFlags As Long) _
As Long

Public Declare PtrSafe Function CredUnPackAuthenticationBuffer Lib "credui" Alias "CredUnPackAuthenticationBufferW" ( _
ByRef dwFlags As LongPtr, _
ByRef pAuthBuffer As LongPtr, _
ByRef cbAuthBuffer As LongPtr, _
ByRef pszUserName As LongPtr, _
ByRef pcchMaxUserName As LongPtr, _
ByRef pszDomainName As LongPtr, _
ByRef pcchMaxDomainName As LongPtr, _
ByRef pszPassword As LongPtr, _
ByRef pcchMaxPassword As LongPtr) _
As LongPtr

Public Enum CREDUI_FLAGS
            INCORRECT_PASSWORD = &H1
            DO_NOT_PERSIST = &H2
            REQUEST_ADMINISTRATOR = &H4
            EXCLUDE_CERTIFICATES = &H8
            REQUIRE_CERTIFICATE = &H10
            SHOW_SAVE_CHECK_BOX = &H40
            ALWAYS_SHOW_UI = &H80
            REQUIRE_SMARTCARD = &H100
            PASSWORD_ONLY_OK = &H200
            VALIDATE_USERNAME = &H400
            COMPLETE_USERNAME = &H800
            PERSIST = &H1000
            SERVER_CREDENTIAL = &H4000
            EXPECT_CONFIRMATION = &H20000
            GENERIC_CREDENTIALS = &H40000
            USERNAME_TARGET_CREDENTIALS = &H80000
            KEEP_USERNAME = &H100000
End Enum

Private Const BUFFER_SIZE As Integer = &H100
Private Const ERROR_CANCELLED As Integer = &H4C7
Private Const CREDUIWIN_GENERIC As Integer = &H1
Private Const CREDUIWIN_CHECKBOX As Integer = &H2
Private Const CREDUIWIN_ENUMERATE_CURRENT_USER As Integer = &H200
Private Const CREDUIWIN_IN_CRED_ONLY As Integer = &H20
Private Const CREDUIWIN_AUTHPACKAGE_ONLY As Integer = &H10
Private Const CREDUIWIN_ENUMERATE_ADMINS As Integer = &H100
Private Const CRED_PACK_PROTECTED_CREDENTIALS As Integer = &H1
Private Const CRED_PACK_GENERIC_CREDENTIALS As Integer = &H4
Private Const MAX_USER_NAME As Integer = 100
Private Const MAX_PASSWORD As Integer = 100
Private Const MAX_DOMAIN As Integer = 100

'typedef struct _CREDUI_INFOA {
'  DWORD   cbSize;
'  HWND    hwndParent;
'  PCSTR   pszMessageText;
'  PCSTR   pszCaptionText;
'  HBITMAP hbmBanner;
'} CREDUI_INFOA, *PCREDUI_INFOA;
Public Type CREDUI_INFO
    cbSize As Long
    hwndParent As LongPtr
    pszMessageText As LongPtr
    pszCaptionText As LongPtr
    hbmBanner As Long
End Type

Public Function GetCredentials()

    Dim pUiInfo As CREDUI_INFO

    Dim pulAuthPackage As LongPtr
    Dim iSave As Long
    Dim result As Long
    Dim dwFlags As Long
    Dim ulInAuthBufferSize As Long
    Dim pulOutAuthBufferSize As LongPtr
    Dim pvInAuthBuffer As LongPtr
    Dim ppvOutAuthBuffer As LongPtr

    pUiInfo.cbSize = LenB(pUiInfo)
    pUiInfo.hwndParent = 0
    pUiInfo.pszMessageText = StrPtr("message")
    pUiInfo.pszCaptionText = StrPtr("title")

    pulAuthPackage = 0
    iSave = 0
    dwFlags = CREDUIWIN_CHECKBOX + CREDUIWIN_ENUMERATE_CURRENT_USER + CREDUIWIN_ENUMERATE_ADMINS

    ppvOutAuthBuffer = 0
    pvInAuthBuffer = 0

    ulInAuthBufferSize = 0
    pulOutAuthBufferSize = 0

    result = CredUIPromptForWindowsCredentials( _
    pUiInfo, _
    0, _
    authPackage, _
    pvInAuthBuffer, _
    ulInAuthBufferSize, _
    ppvOutAuthBuffer, _
    pulOutAuthBufferSize, _
    iSave, _
    dwFlags)

    MsgBox result

End Function

Thanks to Anders I got it working now with the final change being HWND set to a LongPtr, Finished code above.

hey, realise this is fairly old, but any chance you could share your call to CredUnPackAuthenticationBuffer? — Jay, Oct 23 '20 at 17:05

Error 31 - Calling CredUIPromptForWindowsCredentialW from VBA macro

1 Answers1

Linked