Instrucciones para hacer un programa para una empresa. Conexión al servidor y diferentes menús.

Lo que debo hacer es un programa... Algo asi como un sisema que se conecte al servidor y tenga los siguientes menus ... Menu, operations, reports, salir...
El nombre de la empresa puede ser practica...
Y la idea es que haya un icono en el exritorio le de click y ese sea el sistema de la empresa practica...
No es necesario que los menus tengan opciones dentro pues solo es una practica...

1 Respuesta

Respuesta
1
Eso me parece a tarea de colegio, si quieres te puedo dar orientacion al respecto, pero no lo voy a hacer completo; ademas de eso la explicacion esta un poco escueta.
Si te interesa lo que te ofresco escribeme de nuevo y explicate un poco mejor.
Ok.. ya voy adentro de esto
tengo un cmd que muestra usuario, login.. debajo dos botones uno dice log in y el otro cancel...
en el boton log in tengo esto...
Option Explicit
Dim cnS As ADODB.Connection
Dim rsS As ADODB.Recordset, rsAux As ADODB.Recordset
Dim i As Integer
Private Sub cmdCancel_Click()
    Unload Me
End Sub
Private Sub cmdok_Click()
Dim tipo As Integer
On Error GoTo failu
tipo = 0
Set cnS = New ADODB.Connection
cnS.CursorLocation = adUseClient
cnS.Open CxSa
Set rsS = New ADODB.Recordset
If (rsS.State = adStateOpen) Then
    rsS.Close
End If
rsS.Open "select * from sys.database_principals where name='" & Trim(txtusuario.Text) & "'", cnS, adOpenDynamic, adLockReadOnly, adCmdText
If Not (rsS.BOF And rsS.EOF) Then
    Set rsAux = New ADODB.Recordset
    If (rsAux.State = adStateOpen) Then
        rsAux.Close
    End If
    rsAux.Open "SELECT * FROM logins WHERE loginame='" & Trim(txtusuario.Text) & "'", cnS, adOpenDynamic, adLockReadOnly, adCmdText
    If (rsAux.BOF And rsAux.EOF) Then
        MsgBox "The user: " & Trim(txtusuario.Text) & " is an Active login to the Server, but it's not ready to work. Please contact the System Administrator", vbExclamation + vbOKOnly, "Sistema de Inventario"
        End
    Else
        tipo = rsAux!type_usr
    End If
    cnS.Close
    Set cnS = New ADODB.Connection
    cnS.CursorLocation = adUseClient
    cnS.Open fxConectar(txtpwd.Text, txtusuario.Text)
    cnS.Close
    frmPrincipal.pwd = Trim(txtpwd.Text)
    frmPrincipal.idu = Trim(txtusuario.Text)
    'If (tipo = 2) Then
    '    frmPrincipal.mnuCatalogo.Enabled = False
    'End If
    If (tipo = 3) Then
        frmPrincipal.mnu_admin.Enabled = False
        frmPrincipal.mnuCatalogo.Enabled = False
        'frmPrincipal.mnuInvBod.Enabled = False
        frmPrincipal.mnuRollos.Enabled = False
        frmPrincipal.mnuMatInv.Enabled = False
        frmPrincipal.mnuOrdCompra.Enabled = False
        'frmPrincipal.mun_postate.Enabled = False
        frmPrincipal.mnuCamUbica.Enabled = False
        frmPrincipal.mnuFabCloseTcome.Enabled = False
        frmPrincipal.mnuSupposedPO.Enabled = False
        'frmPrincipal.mnuNewCutOrder.Enabled = False
        'frmPrincipal.mnuCompleteCO.Enabled = False
    End If
    If (tipo = 4) Then
        frmPrincipal.mnu_admin.Enabled = False
        frmPrincipal.mnuCatalogo.Enabled = False
        frmPrincipal.mnuMov.Enabled = False
        frmPrincipal.mnuTool.Enabled = False
    End If
    frmPrincipal.Show
    Unload Me
Else
    MsgBox "The User: " & Trim(txtusuario.Text) & " DOES NOT exist", vbCritical + vbOKOnly, "Sistema de Inventario"
    i = i + 1
End If
If (i = 3) Then
    MsgBox "You are not authorized to use this Application", vbExclamation + vbOKOnly, "Sistema de Inventario"
    cnS.Close
    End
End If
failu:
If (Err.Number = -2147217843) Then
    MsgBox Err.Description, vbExclamation + vbOKOnly, "Failure"
    txtpwd.SelStart = 0
    txtpwd.SelLength = Len(txtpwd.Text)
    txtpwd.SetFocus
    i = i + 1
    If (i = 3) Then
        MsgBox "You are not authorized to use this Application", vbExclamation + vbOKOnly, "Sistema de Inventario"
        If (cnS.State = adStateOpen) Then
            cnS.Close
        End If
        End
    End If
ElseIf Err.Description <> "" Then
    MsgBox Err.Description
End If
End Sub
Private Sub Form_Load()
'MsgBox wsock.LocalHostName & Chr(13) & wsock.LocalIP
End Sub
Private Sub txtpwd_Click()
If txtpwd.Text <> "" Then
SendKeys "{Home}+{End}"
End If
End Sub
Private Sub txtpwd_GotFocus()
If txtpwd.Text <> "" Then
SendKeys "{Home}+{End}"
End If
End Sub
Private Sub txtusuario_Change()
'If (txtusuario.Text = LCase("sistemas")) Then
'    End
'End If
End Sub
Private Sub txtusuario_Click()
If txtusuario.Text <> "" Then
SendKeys "{Home}+{End}"
End If
End Sub
Private Sub txtusuario_GotFocus()
If txtusuario.Text <> "" Then
SendKeys "{Home}+{End}"
End If
End Sub
Como hago todo esto mas sencillo... par que cuadno no reconozca el usurio, salga un cuadro que diga usuario no vaildo y el cursor aparezco en el cuadro de texto para escribir el usurio...
En el cuadro cancel tengo esto
Private Sub cmdCancel_Click()
    Unload Me
End Sub
Private Sub cmdok_Click()
Dim tipo As Integer
On Error GoTo failu
tipo = 0
Set cnS = New ADODB.Connection
cnS.CursorLocation = adUseClient
cnS.Open CxSa
Set rsS = New ADODB.Recordset
If (rsS.State = adStateOpen) Then
    rsS.Close
End If
rsS.Open "select * from sys.database_principals where name='" & Trim(txtusuario.Text) & "'", cnS, adOpenDynamic, adLockReadOnly, adCmdText
If Not (rsS.BOF And rsS.EOF) Then
    Set rsAux = New ADODB.Recordset
    If (rsAux.State = adStateOpen) Then
        rsAux.Close
    End If
    rsAux.Open "SELECT * FROM logins WHERE loginame='" & Trim(txtusuario.Text) & "'", cnS, adOpenDynamic, adLockReadOnly, adCmdText
    If (rsAux.BOF And rsAux.EOF) Then
        MsgBox "The user: " & Trim(txtusuario.Text) & " is an Active login to the Server, but it's not ready to work. Please contact the System Administrator", vbExclamation + vbOKOnly, "Sistema de Inventario"
        End
    Else
        tipo = rsAux!type_usr
    End If
    cnS.Close
    Set cnS = New ADODB.Connection
    cnS.CursorLocation = adUseClient
    cnS.Open fxConectar(txtpwd.Text, txtusuario.Text)
    cnS.Close
    frmPrincipal.pwd = Trim(txtpwd.Text)
    frmPrincipal.idu = Trim(txtusuario.Text)
    'If (tipo = 2) Then
    '    frmPrincipal.mnuCatalogo.Enabled = False
    'End If
    If (tipo = 3) Then
        frmPrincipal.mnu_admin.Enabled = False
        frmPrincipal.mnuCatalogo.Enabled = False
        'frmPrincipal.mnuInvBod.Enabled = False
        frmPrincipal.mnuRollos.Enabled = False
        frmPrincipal.mnuMatInv.Enabled = False
        frmPrincipal.mnuOrdCompra.Enabled = False
        'frmPrincipal.mun_postate.Enabled = False
        frmPrincipal.mnuCamUbica.Enabled = False
        frmPrincipal.mnuFabCloseTcome.Enabled = False
        frmPrincipal.mnuSupposedPO.Enabled = False
        'frmPrincipal.mnuNewCutOrder.Enabled = False
        'frmPrincipal.mnuCompleteCO.Enabled = False
    End If
    If (tipo = 4) Then
        frmPrincipal.mnu_admin.Enabled = False
        frmPrincipal.mnuCatalogo.Enabled = False
        frmPrincipal.mnuMov.Enabled = False
        frmPrincipal.mnuTool.Enabled = False
    End If
    frmPrincipal.Show
    Unload Me
Else
    MsgBox "The User: " & Trim(txtusuario.Text) & " DOES NOT exist", vbCritical + vbOKOnly, "Sistema de Inventario"
    i = i + 1
End If
If (i = 3) Then
    MsgBox "You are not authorized to use this Application", vbExclamation + vbOKOnly, "Sistema de Inventario"
    cnS.Close
    End
End If
failu:
If (Err.Number = -2147217843) Then
    MsgBox Err.Description, vbExclamation + vbOKOnly, "Failure"
    txtpwd.SelStart = 0
    txtpwd.SelLength = Len(txtpwd.Text)
    txtpwd.SetFocus
    i = i + 1
    If (i = 3) Then
        MsgBox "You are not authorized to use this Application", vbExclamation + vbOKOnly, "Sistema de Inventario"
        If (cnS.State = adStateOpen) Then
            cnS.Close
        End If
        End
    End If
ElseIf Err.Description <> "" Then
    MsgBox Err.Description
End If
End Sub
Private Sub Form_Load()
'MsgBox wsock.LocalHostName & Chr(13) & wsock.LocalIP
End Sub
Private Sub txtpwd_Click()
If txtpwd.Text <> "" Then
SendKeys "{Home}+{End}"
End If
End Sub
Private Sub txtpwd_GotFocus()
If txtpwd.Text <> "" Then
SendKeys "{Home}+{End}"
End If
End Sub
Private Sub txtusuario_Change()
'If (txtusuario.Text = LCase("sistemas")) Then
'    End
'End If
End Sub
Private Sub txtusuario_Click()
If txtusuario.Text <> "" Then
SendKeys "{Home}+{End}"
End If
End Sub
Private Sub txtusuario_GotFocus()
If txtusuario.Text <> "" Then
SendKeys "{Home}+{End}"
End If
End Sub
Se puede hacer mas sencillo tambien.. asi el corre pero mucho texto... com ibra probando y probando hasta que dio... quiza me sugieres una forma mas simple de hacer lo mismo.
Gracias
OK, en el boton OK no entiendo porque haces dos consultas en dos tablas distintas sobre el mismo usuario, ¿son dos bases de datos o es un backup?. En este mismo boton estas comprobando el valor de "tipo" con unas sentencias if...then...end if prueba con esta sentencia:
Select Case tipo
    tipo 2
        frmPrincipal.mnuCatalogo.Enabled = False
    tipo 3
        frmPrincipal.mnu_admin.Enabled = False
        frmPrincipal.mnuCatalogo.Enabled = False
        'frmPrincipal.mnuInvBod.Enabled = False
        frmPrincipal.mnuRollos.Enabled = False
        frmPrincipal.mnuMatInv.Enabled = False
        frmPrincipal.mnuOrdCompra.Enabled = False
        'frmPrincipal.mun_postate.Enabled = False
        frmPrincipal.mnuCamUbica.Enabled = False
        frmPrincipal.mnuFabCloseTcome.Enabled = False
        frmPrincipal.mnuSupposedPO.Enabled = False
        'frmPrincipal.mnuNewCutOrder.Enabled = False
        'frmPrincipal.mnuCompleteCO.Enabled = False
    tipo 4
        frmPrincipal.mnu_admin.Enabled = False
        frmPrincipal.mnuCatalogo.Enabled = False
        frmPrincipal.mnuMov.Enabled = False
        frmPrincipal.mnuTool.Enabled = False
End Select
el txtpwd_click, txtpwd_gotfocus, txtusuario_click y txtusuario_gotfocus hacen lo mismo ¿porque?, que quieres hacer alli.
¿Como es eso que en el boton de login tienes un chorizo de codigo y en el boton de cancel tienes el mismo (aparentemente), se supone que el boton de cancel solo cancela y que todas las otras operaciones son con el boton de login.
Explicame un poco mejor.
ok listo lo he resumido bastante...
ahora necesito dos cosas...
tengo un formulario donde escribo user y pasword pero no puedo hacer que se muestre de un solo al abrirlo y el reloj siga su marcha normal... cuando lo corro solo si le doy click al panel de control me sale la hora y fecha pero se queda fijo el reloj, solo si le estoy dando click a cada rato esta cambiando el reloj.
esto tengo en ese formulario
Private Sub StatusBar1_PanelClick(ByVal Panel As MSComctlLib.Panel)
StatusBar1.Panels(2) = time
StatusBar1.Panels(3) = Date
End Sub
Private Sub Timer1_Timer()
'StatusBar1.Panels(2) = time
sttbar.Panels(2).Text = Format(Now, "HH:MM:SS AM/PM")
End Sub
en el panel uno esta el nombre del proyecto por eso esta 2 para hora y 3 para fecha..
Lo otro seria.. como hago para que el texbox reconozca todos los user y passwords que ya se han generado.. no solo 1.
Gracias por la ayuda....
ah otra cosita que no logro es que cuando termine de escribir el password al darle enter entre al sistema sin tener que dar click con el mouse al comand buton "login" y que cuando el usuario o password sea incorrecto el puntero se ponga sobre el usuario o password segun sea el que este incorrecto.. sin tener que ponerlo con el mouse....
Estoy tratano de sacarlo pero no lo consigo
Gracias,
bueno gracias, ya logre hacer todo
lo que no logro hacer es que el formulario de usuario y contraseña valide a los que ya estan creados en una base de datos en sql... en la db hay un campo llamado security, dentro esta logins y ahi estan todos los usuarios.. con los campos name y Password
ya probe por recorset y ado y nada que da... en el modulo del proyecto tengo esto
Public MyCon As New ADODB.Connection, rsAuxiliar As New ADODB.Recordset
Public CadSql As String
Public Sub Main()
If MyCon.State = 1 Then Set MyCon = Nothing
MyCon.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=Inventory;Data Source=SEMUEBLETEX\SEMUEBLETEX"
MsgBox CStr(MyCon.State)
MdiMenu.Show
End Sub
osea solo la coneccion y el formulario esto
Private Sub cmdLogIn_Click()
If (txtUser.Text = "hola" And txtPassword.Text = "mundo") Then
frmPrincipal.Show
Unload Me
Else
MsgBox "Usuario incorrecto", vbYes + vbInformation, "Contraseña"
End If
End Sub
como hago para validar todos los usuarios
Para que el panel te actualize la hora constantemente, tienes que crear un bucle, ya que con la sentencia Now(), tomas la hora del sistema (en ese instante) pero no se actualiza.
Utiliza esto para cuando presiones enter sobre el textbox de login, puedas hacer las acciones que necesites:
Private Sub Text1_KeyPress(KeyAscii As Integer)
    If Chr(KeyAscii) = Chr(13) Then
        'Pon aqui el llamado a la sentencia de login
    End If
End Sub
Con respecto a colocar el puntero sobre el textbox de login o pwd cuando este errado alguno de ellos, por seguridad del sistema no deberias hacerlo, ya que de esta forma le estas diciendo al usuario (o persona que esta tratando de accesar) donde se equivoco, ahora imagina que es alguien que quiere accesar de forma ilegal, le estan indicando donde esta el error y aumentando su probabilidad de exito de acceso al sistema indicandole donde se equivoco.
No entiendo tu ultima pregunta.
con respecto a la ultima pregunta... lo que quiero es que como ya existe una base de usuarios con su lgin que el formulario reconozca esos id que estan en una tabla logins
alg asi como validar los usuarios de esa tabla....
Saludos y de verdad gracias por el tiempo dedicado a mis dudas
oh me olvide en botobn login tengo esto
Private Sub cmdLogIn_Click()
If (txtUser.Text = "Admin" And txtPassword.Text = "Admin") Then
frmPrincipal.Show
Unload Me
Else
MsgBox "Usuario incorrecto", vbYes + vbInformation, "Contraseña"
End If
End Sub
pero ahi solo ingresa con ese usuario y contraseña, yo quiero que pueda ingresar cualquier usuario de la tabla que esta en mi base llamda logins
Disculpa la demora, te voy a dar la teoria de lo que deberias hacer, mas no el codigo porqu estoy un poco corto de tiempo: tienes que hacer un select * from logins, y guardar estos datos en una variable tipo matriz, de manera tal que luego puedas hacer un bucle de busqueda dentro de esta matriz para validadr los datos de usuario y password.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas