VERSION 5.00
Begin VB.Form Form_establecer_impresora 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Establecer impresora"
   ClientHeight    =   4770
   ClientLeft      =   45
   ClientTop       =   375
   ClientWidth     =   5865
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   4770
   ScaleWidth      =   5865
   Begin VB.TextBox txt_resultado 
      Height          =   375
      Left            =   960
      TabIndex        =   4
      Text            =   "Text1"
      Top             =   4800
      Width           =   3015
   End
   Begin VB.Frame Frame1 
      Caption         =   "Configuración impresora de Boletas y Letras"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   4575
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   5655
      Begin VB.CommandButton Command3 
         Caption         =   "Quitar impresora de boletas y letras"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   120
         TabIndex        =   6
         Top             =   3360
         Width           =   5415
      End
      Begin VB.CommandButton Command2 
         Caption         =   "Cambiar nombre de impresora matriz de punto predeterminada"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   120
         TabIndex        =   5
         Top             =   3960
         Width           =   5415
      End
      Begin VB.CommandButton Command1 
         Caption         =   "Configurar impresora de boletas y letras."
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   120
         TabIndex        =   2
         Top             =   2760
         Width           =   5415
      End
      Begin VB.ListBox List1 
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   1950
         ItemData        =   "Form_establecer_impresora.frx":0000
         Left            =   120
         List            =   "Form_establecer_impresora.frx":0002
         TabIndex        =   1
         Top             =   720
         Width           =   5415
      End
      Begin VB.Label Label1 
         Caption         =   "Listado de impresoras"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   240
         TabIndex        =   3
         Top             =   360
         Width           =   4695
      End
   End
End
Attribute VB_Name = "Form_establecer_impresora"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Function establecer_impresora(ByVal NamePrinter As String) As Boolean

   On Error GoTo errSub
   
        'Variable de referencia
        Dim obj_Impresora As Object
   
        'Creamos la referencia
        Set obj_Impresora = CreateObject("WScript.Network")
            obj_Impresora.SetDefaultPrinter NamePrinter
  
       Set obj_Impresora = Nothing
  
           'La función devuelve true y se cambió con éxito
           establecer_impresora = True
           MsgBox "La impresora se cambió correctamente", vbInformation
       Exit Function
  
'MsgBox obj_Impresora
'Error al cambiar la impresora
errSub:
   If Err.Number = 0 Then Exit Function
      establecer_impresora = False
      MsgBox "error: " & Err.Number & Chr(13) & "Description: " & Err.Description
      On Error GoTo 0
End Function
  
Private Sub Command1_Click()
   Dim IP As String
   Dim impre As String
   Dim objRS As ADODB.Recordset
   Set objRS = New ADODB.Recordset
   Dim var_sql As String
   Dim borrar As Integer
    
    var_sql = "SELECT cfg_impresora as b FROM usuarios where aut_nombre_usuario = '" & Nom_usu_ses & "'"
    objRS.Open var_sql, conn
    borrar = objRS("b")
    objRS.Close
    
    If borrar = 0 Then
        MsgBox "Ud. no tiene privilegios para configurar la impresora", vbInformation
        Exit Sub
    End If
   
   
   var_sql = "select valor from cfg where param = 'imp_usb'"
   objRS.Open var_sql, conn
       impre = objRS("valor")
   objRS.Close
   
   'Le enviamos la impresora que se encuentre seleccionada en el control List1
   If List1.Selected(List1.ListIndex) Then
      'establecer_impresora List1
      IP = devuelve_equipo
      Call configura_comando(IP, impre)
   End If
End Sub
  
Private Sub Command2_Click()
 Dim antiguo As String
 Dim nuevo As String
 Dim myValue As String
 Dim objRS As ADODB.Recordset
 Set objRS = New ADODB.Recordset
 Dim var_sql As String
 Dim borrar As Integer
    
    var_sql = "SELECT cfg_impresora as b FROM usuarios where aut_nombre_usuario = '" & Nom_usu_ses & "'"
    objRS.Open var_sql, conn
    borrar = objRS("b")
    objRS.Close
    
    If borrar = 0 Then
        MsgBox "Ud. no tiene privilegios para cambiar el nombre a la impresora", vbInformation
        Exit Sub
    End If
 
 
 var_sql = "select valor from cfg where param = 'imp_usb'"
 objRS.Open var_sql, conn
       antiguo = objRS("valor")
 objRS.Close
 nuevo = InputBox(boleta, "Ingrese nombre de la boleta ", DefaultValue, 100, 100)
    
 If MsgBox("¿Esta seguro de que desea cambiar el nombre de la impresora predeterminada de " & antiguo & " a " & nuevo & " ?", vbCritical + vbYesNo) = vbYes Then
    conn.Execute "update cfg set valor = '" & nuevo & "' where param = 'imp_usb'"
    MsgBox "El valor de la impresora fue cambiado satisfactoriamente", vbInformation
 End If
    
End Sub

Private Sub Command3_Click()
   Dim IP As String
   Dim impre As String
   Dim objRS As ADODB.Recordset
   Set objRS = New ADODB.Recordset
   Dim var_sql As String
   Dim borrar As Integer
    
    var_sql = "SELECT cfg_impresora as b FROM usuarios where aut_nombre_usuario = '" & Nom_usu_ses & "'"
    objRS.Open var_sql, conn
    borrar = objRS("b")
    objRS.Close
    
    If borrar = 0 Then
        MsgBox "Ud. no tiene privilegios para quitar la impresora", vbInformation
        Exit Sub
    End If
   
   
   
   var_sql = "select valor from cfg where param = 'imp_usb'"
   objRS.Open var_sql, conn
       impre = objRS("valor")
   objRS.Close
   
   'Le enviamos la impresora que se encuentre seleccionada en el control List1
   If List1.Selected(List1.ListIndex) Then
      'establecer_impresora List1
      IP = devuelve_equipo
      Call des_configura_comando(IP, impre)
   End If
End Sub

   Private Sub Form_Load()
   Dim X As Printer, impr As String
   'Listamos en el control List1 las impresoras instaladas
   For Each X In Printers
       List1.AddItem X.DeviceName
   Next
   Command1.Caption = " Seleccionar la impresora de Boletas y Letras"
   End Sub

Private Function devuelve_equipo() As String
    Dim i As Integer
    'Dim pos_fin
    Dim impresora As String
    impresora = List1.Text
    If CStr(Mid(impresora, 1, 1)) = "\" Then
    i = 3
    While Mid(impresora, i, 1) <> "\"
        i = i + 1
    Wend
    i = i - 3
    'recuperar_IP(Host)
    devuelve_equipo = recuperar_IP(Mid(impresora, 3, i))
    Else
    devuelve_equipo = Form_main.Winsock1.LocalIP
    End If
    'MsgBox List1.Text
End Function

Private Sub configura_comando(IP As String, impre As String)
    'Dim IP As String
    'Dim impre As String
    Dim borrar As String
    Dim crear As String
    'IP = "PC-LRIVEROS-1"
    'txt_resultado.Text = ""
    'txt_resultado.Text = ejecutar_Dos(Trim("NET USE LPT1: /DELETE"))
    'txt_resultado.Text = ejecutar_Dos(Trim("net use LPT1: \\ip\impre /yes"))
    borrar = "NET USE LPT1: /DELETE"
    'crear = "NET USE LPT1: \\" & IP & "\" & impre & " /yes"
    crear = "NET USE LPT1: \\" & IP & "\" & impre & " /persistent:yes"
    txt_resultado.Text = ejecutar_Dos(Trim(borrar))
    'MsgBox crear
    txt_resultado.Text = ejecutar_Dos(Trim(crear))
    MsgBox "Se a agregado la impresora de boletas y letras", vbInformation
End Sub


Private Sub des_configura_comando(IP As String, impre As String)
    'Dim IP As String
    'Dim impre As String
    Dim borrar As String
    'Dim crear As String
    'IP = "PC-LRIVEROS-1"
    'txt_resultado.Text = ""
    'txt_resultado.Text = ejecutar_Dos(Trim("NET USE LPT1: /DELETE"))
    'txt_resultado.Text = ejecutar_Dos(Trim("net use LPT1: \\ip\impre /yes"))
    borrar = "NET USE LPT1: /DELETE"
    'crear = "NET USE LPT1: \\" & IP & "\" & impre & " /yes"
    'crear = "NET USE LPT1: \\" & IP & "\" & impre & " /persistent:yes"
    txt_resultado.Text = ejecutar_Dos(Trim(borrar))
    'MsgBox crear
    'txt_resultado.Text = ejecutar_Dos(Trim(crear))
    MsgBox "Se a quitado la impresora de boletas y letras", vbInformation
End Sub

 
Function ejecutar_Dos(comando As String) As String
    Dim oShell As WshShell
    Dim oExec As WshExec
    Dim ret As String
    Set oShell = New WshShell
    DoEvents
    Set oExec = oShell.Exec("%comspec% /c " & comando)
    ret = oExec.StdOut.ReadAll()
    ejecutar_Dos = ret
    DoEvents
    Me.SetFocus
End Function
