Runas Program

 I wrote up a little program that is similar to my touch screen runas program just missing the buttons. Here is the source code You will need to create a couple buttons and three text boxes. txtpassword txtusername txtpath and two buttons one for running the program and one for exit.

Requires VB.net Express 2010

Imports System.Security
Imports System.ComponentModel

Public Class frmMain

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load

    End Sub
    Function ConvertToSecureString(ByVal str As String)
        Dim password As New SecureString
        For Each c As Char In str.ToCharArray
            password.AppendChar(c)
        Next
        Return password
    End Function

    Private Sub Step1_UsernamesPasswords()

        Dim strUsername As String
        Dim strpassword As SecureString = ConvertToSecureString(txtpassword.Text)
        Dim strCommand As String = txtpath.Text

        ' MsgBox(strCommand)
       
        strUsername = txtusername.Text


        'If username = nothing display error then exit sub
        If strUsername = Nothing Then
            MsgBox("Error: Please enter a username", , "Error!")
            Exit Sub
        End If

        'the username is then set to a lowercase
        strUsername = LCase(strUsername)

        'Removes all spaces from username
        strUsername = strUsername.Replace(" ", "")





        Step2_Runas(strCommand, strUsername, strpassword)
    End Sub



    Private Sub Step2_Runas(strpathSecure As String, strusername As String, strpassword As SecureString)

        ' Process.Start(strpath, strusername, strpassword, ".")
        Dim pinfo = New System.Diagnostics.ProcessStartInfo
        Dim workingFolder = "c:"
        Dim strArguments As String = ""
        Dim intstrpathsecure As Integer = strpathSecure.Count
        Dim checkforspace
        Dim strlast3characters As String = ""
        Dim strchecklast3char As String
        Dim strErrorMsg As String

        'Checks for an argument and set strArguments if found
        For i = 0 To intstrpathsecure - 1
            strlast3characters = strlast3characters & strpathSecure.Chars(i) 'all characters
            checkforspace = strpathSecure.Chars(i) 'char that currently on

            strchecklast3char = Microsoft.VisualBasic.Right(strlast3characters, 4) ' last 4 chars.
            'This detects when "exe " and there is a space then set arguements values and strpathsecure
            If checkforspace = " " And strchecklast3char = "exe " Or checkforspace = " " And strchecklast3char = "bat " Then
                strArguments = Microsoft.VisualBasic.Mid(strpathSecure, i + 2)
                strpathSecure = Microsoft.VisualBasic.Left(strpathSecure, i)
                Exit For
            End If
        Next i

        pinfo.FileName = strpathSecure
        pinfo.WorkingDirectory = workingFolder
        pinfo.LoadUserProfile = True
        pinfo.UseShellExecute = False
        pinfo.UserName = strusername
        pinfo.Password = strpassword
        pinfo.Arguments = strArguments
        pinfo.Domain = "."

        Try


            System.Diagnostics.Process.Start(pinfo)

        Catch ex As Win32Exception
            'Error Message


            strErrorMsg = "Error: " & ex.Message.ToString & vbNewLine & _
                            "___________________________________________________________ " & vbNewLine & vbNewLine & _
                            "File Path: " & strpathSecure & vbNewLine & _
                            "Arguments: " & strArguments & vbNewLine & _
                            "Username: " & pinfo.UserName & vbNewLine & _
                            "WorkingDirectory: " & pinfo.WorkingDirectory & vbNewLine & _
                            "Time Stamp: " & TimeOfDay & " on " & Date.Today
                            






            'Debug.Assert(False, ex.Message)



            MessageBox.Show(strErrorMsg, "Error logging in as administrator", MessageBoxButtons.OK, MessageBoxIcon.Error)

        End Try
    End Sub

    Private Sub cmdRun_Click(sender As System.Object, e As System.EventArgs) Handles cmdRun.Click
        Step1_UsernamesPasswords()

      
    End Sub

    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        End
    End Sub
End Class