Hi all,
We are running a utility called DeviceLock that uses security to
enable/disable access to A: drive.
I am trying to write a utility that enables unprivledged users to have
access to A: drive. The problem is that anything I try to
do to format A: drive I get access denied when I am the unprivledged user.
Below is the latest attempt...

Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type

Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As Long

Private Declare Function CreateProcessAsUserA Lib "advapi32" (ByVal
lHandle As Long, ByVal _
lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As Long

'Security Stuff
Private Declare Function LogonUser Lib "advapi32.dll" Alias "LogonUserA"
(ByVal lpszUsername As String, ByVal lpszDomain As String, ByVal
lpszPassword As String, ByVal dwLogonType As Long, ByVal dwLogonProvider As
Long, phToken As Long) As Long
Private Declare Function ImpersonateLoggedOnUser Lib "advapi32.dll" (ByVal
hToken As Long) As Long
Private Declare Function RevertToSelf Lib "advapi32.dll" () As Long

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias
"GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As
Long

Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long

Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&

'Logon Constants
Const LOGON32_LOGON_INTERACTIVE = 2
Const LOGON32_LOGON_NETWORK = 3
Const LOGON32_LOGON_BATCH = 4
Const LOGON32_LOGON_SERVICE = 5

Const LOGON32_PROVIDER_DEFAULT = 0
Const LOGON32_PROVIDER_WINNT40 = 1

Public Function ExecCmd(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim lImpersonatorHandle As Long

' Initialize the STARTUPINFO structure:
start.lpDesktop = "winsta0\default"
start.cb = Len(start)

lImpersonatorHandle = Logon("privuser", "privpassword",
"LOCALDOMAIN")
' Start the shelled application:
ret& = CreateProcessAsUserA(lImpersonatorHandle, vbNullString,
cmdline$, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)

' Wait for the shelled application to finish:
ret& = WaitForSingleObject(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, ret&)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
ExecCmd = ret&
End Function

Sub Form_Click()
Dim rtn As String
Dim lRtn As Long
Dim buffer As String
Dim WinPath As String

buffer = String$(255, 0)
rtn = GetWindowsDirectory(buffer, Len(buffer))
WinPath = Left(Trim(buffer), rtn)

CurDir$
Dim retval As Long
retval = ExecCmd("command.com /c format a:")
'retval = ExecCmd("cmd.exe formata.bat")
'retval = ExecCmd(WinPath + "\system32\rundll32.exe
shell32.dll,SHFormatDrive")
'retval = ExecCmd("notepad.exe")
Logoff
MsgBox "Process Finished, Exit Code " & retval
End Sub

Public Function Logon(ByVal strAdminUser As String, ByVal _
strAdminPassword As String, ByVal strAdminDomain As String) As Long

Dim lngTokenHandle, lngLogonType, lngLogonProvider As Long
Dim blnResult As Boolean

lngLogonType = LOGON32_LOGON_INTERACTIVE
lngLogonProvider = LOGON32_PROVIDER_DEFAULT

blnResult = RevertToSelf()
#If DebugFlag Then
If blnResult = False Then
MsgBox "RevertToSelf() failed", , "Impersonate Errors"
End If
#End If


blnResult = LogonUser(strAdminUser, strAdminDomain, strAdminPassword, _
lngLogonType, lngLogonProvider, _
lngTokenHandle)
#If DebugFlag Then
If blnResult = False Then
MsgBox "LogonUser(...) failed", , "Impersonate Errors"
End If
#End If

blnResult = ImpersonateLoggedOnUser(lngTokenHandle)
#If DebugFlag Then
If blnResult = False Then
MsgBox "ImpersonateLoggedOnUser() failed", , "Impersonate Errors"
End If
#End If
Logon = lngTokenHandle
End Function


Public Sub Logoff()
Dim blnResult As Boolean

blnResult = RevertToSelf()
End Sub


I have tried several other flavors with no success.
'Will this work when we impersonate a user?
'rtn = Shell(WinPath + "\system32\rundll32.exe
shell32.dll,SHFormatDrive", 1)
lRtn = SHFormatDrive(frmParent.hwnd, SHFMT_DRIVE_A, SHFMT_ID_DEFAULT,
SHFMT_OPT_FULL)


Somewhere along the line the impersonation is lost when I try to format A:
drive.
Does anybody have any suggestions?

On a side note....
Is there a utility that can show current logged on users, with their
processes, and threads?
Process Viewer doesn't give enough information.
--
To respond remove "No.Spam.guard" from email
Thanks,
Gregory B. Brooks