ACCPAC Password Lister (Excel VBA Module)

' 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

Reply to
By97fzqHryx0Xyyz3Q
Loading thread data ...

BeanSmart website is not affiliated with any of the manufacturers or service providers discussed here. All logos and trade names are the property of their respective owners.