• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 301
  • Last Modified:

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.
0
usachrisk1983
Asked:
usachrisk1983
  • 21
  • 19
  • 2
  • +1
1 Solution
 
nffvrxqgrcfqvvcCommented:
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
0
 
nffvrxqgrcfqvvcCommented:
'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
0
 
usachrisk1983Author Commented:
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.
0
Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

 
nffvrxqgrcfqvvcCommented:
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
0
 
nffvrxqgrcfqvvcCommented:
Also before you compile did you go to project properties under the MAKE tab and put this as the title....

SCRNSAVE:DomainLock
0
 
usachrisk1983Author Commented:
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.
0
 
usachrisk1983Author Commented:
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?
0
 
nffvrxqgrcfqvvcCommented:
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?
0
 
usachrisk1983Author Commented:
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.
0
 
usachrisk1983Author Commented:
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
0
 
usachrisk1983Author Commented:
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
0
 
Shiju SasidharanCommented:
www.planet-source-code.com/vb/ scripts/ShowCode.asp?txtCodeId=162&lngWId=1
0
 
Shiju SasidharanCommented:
www.a1vbcode.com/ code.asp?type=screensavers&intPage=2
netscape.com.com/ Visual-Basic-Source-Code-Controls/3000-2229_4-10375670.html
0
 
usachrisk1983Author Commented:
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.
0
 
usachrisk1983Author Commented:
Guess I can't do 750, changed to 500.
0
 
nffvrxqgrcfqvvcCommented:
do you have any code in the Form_Click event?

If so remove it and try the SS
0
 
usachrisk1983Author Commented:
My Form Click is Empty.
0
 
nffvrxqgrcfqvvcCommented:
try disabling the timer see what happens..
0
 
usachrisk1983Author Commented:
Disabling the timer stopped the image from dancing around, but still had the same problem.
0
 
nffvrxqgrcfqvvcCommented:
Just trying to figure out why its happening...its not the timer than...

\try commenting everything in the keypress_event and check again.
0
 
usachrisk1983Author Commented:
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?
0
 
nffvrxqgrcfqvvcCommented:
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..
0
 
usachrisk1983Author Commented:
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?
0
 
usachrisk1983Author Commented:
Does anyone have anything?
0
 
nffvrxqgrcfqvvcCommented:
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.
0
 
usachrisk1983Author Commented:
I'd be happy to send it - how would you like me to get it to you?
0
 
nffvrxqgrcfqvvcCommented:
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
0
 
usachrisk1983Author Commented:
It has been sent, thanks for looking into this for me, egl :)
0
 
nffvrxqgrcfqvvcCommented:
I did not get it? did you send to the correct e-mail address?
0
 
usachrisk1983Author Commented:
I have confirmed it went out.  Did it maybe hit your junk folder or something?  I have resent.
0
 
usachrisk1983Author Commented:
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.
0
 
nffvrxqgrcfqvvcCommented:
you can send it to egl1044 at yahoo dot com try that
0
 
usachrisk1983Author Commented:
I sent a link to both GMail and Yahoo, did you get either one?
0
 
nffvrxqgrcfqvvcCommented:
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
0
 
nffvrxqgrcfqvvcCommented:
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
0
 
usachrisk1983Author Commented:
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?
0
 
nffvrxqgrcfqvvcCommented:
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.
0
 
usachrisk1983Author Commented:
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.
0
 
nffvrxqgrcfqvvcCommented:
wow
0
 
nffvrxqgrcfqvvcCommented:
You can ask in comunnity support to link this question to here or ask comunity support TA to close this question
0
 
usachrisk1983Author Commented:
egl, can I award an amount of points without considering the question answered?
0
 
nffvrxqgrcfqvvcCommented:
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.
0
 
moduloCommented:
PAQed with points refunded (500)

modulo
Community Support Moderator
0

Featured Post

Visualize your virtual and backup environments

Create well-organized and polished visualizations of your virtual and backup environments when planning VMware vSphere, Microsoft Hyper-V or Veeam deployments. It helps you to gain better visibility and valuable business insights.

  • 21
  • 19
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now