upgrading an application from VB6 to VB.Net

[b][red]This message was edited by merc3065 at 2005-12-13 7:14:31[/red][/b][hr]
Finally my work decided to allow me to upgrade to VB.Net 2003 which is nice. However I am having issues locating a similar process that creates processes or runs external programs as other users. I used a function in my vb6 app called W2KCreateProcessAsUser

After running the conversion wizard I don't understand what marshalling means first off as we never had to do this in VB6.

I will post the VB6 code in hopes someone may be able to assist me in finding a similar function within .Net or an idea to update.

This vb file works great in VB6 for opening programs or running services etc as different users, perfect for administrators that don't have SMS or other like admin capabilities for remote users.

Heres hoping someone can understand my problems.

Old Code below
=====================
Attribute VB_Name = "mdlLogon"
Option Explicit

Private Type STARTUPINFO
cb As Long
lpReserved As Long ' !!! must be Long for Unicode string
lpDesktop As Long ' !!! must be Long for Unicode string
lpTitle As Long ' !!! must be Long for Unicode 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

' CreateProcessWithLogonW API is available only on Windows 2000 and later.
Private Declare Function CreateProcessWithLogonW Lib "advapi32.dll" _
(ByVal lpUsername As String, _
ByVal lpDomain As String, _
ByVal lpPassword As String, _
ByVal dwLogonFlags As Long, _
ByVal lpApplicationName As Long, _
ByVal lpCommandLine As String, _
ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, _
ByVal lpCurrentDirectory As String, _
ByRef lpStartupInfo As STARTUPINFO, _
ByRef lpProcessInformation As PROCESS_INFORMATION) 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 Declare Function SetErrorMode Lib "kernel32.dll" _
(ByVal uMode As Long) As Long

Private Const CREATE_DEFAULT_ERROR_MODE = &H4000000

Private Const LOGON_WITH_PROFILE = &H1
Private Const LOGON_NETCREDENTIALS_ONLY = &H2

Private Const LOGON32_LOGON_INTERACTIVE = 2
Private Const LOGON32_PROVIDER_DEFAULT = 0
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&

Public Function W2KRunAsUser(ByVal UserName As String, _
ByVal password As String, _
ByVal DomainName As String, _
ByVal CommandLine As String, _
ByVal CurrentDirectory As String) As Long

Dim si As STARTUPINFO
Dim pi As PROCESS_INFORMATION

Dim wUser As String
Dim wDomain As String
Dim wPassword As String
Dim wCommandLine As String
Dim wCurrentDir As String

Dim result As Long

si.cb = Len(si)

wUser = StrConv(UserName + Chr$(0), vbUnicode)
wDomain = StrConv(DomainName + Chr$(0), vbUnicode)
wPassword = StrConv(password + Chr$(0), vbUnicode)
wCommandLine = StrConv(CommandLine + Chr$(0), vbUnicode)
wCurrentDir = StrConv(CurrentDirectory + Chr$(0), vbUnicode)

result = CreateProcessWithLogonW(wUser, wDomain, wPassword, _
LOGON_WITH_PROFILE, 0&, wCommandLine, _
CREATE_DEFAULT_ERROR_MODE, 0&, wCurrentDir, si, pi)
' CreateProcessWithLogonW() does not
If result <> 0 Then
CloseHandle pi.hThread
CloseHandle pi.hProcess
W2KRunAsUser = 0
'MsgBox "Process Finished, Exit Code " & result
Else
W2KRunAsUser = Err.LastDllError
MsgBox "CreateProcessWithLogonW() failed with error " & Err.LastDllError, vbExclamation
End If

End Function

Public Function ExecCmd(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret&
' Initialize the STARTUPINFO structure:
start.cb = Len(start)

' Start the shelled application:
ret& = CreateProcessA(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
Public Function RunWithWait(ByVal user As String, ByVal password As String, _
ByVal program As String, ByVal currDir As String)


Dim si As STARTUPINFO
Dim pi As PROCESS_INFORMATION

Dim wUser As String
Dim wDomain As String
Dim wPassword As String
Dim wCommandLine As String
Dim wCurrentDir As String

Dim result As Long

si.cb = Len(si)

wUser = StrConv(user + Chr$(0), vbUnicode)
wDomain = StrConv(Environ("computername") + Chr$(0), vbUnicode)
wPassword = StrConv(password + Chr$(0), vbUnicode)
wCommandLine = StrConv(program + Chr$(0), vbUnicode)
wCurrentDir = StrConv(currDir + Chr$(0), vbUnicode)

result = CreateProcessWithLogonW(wUser, wDomain, wPassword, _
LOGON_WITH_PROFILE, 0&, wCommandLine, _
CREATE_DEFAULT_ERROR_MODE, 0&, wCurrentDir, si, pi)
' CreateProcessWithLogonW() does not
If result <> 0 Or result <> 2 Then
'Wait for the shelled application to finish:
result = WaitForSingleObject(pi.hProcess, INFINITE)
Call GetExitCodeProcess(pi.hProcess, result)
CloseHandle pi.hThread
CloseHandle pi.hProcess

'MsgBox "worked, starting next program"
'MsgBox "Process Finished, Exit Code " & result
Else
'W2KRunAsUser = Err.LastDllError
MsgBox "Patch v0.5 failed with error #" & Err.LastDllError & "...Please contact support with this error number and your Image version", vbExclamation
End
End If

End Function




New Code in VB.Net
=========================
Option Strict Off
Option Explicit On
Module mdlLogon

Private Structure STARTUPINFO
Dim cb As Integer
Dim lpReserved As Integer ' !!! must be Long for Unicode string
Dim lpDesktop As Integer ' !!! must be Long for Unicode string
Dim lpTitle As Integer ' !!! must be Long for Unicode string
Dim dwX As Integer
Dim dwY As Integer
Dim dwXSize As Integer
Dim dwYSize As Integer
Dim dwXCountChars As Integer
Dim dwYCountChars As Integer
Dim dwFillAttribute As Integer
Dim dwFlags As Integer
Dim wShowWindow As Short
Dim cbReserved2 As Short
Dim lpReserved2 As Integer
Dim hStdInput As Integer
Dim hStdOutput As Integer
Dim hStdError As Integer
End Structure

Private Structure PROCESS_INFORMATION
Dim hProcess As Integer
Dim hThread As Integer
Dim dwProcessID As Integer
Dim dwThreadID As Integer
End Structure

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

'UPGRADE_WARNING: Structure PROCESS_INFORMATION may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"'
'UPGRADE_WARNING: Structure STARTUPINFO may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"'
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Integer, ByVal lpThreadAttributes As Integer, ByVal bInheritHandles As Integer, ByVal dwCreationFlags As Integer, ByVal lpEnvironment As Integer, ByVal lpCurrentDirectory As String, ByRef lpStartupInfo As STARTUPINFO, ByRef lpProcessInformation As PROCESS_INFORMATION) As Integer

' CreateProcessWithLogonW API is available only on Windows 2000 and later.
'UPGRADE_WARNING: Structure PROCESS_INFORMATION may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"'
'UPGRADE_WARNING: Structure STARTUPINFO may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"'
Private Declare Function CreateProcessWithLogonW Lib "advapi32.dll" (ByVal lpUsername As String, ByVal lpDomain As String, ByVal lpPassword As String, ByVal dwLogonFlags As Integer, ByVal lpApplicationName As Integer, ByVal lpCommandLine As String, ByVal dwCreationFlags As Integer, ByVal lpEnvironment As Integer, ByVal lpCurrentDirectory As String, ByRef lpStartupInfo As STARTUPINFO, ByRef lpProcessInformation As PROCESS_INFORMATION) As Integer

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

Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Integer, ByRef lpExitCode As Integer) As Integer

Private Declare Function SetErrorMode Lib "kernel32.dll" (ByVal uMode As Integer) As Integer

Private Const CREATE_DEFAULT_ERROR_MODE As Integer = &H4000000

Private Const LOGON_WITH_PROFILE As Short = &H1s
Private Const LOGON_NETCREDENTIALS_ONLY As Short = &H2s

Private Const LOGON32_LOGON_INTERACTIVE As Short = 2
Private Const LOGON32_PROVIDER_DEFAULT As Short = 0
Private Const NORMAL_PRIORITY_CLASS As Integer = &H20
Private Const INFINITE As Short = -1

Public Function W2KRunAsUser(ByVal UserName As String, ByVal password As String, ByVal DomainName As String, ByVal CommandLine As String, ByVal CurrentDirectory As String) As Integer

Dim si As STARTUPINFO
Dim pi As PROCESS_INFORMATION

Dim wUser As String
Dim wDomain As String
Dim wPassword As String
Dim wCommandLine As String
Dim wCurrentDir As String

Dim result As Integer

si.cb = Len(si)

'UPGRADE_ISSUE: Constant vbUnicode was not upgraded. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2070"'
wUser = StrConv(UserName & Chr(0), vbUnicode)
'UPGRADE_ISSUE: Constant vbUnicode was not upgraded. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2070"'
wDomain = StrConv(DomainName & Chr(0), vbUnicode)
'UPGRADE_ISSUE: Constant vbUnicode was not upgraded. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2070"'
wPassword = StrConv(password & Chr(0), vbUnicode)
'UPGRADE_ISSUE: Constant vbUnicode was not upgraded. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2070"'
wCommandLine = StrConv(CommandLine & Chr(0), vbUnicode)
'UPGRADE_ISSUE: Constant vbUnicode was not upgraded. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2070"'
wCurrentDir = StrConv(CurrentDirectory & Chr(0), vbUnicode)

result = CreateProcessWithLogonW(wUser, wDomain, wPassword, LOGON_WITH_PROFILE, 0, wCommandLine, CREATE_DEFAULT_ERROR_MODE, 0, wCurrentDir, si, pi)
' CreateProcessWithLogonW() does not
If result <> 0 Then
CloseHandle(pi.hThread)
CloseHandle(pi.hProcess)
W2KRunAsUser = 0
'MsgBox "Process Finished, Exit Code " & result
Else
W2KRunAsUser = Err.LastDllError
MsgBox("CreateProcessWithLogonW() failed with error " & Err.LastDllError, MsgBoxStyle.Exclamation)
End If

End Function

Public Function ExecCmd(ByRef cmdline As String) As Object
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret As Integer
' Initialize the STARTUPINFO structure:
start.cb = Len(start)

' Start the shelled application:
ret = CreateProcessA(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)
'UPGRADE_WARNING: Couldn't resolve default property of object ExecCmd. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
ExecCmd = ret
End Function
Public Function RunWithWait(ByVal user As String, ByVal password As String, ByVal program As String, ByVal currDir As String) As Object


Dim si As STARTUPINFO
Dim pi As PROCESS_INFORMATION

Dim wUser As String
Dim wDomain As String
Dim wPassword As String
Dim wCommandLine As String
Dim wCurrentDir As String

Dim result As Integer

si.cb = Len(si)

'UPGRADE_ISSUE: Constant vbUnicode was not upgraded. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2070"'
wUser = StrConv(user & Chr(0), vbUnicode)
'UPGRADE_ISSUE: Constant vbUnicode was not upgraded. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2070"'
wDomain = StrConv(Environ("computername") & Chr(0), vbUnicode)
'UPGRADE_ISSUE: Constant vbUnicode was not upgraded. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2070"'
wPassword = StrConv(password & Chr(0), vbUnicode)
'UPGRADE_ISSUE: Constant vbUnicode was not upgraded. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2070"'
wCommandLine = StrConv(program & Chr(0), vbUnicode)
'UPGRADE_ISSUE: Constant vbUnicode was not upgraded. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2070"'
wCurrentDir = StrConv(currDir & Chr(0), vbUnicode)

result = CreateProcessWithLogonW(wUser, wDomain, wPassword, LOGON_WITH_PROFILE, 0, wCommandLine, CREATE_DEFAULT_ERROR_MODE, 0, wCurrentDir, si, pi)
' CreateProcessWithLogonW() does not
If result <> 0 Or result <> 2 Then
'Wait for the shelled application to finish:
result = WaitForSingleObject(pi.hProcess, INFINITE)
Call GetExitCodeProcess(pi.hProcess, result)
CloseHandle(pi.hThread)
CloseHandle(pi.hProcess)

'MsgBox "worked, starting next program"
'MsgBox "Process Finished, Exit Code " & result
Else
'W2KRunAsUser = Err.LastDllError
MsgBox("Patch v0.5 failed with error #" & Err.LastDllError & "...Please contact support with this error number and your Image version", MsgBoxStyle.Exclamation)
End
End If

End Function
End Module


Comments

  • Didn't look through your code... But one of the major advantages of the .Net framework is most API functions have been incorporated it the framework, eliminating the need to reference API fucntions. For instance starting a external process. Use ProcessStartInfo to add arguments setup process, then start... Here is a link to the lib info, and a more detailed example...

    http://msdn.microsoft.com/library/default.asp?url=/library/en-us/cpref/html/frlrfSystemDiagnosticsProcessClassTopic.asp

    ~rlc

    [code]
    Dim l_Path As String
    Dim l_MyProcInfo As System.Diagnostics.ProcessStartInfo

    Try
    l_Path =
    l_MyProcInfo = New ProcessStartInfo(l_Path, "")
    System.Diagnostics.Process.Start(l_MyProcInfo)
    Catch ex As Exception
    'handle exception here
    End Try
    [/code]
  • hi...
    i m getting the same problem after upgrading from vb6 to vb.net.
    cud u plz tell how u solved the problem...
Sign In or Register to comment.

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories

In this Discussion