Start Free Trial

asked on

Building a Screen Saver in Visual Basic

I know this has been asked over and over and over again, but I'm building a screen saver in VB6. The purpose is to authenticate against a domain controller instead of asking for a common shared password. I have all the code necessary for authentication, and the design work, etc. When I run it in design mode, it runs perfectly. When I run the executable, it runs perfectly.

However, when I rename it to an .src file, put it in the correct folder, and select it as the default SS, it doesn't work. What happens instead is that after the desired idle time has expired, it launches in somewhat of a minimized state. That is to say, not on the task bar, but instead inside of the desktop window, but minimized. Clicking the grey titleless bar that appears launches it in full scren mode.

The property of both forms in the project are listed as maximized.

nffvrxqgrcfqvvc

Set the border property to none, and disable all clip controls
Make sure you use setwindowpos api to make it the topmost window

Private Sub Form_Load()

if app.previnstance=true then
end
end if

Form1.Visible = True
Form1.Enabled = True
Form1.WindowState = vbMaximized
App.TaskVisible = False

End Sub

nffvrxqgrcfqvvc

'I think instead of maximizing the window it would be best to resize the form to the screens height and width instead..

'Also make sure you set the property StartUpPosition = CenterScreen

then try this..

Private Sub Form_Load()
Form1.Visible = True
Form1.Enabled = True
App.TaskVisible = False
Form1.Height = Screen.Height + 250
Form1.Width = Screen.Width + 250

End Sub

ASKER

Most of your suggestions I did by default to make it look more screen saver like, but unfortunately the ones that I didn't have didn't help. Rereading the original post, I need to make one update that may help --- although the grey titlebar is in the desktop area, there is no desktop - it's a black background. I have one picture on the background that jumps around, and that's what doesn't happen until I click the titlebar.

This is my form_load module:

bInitialized = False
If App.PrevInstance = True Then End
Dim strCmdLine As String
strCmdLine = LCase(Left(Command, 2))
'MsgBox strCmdLine
If strCmdLine = "/p" Then End
Dim X As Integer ' Declare variable
AlwaysOnTop Me, True ' Cover everything Else on screen
Randomize Timer
picSS.Visible = True
tmrMovePic.Enabled = True
X = ShowCursor(False)
LockDownSystem (True)
MouseCount = 0
bInitialized = True

If you need to see any of my functions, other form information, etc, please let me know.

nffvrxqgrcfqvvc

have you tried setting scalemode property to pixels...
have you tried setting autoredraw property to true
make sure you forms caption is set to nothing

BorderStyle: None
Caption: ""
ControlBox: False
Icon: None
ShowInTaskBar: False
WindowState: Maximized

nffvrxqgrcfqvvc

Also before you compile did you go to project properties under the MAKE tab and put this as the title....

SCRNSAVE:DomainLock

ASKER

Scalemode was Twip, changed to pixel on both the form and the image.
Confirmed Caption is Blank
Confirmed ControlBox is Off
Confirmed ShowInTaskbar is False
Confirmed WindowStat is Maximized

Icon doesn't say "NONE", it says "(ICON)", but I didn't specifically define any icon at any time.

Same issue.

ASKER

Yes, I have SCRNSAVE:DomainLock ... however when it shows up in the Screen Saver drop down, it's listed as just "auth". The name of the file is ssauth.scr. I've recompiled (overwriting existing) as well as deleting from c:\winnt and recreating, but same thing lists, does this hint at the problem?

nffvrxqgrcfqvvc

Let me just understand what exatlcy the problem is?

everything is fine with the screenaver...and execution its just that the picture's don't start moving around until you click the form?

ASKER

Nothing works until I click that titlebox - the picture doesn't start moving, the screen saver doesn't end on mouseclick/keypress, etc. To try and troubleshoot, I changed the background of my main SS form to pink. When I run it, the background is still black ... until I click the titlebar, at which time the screen goes pink.

ASKER

Maybe posting my code will help?

I have two forms, the first form is frmMainSS:
-------------------------------------------------------------------------
Dim bInitialized As Boolean
Dim iLastMouseX As Integer
Dim iLastMouseY As Integer

Dim MouseCount As Integer

Private Sub Form_KeyPress(KeyAscii As Integer)

If bInitialized = False Then Exit Sub
X = ShowCursor(True)
Unload Me
frmAuthenticate.Show

End Sub

Private Sub Form_Load()

bInitialized = False
If App.PrevInstance = True Then End
Dim strCmdLine As String
strCmdLine = LCase(Left(Command, 2))
'MsgBox strCmdLine
If strCmdLine = "/p" Then End
'If strCmdLine = "/s" Then MsgBox "There are no settings for this screen saver.", vbOKOnly + vbInformation, "Screen Saver"
Dim X As Integer ' Declare variable
AlwaysOnTop Me, True ' Cover everything Else on screen
Randomize Timer
picMainLogo.Visible = True
tmrMovePic.Enabled = True
X = ShowCursor(False)
LockDownSystem (True)
MouseCount = 0
Me.Height = Screen.Height + 250
Me.Width = Screen.Width + 250
bInitialized = True

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If bInitialized = False Then Exit Sub

If iLastMouseX <> X Or iLastMouseY <> Y Then
MouseCount = MouseCount + 1
iLastMouseX = X
iLastMouseY = Y
End If

If MouseCount = 3 Then
Unload Me
frmAuthenticate.Show
End If

End Sub

Private Sub picMainLogo_KeyPress(KeyAscii As Integer)
Call Form_KeyPress(KeyAscii)
End Sub

Private Sub tmrMovePic_Timer()

iMaxLeft = frmMainSS.Width - picMainLogo.Width - 35
iMaxHeight = frmMainSS.Height - picMainLogo.Height - 35

picMainLogo.Left = Int(Rnd * iMaxLeft) + 10
picMainLogo.Top = Int(Rnd * iMaxHeight) + 10

End Sub

The second form is frmAuthenticate
-------------------------------------------------------------------------
Dim IdleCount As Integer

Private Sub cmdUnLock_Click()

Dim bAuthUser As Boolean

If txtUserName.Visible = True Then
bAuthUser = SSPValidateUser(txtUserName.Text, "CORP", txtPassword.Text)
If txtPassword.Text = "" Or (txtUserName.Visible = True And txtUserName.Text = "") Then bAuthUser = False
End If

If bAuthUser = True Then
LockDownSystem (False)
Unload Me
End
Else
txtUserName.Text = ""
txtPassword.Text = ""
lblInvalidPassword.Visible = True
tmrPassword.Enabled = True
If txtUserName.Visible = True Then
txtUserName.SetFocus
Else
txtPassword.SetFocus
End If
End If
End Sub

Private Sub cmdUnLock_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call ResetIdle
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
Call ResetIdle
End Sub

Private Sub Form_Load()

Dim X As Integer ' Declare variable
AlwaysOnTop Me, True ' Cover everything Else on screen
X = ShowCursor(True) ' Show MousePointer While running

frmAuth.Left = (Screen.Width - frmAuth.Width) / 2
frmAuth.Top = (Screen.Height - frmAuth.Height) / 2

Call ResetIdle

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call ResetIdle
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call ResetIdle
End Sub

Private Sub frmAuth_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call ResetIdle
End Sub

Private Sub lblInvalidPassword_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call ResetIdle
End Sub

Private Sub lblPassword_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call ResetIdle
End Sub

Private Sub lblUserName_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call ResetIdle
End Sub

Private Sub picLogo_KeyPress(KeyAscii As Integer)
Call ResetIdle
End Sub

Private Sub picLogo_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call ResetIdle
End Sub

Private Sub tmrIdle_Timer()
IdleCount = IdleCount + 1
lbltmp.Caption = IdleCount
If IdleCount > 30 Then
Load frmMainSS
Unload frmAuthenticate
frmMainSS.Show
frmAuthenticate.Hide
End If
End Sub

Private Sub tmrPassword_Timer()
lblInvalidPassword.Visible = False
tmrPassword.Enabled = False
lblInvalidPassword = "Invalid Username / Password Entered"
End Sub

Private Sub ResetIdle()
IdleCount = 0
End Sub

Private Sub txtPassword_KeyPress(KeyAscii As Integer)
Call ResetIdle
End Sub

Private Sub txtPassword_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call ResetIdle
End Sub

Private Sub txtUserName_KeyPress(KeyAscii As Integer)
Call ResetIdle
End Sub

Private Sub txtUserName_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call ResetIdle
End Sub

Then I have a module, MiscModule:
-------------------------------------------------------------------------
Public Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Private Declare Function Desktop_Show_Hide Lib "WinLockDll.dll" (ByVal bShowHide As Boolean) As Integer
Private Declare Function StartButton_Show_Hide Lib "WinLockDll.dll" (ByVal bShowHide As Boolean) As Integer
Private Declare Function Taskbar_Show_Hide Lib "WinLockDll.dll" (ByVal bShowHide As Boolean) As Integer
Private Declare Function Keys_Enable_Disable Lib "WinLockDll.dll" (ByVal bEnableDisable As Boolean) As Integer
Private Declare Function AltTab1_Enable_Disable Lib "WinLockDll.dll" (ByVal bEnableDisable As Boolean) As Integer
Private Declare Function AltTab2_Enable_Disable Lib "WinLockDll.dll" (ByVal hWnd As Long, ByVal bEnableDisable As Boolean) As Integer
Private Declare Function TaskSwitching_Enable_Disable Lib "WinLockDll.dll" (ByVal bEnableDisable As Boolean) As Integer
Private Declare Function TaskManager_Enable_Disable Lib "WinLockDll.dll" (ByVal bEnableDisable As Boolean) As Integer
Public Declare Function CtrlAltDel_Enable_Disable Lib "WinLockDll.dll" (ByVal bEnableDisable As Boolean) As Integer
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Public Sub AlwaysOnTop(FrmID As Form, OnTop As Integer)
Exit Sub
Const SWP_NOMOVE = 2
Const SWP_NOSIZE = 1
Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2

If OnTop Then
OnTop = SetWindowPos(FrmID.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
Else
OnTop = SetWindowPos(FrmID.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
End If

End Sub

Public Sub LockDownSystem(LockDown As Boolean)

If LockDown = True Then
Desktop_Show_Hide (False)
StartButton_Show_Hide (False)
Taskbar_Show_Hide (False)
Keys_Enable_Disable (False)
AltTab1_Enable_Disable (False)
AltTab2_Enable_Disable 0, False
TaskSwitching_Enable_Disable (False)
TaskManager_Enable_Disable (False)
CtrlAltDel_Enable_Disable (False)
Else
Desktop_Show_Hide (True)
StartButton_Show_Hide (True)
Taskbar_Show_Hide (True)
Keys_Enable_Disable (True)
AltTab1_Enable_Disable (True)
AltTab2_Enable_Disable 0, True
TaskSwitching_Enable_Disable (True)
TaskManager_Enable_Disable (True)
CtrlAltDel_Enable_Disable (True)
X = ShowCursor(True)
End If

End Sub

ASKER

Oh yeah, one more module, SSPLOGON.BAS:
-----------------------------------------------------------------------
Option Explicit

Private Const HEAP_ZERO_MEMORY = &H8

Private Const SEC_WINNT_AUTH_IDENTITY_ANSI = &H1

Private Const SECBUFFER_TOKEN = &H2

Private Const SECURITY_NATIVE_DREP = &H10

Private Const SECPKG_CRED_INBOUND = &H1
Private Const SECPKG_CRED_OUTBOUND = &H2

Private Const SEC_I_CONTINUE_NEEDED = &H90312
Private Const SEC_I_COMPLETE_NEEDED = &H90313
Private Const SEC_I_COMPLETE_AND_CONTINUE = &H90314

Private Const VER_PLATFORM_WIN32_NT = &H2

Type SecPkgInfo
fCapabilities As Long
wVersion As Integer
wRPCID As Integer
cbMaxToken As Long
Name As Long
Comment As Long
End Type

Type SecHandle
dwLower As Long
dwUpper As Long
End Type

Type AUTH_SEQ
fInitialized As Boolean
fHaveCredHandle As Boolean
fHaveCtxtHandle As Boolean
hcred As SecHandle
hctxt As SecHandle
End Type

Type SEC_WINNT_AUTH_IDENTITY
User As String
UserLength As Long
Domain As String
DomainLength As Long
Password As String
PasswordLength As Long
FLAGS As Long
End Type

Type TimeStamp
LowPart As Long
HighPart As Long
End Type

Type SecBuffer
cbBuffer As Long
BufferType As Long
pvBuffer As Long
End Type

Type SecBufferDesc
ulVersion As Long
cBuffers As Long
pBuffers As Long
End Type

Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function NT4QuerySecurityPackageInfo Lib "security" _
Alias "QuerySecurityPackageInfoA" (ByVal PackageName As String, _
ByRef pPackageInfo As Long) As Long

Private Declare Function QuerySecurityPackageInfo Lib "secur32" _
Alias "QuerySecurityPackageInfoA" (ByVal PackageName As String, _
ByRef pPackageInfo As Long) As Long

Private Declare Function NT4FreeContextBuffer Lib "security" _
Alias "FreeContextBuffer" (ByVal pvContextBuffer As Long) As Long

Private Declare Function FreeContextBuffer Lib "secur32" _
(ByVal pvContextBuffer As Long) As Long

Private Declare Function NT4InitializeSecurityContext Lib "security" _
Alias "InitializeSecurityContextA" _
(ByRef phCredential As SecHandle, ByRef phContext As SecHandle, _
ByVal pszTargetName As Long, ByVal fContextReq As Long, _
ByVal Reserved1 As Long, ByVal TargetDataRep As Long, _
ByRef pInput As SecBufferDesc, ByVal Reserved2 As Long, _
ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, _
ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long

Private Declare Function InitializeSecurityContext Lib "secur32" _
Alias "InitializeSecurityContextA" _
(ByRef phCredential As SecHandle, ByRef phContext As SecHandle, _
ByVal pszTargetName As Long, ByVal fContextReq As Long, _
ByVal Reserved1 As Long, ByVal TargetDataRep As Long, _
ByRef pInput As SecBufferDesc, ByVal Reserved2 As Long, _
ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, _
ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long

Private Declare Function NT4InitializeSecurityContext2 Lib "security" _
Alias "InitializeSecurityContextA" _
(ByRef phCredential As SecHandle, ByVal phContext As Long, _
ByVal pszTargetName As Long, ByVal fContextReq As Long, _
ByVal Reserved1 As Long, ByVal TargetDataRep As Long, _
ByVal pInput As Long, ByVal Reserved2 As Long, _
ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, _
ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long

Private Declare Function InitializeSecurityContext2 Lib "secur32" _
Alias "InitializeSecurityContextA" _
(ByRef phCredential As SecHandle, ByVal phContext As Long, _
ByVal pszTargetName As Long, ByVal fContextReq As Long, _
ByVal Reserved1 As Long, ByVal TargetDataRep As Long, _
ByVal pInput As Long, ByVal Reserved2 As Long, _
ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, _
ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long

Private Declare Function NT4AcquireCredentialsHandle Lib "security" _
Alias "AcquireCredentialsHandleA" (ByVal pszPrincipal As Long, _
ByVal pszPackage As String, ByVal fCredentialUse As Long, _
ByVal pvLogonId As Long, _
ByRef pAuthData As SEC_WINNT_AUTH_IDENTITY, _
ByVal pGetKeyFn As Long, ByVal pvGetKeyArgument As Long, _
ByRef phCredential As SecHandle, ByRef ptsExpiry As TimeStamp) _
As Long

Private Declare Function AcquireCredentialsHandle Lib "secur32" _
Alias "AcquireCredentialsHandleA" (ByVal pszPrincipal As Long, _
ByVal pszPackage As String, ByVal fCredentialUse As Long, _
ByVal pvLogonId As Long, _
ByRef pAuthData As SEC_WINNT_AUTH_IDENTITY, _
ByVal pGetKeyFn As Long, ByVal pvGetKeyArgument As Long, _
ByRef phCredential As SecHandle, ByRef ptsExpiry As TimeStamp) _
As Long

Private Declare Function NT4AcquireCredentialsHandle2 Lib "security" _
Alias "AcquireCredentialsHandleA" (ByVal pszPrincipal As Long, _
ByVal pszPackage As String, ByVal fCredentialUse As Long, _
ByVal pvLogonId As Long, ByVal pAuthData As Long, _
ByVal pGetKeyFn As Long, ByVal pvGetKeyArgument As Long, _
ByRef phCredential As SecHandle, ByRef ptsExpiry As TimeStamp) _
As Long

Private Declare Function AcquireCredentialsHandle2 Lib "secur32" _
Alias "AcquireCredentialsHandleA" (ByVal pszPrincipal As Long, _
ByVal pszPackage As String, ByVal fCredentialUse As Long, _
ByVal pvLogonId As Long, ByVal pAuthData As Long, _
ByVal pGetKeyFn As Long, ByVal pvGetKeyArgument As Long, _
ByRef phCredential As SecHandle, ByRef ptsExpiry As TimeStamp) _
As Long

Private Declare Function NT4AcceptSecurityContext Lib "security" _
Alias "AcceptSecurityContext" (ByRef phCredential As SecHandle, _
ByRef phContext As SecHandle, ByRef pInput As SecBufferDesc, _
ByVal fContextReq As Long, ByVal TargetDataRep As Long, _
ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, _
ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long

Private Declare Function AcceptSecurityContext Lib "secur32" _
(ByRef phCredential As SecHandle, _
ByRef phContext As SecHandle, ByRef pInput As SecBufferDesc, _
ByVal fContextReq As Long, ByVal TargetDataRep As Long, _
ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, _
ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long

Private Declare Function NT4AcceptSecurityContext2 Lib "security" _
Alias "AcceptSecurityContext" (ByRef phCredential As SecHandle, _
ByVal phContext As Long, ByRef pInput As SecBufferDesc, _
ByVal fContextReq As Long, ByVal TargetDataRep As Long, _
ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, _
ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long

Private Declare Function AcceptSecurityContext2 Lib "secur32" _
Alias "AcceptSecurityContext" (ByRef phCredential As SecHandle, _
ByVal phContext As Long, ByRef pInput As SecBufferDesc, _
ByVal fContextReq As Long, ByVal TargetDataRep As Long, _
ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, _
ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long

Private Declare Function NT4CompleteAuthToken Lib "security" _
Alias "CompleteAuthToken" (ByRef phContext As SecHandle, _
ByRef pToken As SecBufferDesc) As Long

Private Declare Function CompleteAuthToken Lib "secur32" _
(ByRef phContext As SecHandle, _
ByRef pToken As SecBufferDesc) As Long

Private Declare Function NT4DeleteSecurityContext Lib "security" _
Alias "DeleteSecurityContext" (ByRef phContext As SecHandle) _
As Long

Private Declare Function DeleteSecurityContext Lib "secur32" _
(ByRef phContext As SecHandle) _
As Long

Private Declare Function NT4FreeCredentialsHandle Lib "security" _
Alias "FreeCredentialsHandle" (ByRef phContext As SecHandle) _
As Long

Private Declare Function FreeCredentialsHandle Lib "secur32" _
(ByRef phContext As SecHandle) _
As Long

Private Declare Function GetProcessHeap Lib "kernel32" () As Long

Private Declare Function HeapAlloc Lib "kernel32" _
(ByVal hHeap As Long, ByVal dwFlags As Long, _
ByVal dwBytes As Long) As Long

Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, _
ByVal dwFlags As Long, ByVal lpMem As Long) As Long

Private Declare Function GetVersionExA Lib "kernel32" _
(lpVersionInformation As OSVERSIONINFO) As Integer

Dim g_NT4 As Boolean

Private Function GenClientContext(ByRef AuthSeq As AUTH_SEQ, _
ByRef AuthIdentity As SEC_WINNT_AUTH_IDENTITY, _
ByVal pIn As Long, ByVal cbIn As Long, _
ByVal pOut As Long, ByRef cbOut As Long, _
ByRef fDone As Boolean) As Boolean

Dim ss As Long
Dim tsExpiry As TimeStamp
Dim sbdOut As SecBufferDesc
Dim sbOut As SecBuffer
Dim sbdIn As SecBufferDesc
Dim sbIn As SecBuffer
Dim fContextAttr As Long

GenClientContext = False

If Not AuthSeq.fInitialized Then

If g_NT4 Then
ss = NT4AcquireCredentialsHandle(0&, "NTLM", _
SECPKG_CRED_OUTBOUND, 0&, AuthIdentity, 0&, 0&, _
AuthSeq.hcred, tsExpiry)
Else
ss = AcquireCredentialsHandle(0&, "NTLM", _
SECPKG_CRED_OUTBOUND, 0&, AuthIdentity, 0&, 0&, _
AuthSeq.hcred, tsExpiry)
End If

If ss < 0 Then
Exit Function
End If

AuthSeq.fHaveCredHandle = True

End If

' Prepare output buffer
sbdOut.ulVersion = 0
sbdOut.cBuffers = 1
sbdOut.pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
Len(sbOut))

sbOut.cbBuffer = cbOut
sbOut.BufferType = SECBUFFER_TOKEN
sbOut.pvBuffer = pOut

CopyMemory ByVal sbdOut.pBuffers, sbOut, Len(sbOut)

' Prepare input buffer
If AuthSeq.fInitialized Then

sbdIn.ulVersion = 0
sbdIn.cBuffers = 1
sbdIn.pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
Len(sbIn))

sbIn.cbBuffer = cbIn
sbIn.BufferType = SECBUFFER_TOKEN
sbIn.pvBuffer = pIn

CopyMemory ByVal sbdIn.pBuffers, sbIn, Len(sbIn)

End If

If AuthSeq.fInitialized Then

If g_NT4 Then
ss = NT4InitializeSecurityContext(AuthSeq.hcred, _
AuthSeq.hctxt, 0&, 0, 0, SECURITY_NATIVE_DREP, sbdIn, _
0, AuthSeq.hctxt, sbdOut, fContextAttr, tsExpiry)
Else
ss = InitializeSecurityContext(AuthSeq.hcred, _
AuthSeq.hctxt, 0&, 0, 0, SECURITY_NATIVE_DREP, sbdIn, _
0, AuthSeq.hctxt, sbdOut, fContextAttr, tsExpiry)
End If

Else

If g_NT4 Then
ss = NT4InitializeSecurityContext2(AuthSeq.hcred, 0&, 0&, _
0, 0, SECURITY_NATIVE_DREP, 0&, 0, AuthSeq.hctxt, _
sbdOut, fContextAttr, tsExpiry)
Else
ss = InitializeSecurityContext2(AuthSeq.hcred, 0&, 0&, _
0, 0, SECURITY_NATIVE_DREP, 0&, 0, AuthSeq.hctxt, _
sbdOut, fContextAttr, tsExpiry)
End If

End If

If ss < 0 Then
GoTo FreeResourcesAndExit
End If

AuthSeq.fHaveCtxtHandle = True

' If necessary, complete token
If ss = SEC_I_COMPLETE_NEEDED _
Or ss = SEC_I_COMPLETE_AND_CONTINUE Then

If g_NT4 Then
ss = NT4CompleteAuthToken(AuthSeq.hctxt, sbdOut)
Else
ss = CompleteAuthToken(AuthSeq.hctxt, sbdOut)
End If

If ss < 0 Then
GoTo FreeResourcesAndExit
End If

End If

CopyMemory sbOut, ByVal sbdOut.pBuffers, Len(sbOut)
cbOut = sbOut.cbBuffer

If Not AuthSeq.fInitialized Then
AuthSeq.fInitialized = True
End If

fDone = Not (ss = SEC_I_CONTINUE_NEEDED _
Or ss = SEC_I_COMPLETE_AND_CONTINUE)

GenClientContext = True

FreeResourcesAndExit:

If sbdOut.pBuffers <> 0 Then
HeapFree GetProcessHeap(), 0, sbdOut.pBuffers
End If

If sbdIn.pBuffers <> 0 Then
HeapFree GetProcessHeap(), 0, sbdIn.pBuffers
End If

End Function

Private Function GenServerContext(ByRef AuthSeq As AUTH_SEQ, _
ByVal pIn As Long, ByVal cbIn As Long, _
ByVal pOut As Long, ByRef cbOut As Long, _
ByRef fDone As Boolean) As Boolean

Dim ss As Long
Dim tsExpiry As TimeStamp
Dim sbdOut As SecBufferDesc
Dim sbOut As SecBuffer
Dim sbdIn As SecBufferDesc
Dim sbIn As SecBuffer
Dim fContextAttr As Long

GenServerContext = False

If Not AuthSeq.fInitialized Then

If g_NT4 Then
ss = NT4AcquireCredentialsHandle2(0&, "NTLM", _
SECPKG_CRED_INBOUND, 0&, 0&, 0&, 0&, AuthSeq.hcred, _
tsExpiry)
Else
ss = AcquireCredentialsHandle2(0&, "NTLM", _
SECPKG_CRED_INBOUND, 0&, 0&, 0&, 0&, AuthSeq.hcred, _
tsExpiry)
End If

If ss < 0 Then
Exit Function
End If

AuthSeq.fHaveCredHandle = True

End If

' Prepare output buffer
sbdOut.ulVersion = 0
sbdOut.cBuffers = 1
sbdOut.pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
Len(sbOut))

sbOut.cbBuffer = cbOut
sbOut.BufferType = SECBUFFER_TOKEN
sbOut.pvBuffer = pOut

CopyMemory ByVal sbdOut.pBuffers, sbOut, Len(sbOut)

' Prepare input buffer
sbdIn.ulVersion = 0
sbdIn.cBuffers = 1
sbdIn.pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
Len(sbIn))

sbIn.cbBuffer = cbIn
sbIn.BufferType = SECBUFFER_TOKEN
sbIn.pvBuffer = pIn

CopyMemory ByVal sbdIn.pBuffers, sbIn, Len(sbIn)

If AuthSeq.fInitialized Then

If g_NT4 Then
ss = NT4AcceptSecurityContext(AuthSeq.hcred, AuthSeq.hctxt, _
sbdIn, 0, SECURITY_NATIVE_DREP, AuthSeq.hctxt, sbdOut, _
fContextAttr, tsExpiry)
Else
ss = AcceptSecurityContext(AuthSeq.hcred, AuthSeq.hctxt, _
sbdIn, 0, SECURITY_NATIVE_DREP, AuthSeq.hctxt, sbdOut, _
fContextAttr, tsExpiry)
End If

Else

If g_NT4 Then
ss = NT4AcceptSecurityContext2(AuthSeq.hcred, 0&, sbdIn, 0, _
SECURITY_NATIVE_DREP, AuthSeq.hctxt, sbdOut, _
fContextAttr, tsExpiry)
Else
ss = AcceptSecurityContext2(AuthSeq.hcred, 0&, sbdIn, 0, _
SECURITY_NATIVE_DREP, AuthSeq.hctxt, sbdOut, _
fContextAttr, tsExpiry)
End If

End If

If ss < 0 Then
GoTo FreeResourcesAndExit
End If

AuthSeq.fHaveCtxtHandle = True

' If necessary, complete token
If ss = SEC_I_COMPLETE_NEEDED _
Or ss = SEC_I_COMPLETE_AND_CONTINUE Then

If g_NT4 Then
ss = NT4CompleteAuthToken(AuthSeq.hctxt, sbdOut)
Else
ss = CompleteAuthToken(AuthSeq.hctxt, sbdOut)
End If

If ss < 0 Then
GoTo FreeResourcesAndExit
End If

End If

CopyMemory sbOut, ByVal sbdOut.pBuffers, Len(sbOut)
cbOut = sbOut.cbBuffer

If Not AuthSeq.fInitialized Then
AuthSeq.fInitialized = True
End If

fDone = Not (ss = SEC_I_CONTINUE_NEEDED _
Or ss = SEC_I_COMPLETE_AND_CONTINUE)

GenServerContext = True

FreeResourcesAndExit:

If sbdOut.pBuffers <> 0 Then
HeapFree GetProcessHeap(), 0, sbdOut.pBuffers
End If

If sbdIn.pBuffers <> 0 Then
HeapFree GetProcessHeap(), 0, sbdIn.pBuffers
End If

End Function

Public Function SSPValidateUser(User As String, Domain As String, _
Password As String) As Boolean

Dim pSPI As Long
Dim SPI As SecPkgInfo
Dim cbMaxToken As Long

Dim pClientBuf As Long
Dim pServerBuf As Long

Dim ai As SEC_WINNT_AUTH_IDENTITY

Dim asClient As AUTH_SEQ
Dim asServer As AUTH_SEQ
Dim cbIn As Long
Dim cbOut As Long
Dim fDone As Boolean

Dim osinfo As OSVERSIONINFO

SSPValidateUser = False

' Determine if system is Windows NT (version 4.0 or earlier)
osinfo.dwOSVersionInfoSize = Len(osinfo)
osinfo.szCSDVersion = Space$(128)
GetVersionExA osinfo
g_NT4 = (osinfo.dwPlatformId = VER_PLATFORM_WIN32_NT And _
osinfo.dwMajorVersion <= 4)

' Get max token size
If g_NT4 Then
NT4QuerySecurityPackageInfo "NTLM", pSPI
Else
QuerySecurityPackageInfo "NTLM", pSPI
End If

CopyMemory SPI, ByVal pSPI, Len(SPI)
cbMaxToken = SPI.cbMaxToken

If g_NT4 Then
NT4FreeContextBuffer pSPI
Else
FreeContextBuffer pSPI
End If

' Allocate buffers for client and server messages
pClientBuf = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
cbMaxToken)
If pClientBuf = 0 Then
GoTo FreeResourcesAndExit
End If

pServerBuf = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
cbMaxToken)
If pServerBuf = 0 Then
GoTo FreeResourcesAndExit
End If

' Initialize auth identity structure
ai.Domain = Domain
ai.DomainLength = Len(Domain)
ai.User = User
ai.UserLength = Len(User)
ai.Password = Password
ai.PasswordLength = Len(Password)
ai.FLAGS = SEC_WINNT_AUTH_IDENTITY_ANSI

' Prepare client message (negotiate) .
cbOut = cbMaxToken
If Not GenClientContext(asClient, ai, 0, 0, pClientBuf, cbOut, _
fDone) Then
GoTo FreeResourcesAndExit
End If

' Prepare server message (challenge) .
cbIn = cbOut
cbOut = cbMaxToken
If Not GenServerContext(asServer, pClientBuf, cbIn, pServerBuf, _
cbOut, fDone) Then
' Most likely failure: AcceptServerContext fails with
' SEC_E_LOGON_DENIED in the case of bad szUser or szPassword.
' Unexpected Result: Logon will succeed if you pass in a bad
' szUser and the guest account is enabled in the specified domain.
GoTo FreeResourcesAndExit
End If

' Prepare client message (authenticate) .
cbIn = cbOut
cbOut = cbMaxToken
If Not GenClientContext(asClient, ai, pServerBuf, cbIn, pClientBuf, _
cbOut, fDone) Then
GoTo FreeResourcesAndExit
End If

' Prepare server message (authentication) .
cbIn = cbOut
cbOut = cbMaxToken
If Not GenServerContext(asServer, pClientBuf, cbIn, pServerBuf, _
cbOut, fDone) Then
GoTo FreeResourcesAndExit
End If

SSPValidateUser = True

FreeResourcesAndExit:

' Clean up resources
If asClient.fHaveCtxtHandle Then
If g_NT4 Then
NT4DeleteSecurityContext asClient.hctxt
Else
DeleteSecurityContext asClient.hctxt
End If
End If

If asClient.fHaveCredHandle Then
If g_NT4 Then
NT4FreeCredentialsHandle asClient.hcred
Else
FreeCredentialsHandle asClient.hcred
End If
End If

If asServer.fHaveCtxtHandle Then
If g_NT4 Then
NT4DeleteSecurityContext asServer.hctxt
Else
DeleteSecurityContext asServer.hctxt
End If
End If

If asServer.fHaveCredHandle Then
If g_NT4 Then
NT4FreeCredentialsHandle asServer.hcred
Else
FreeCredentialsHandle asServer.hcred
End If
End If

If pClientBuf <> 0 Then
HeapFree GetProcessHeap(), 0, pClientBuf
End If

If pServerBuf <> 0 Then
HeapFree GetProcessHeap(), 0, pServerBuf
End If

End Function

www.planet-source-code.com/vb/ scripts/ShowCode.asp?txtCodeId=162&lngWId=1

www.a1vbcode.com/ code.asp?type=screensavers&intPage=2
netscape.com.com/ Visual-Basic-Source-Code-Controls/3000-2229_4-10375670.html

ASKER

Shijusn, thanks, I have downloaded a few of these, and it's how I got the beginner of what I needed for an SS before adding on to it. My problem is that I'm not sure what in my code is causing the problem.

Points uped to 750.

ASKER

Guess I can't do 750, changed to 500.

nffvrxqgrcfqvvc

do you have any code in the Form_Click event?

If so remove it and try the SS

ASKER

My Form Click is Empty.

nffvrxqgrcfqvvc

try disabling the timer see what happens..

ASKER

Disabling the timer stopped the image from dancing around, but still had the same problem.

nffvrxqgrcfqvvc

Just trying to figure out why its happening...its not the timer than...

\try commenting everything in the keypress_event and check again.

ASKER

What makes you think it's in keypress? Or are you eventually going to just have me comment every line of code until this stops happening?

nffvrxqgrcfqvvc

Well something is making it not work properly and the only way to figure out what the problem is, would be to narrow it down to a specific coding structure..

ASKER

I've changed the FORM_LOAD on my main form to basically just exit sub as soon as it loads and I've disabled all times. But it's still happening, so it's got to be a property of something, or the way it's being compiled. Here is my FORM_LOAD:

Private Sub Form_Load()
Dim strCmdLine As String
strCmdLine = LCase(Left(Command, 2))
If strCmdLine = "/p" Then End
Exit Sub
End Sub

Here are the details on my form:

AutoRedraw = -1 'True
BackColor = &H0080FFFF&
BorderStyle = 0 'None
ClientHeight = 4995
ClientLeft = 0
ClientTop = 0
ClientWidth = 7290
ClipControls = 0 'False
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 333
ScaleMode = 3 'Pixel
ScaleWidth = 486
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen

Any other suggestions?

ASKER

Does anyone have anything?

nffvrxqgrcfqvvc

If you send me the entire project I can test it to get a better idea what you mean, then I should be able to know whats wrong. But if thats not an option I wouldn't know how else to find the problem.

ASKER

I'd be happy to send it - how would you like me to get it to you?

nffvrxqgrcfqvvc

You can either post it on a website and give me the link, or send it to my e-mail : egl1044 AT gmail dot com

ASKER

It has been sent, thanks for looking into this for me, egl :)

nffvrxqgrcfqvvc

I did not get it? did you send to the correct e-mail address?

ASKER

I have confirmed it went out. Did it maybe hit your junk folder or something? I have resent.

ASKER

Sorry, just realized I got an email from Google that it didn't like that I attached a ZIP file. I will find another way to get it to you.

nffvrxqgrcfqvvc

you can send it to egl1044 at yahoo dot com try that

ASKER

I sent a link to both GMail and Yahoo, did you get either one?

nffvrxqgrcfqvvc

yes i got them, I downloaded it but I will have to look at it tomorrow morning I will get back to you a.s.a.p

nffvrxqgrcfqvvc

OK i took a look at the project however I had to start from scratch.

I created the basic layout of your entire project, all you need to do is add the domain lock code

Try this see if it works for you now.
good luck

http://www.geocities.com/egl1044/domain.html

ASKER

egl1044, thank you for your work. I tested it, and it worked as a screen saver... until the extra code from MS was added for domain authentication. Did you see anything in there that could cause what my problem is?

nffvrxqgrcfqvvc

I didn't really check any of the domain code because I was focusing on the screensaver aspect of the project, I am not sure if that has any conflicts with the screen saver.

ASKER

Alright, it's been nearly two and half months, I've given up. I appreciate everyone's time on this, but I guess there's just something in there that I'm never going to see. Mods, please delete/archive/retire, or however it works, this question.

nffvrxqgrcfqvvc

wow

nffvrxqgrcfqvvc

You can ask in comunnity support to link this question to here or ask comunity support TA to close this question

ASKER

egl, can I award an amount of points without considering the question answered?

nffvrxqgrcfqvvc

No you can't. You can post the question again but when you do link it to this question and make the question worth 20 points. When you do this it will expose the question to more experts. Most of the experts don't review questions that are a month old so If the question is new they will see it as a question that needs to be answered.

ASKER CERTIFIED SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial