DominoArea.org [Archive]

[syntax="ls"]Private Const wAPIModule = "NNOTES" ' Windows/32



Private Const EM_REG_BEFORE = 1

Private Const EM_GETPASSWORD = 73

Private Const ERR_BSAFE_EXTERNAL_PASSWORD = &H1700 + 97 ' &H1761

Private Const MAX_ID_PASSWORD = 64



Declare Private Function EMRegister Lib wAPIModule Alias "EMRegister" _

( Byval id As Integer, Byval F As Long, C As Long _

, Byval R As Long, hR As Long) As Integer

Declare Private Function EMDeregister Lib wAPIModule Alias "EMDeregister" _

( Byval hR As Long) As Integer



Declare Private Function OSMemoryAllocate Lib wAPIModule Alias "OSMemoryAllocate" _

( Byval T As Long, Byval S As Long, hM As Long) As Integer

Declare Private Sub OSMemoryFree Lib wAPIModule Alias "OSMemoryFree" _

( Byval hM As Long)

Declare Private Function OSMemoryLock Lib wAPIModule Alias "OSMemoryLock" _

( Byval hM As Long) As Long

Declare Private Function OSMemoryUnlock Lib wAPIModule Alias "OSMemoryUnlock" _

( Byval hM As Long) As Integer



Declare Private Sub Poke Lib "MSVCRT" Alias "memcpy" _

( Byval D As Long, S As Any, Byval N As Long)

Declare Private Sub PokeString Lib "MSVCRT" Alias "memcpy" _

( Byval D As Long, Byval S As Lmbcs String, Byval N As Long)

Declare Private Function Length Lib "MSVCRT" Alias "strlen" _

( Byval S As Lmbcs String) As Long



Class Assembler



Private hx As String



Public Sub New

End Sub



Public Sub Add(S As String)

hx = hx & S

End Sub



Public Sub AddLong(S As String, V As Variant)

Add S

h$ = Right$("0000000" & Hex$(V),

For i% = 7 To 1 Step -2

Add Mid$(h$, i%, 2)

Next

End Sub



Public Function CodeArray

n% = -Int(-Len(hx) / - 1

hx = hx & "90909090"

Redim A(n%) As Long

For i% = 0 To n%

x$ = ""

For j% = 1 To 4

x$ = Left$(hx, 2) & x$

hx = Mid$(hx, 3)

Next

A(i%) = Clng("&H" & x$)

Next

CodeArray = A

End Function

End Class





Sub Recertify(userid$, userpw$, certid$, certpw$, server$)

' setup...

Dim hM As Long

OSMemoryAllocate 0, MAX_ID_PASSWORD + 4, hM

p& = OSMemoryLock(hM)



Dim asm As New Assembler

With asm

' callback:

.Add "55" ' push ebp

.Add "8B6C2408" ' mov ebp, [esp+08h] ; EMRECORD

.Add "8B6D06" ' mov ebp, [ebp+06h] ; GetPassword args

.Add "57" ' push edi

.Add "56" ' push esi

.Add "51" ' push ecx

.Add "8B7D04" ' mov edi, [ebp+04h] ; password length

.AddLong "BE", p& ' mov esi, p&

.Add "8B0E" ' mov ecx, [esi]

.Add "890F" ' mov [edi], ecx

.Add "8B7D08" ' mov edi, [ebp+08h] ; password

.Add "83C604" ' add esi, byte 04h

.Add "F3A4" ' rep movsb

.Add "59" ' pop ecx

.Add "5E" ' pop esi

.Add "5F" ' pop edi

.Add "5D" ' pop ebp

.Add "B861170000" ' mov eax, ERR_BSAFE_EXTERNAL_PASSWORD

.Add "C20400" ' ret 0004h

End With



Dim callback As Variant

callback = asm.CodeArray



Dim hR As Long

EMRegister EM_GETPASSWORD, EM_REG_BEFORE, callback(0), 0, hR



' task...

n& = Length(userpw$)

Poke p&, n&, 4

PokeString p& + 4, userpw$, n&



Dim reg As New NotesRegistration

With reg

.RegistrationServer = server$

.CertifierIDFile = certid$

.Expiration = Today + 365

On Error Goto E

.ReCertify userid$, certpw$

On Error Goto 0

End With

Messagebox "OK", 64, "Recertify Demo"



X:

' cleanup...

EMDeregister hR

OSMemoryUnlock hM

OSMemoryFree hM



Exit Sub



E:

Messagebox Error(), 16, "Recertify Demo"

Resume X

End Sub[/syntax]