viernes, 10 de mayo de 2013

Modificación, Inserción, Eliminación de datos en Txt Desde Visual Basic 6

Hace unos años hice este code para el manejo parcial de las cuentas Vip de un juego, el sistema utilizaba un Txt como intermediario para comprobar las cuentas existentes y permitir el acceso si las mismas coincidian.

El código se basa en estructuras simples y concretas, sin módulos.

Para ingresar una cuenta era necesario en dos Textbox ingresar obligatoriamente el nombre de la cuenta y una fecha válida de finalización.

Option Explicit
Dim RepCuenta As Boolean
Private Sub cmdActivar_Click()
Dim Kuenta As String
Dim FechaExp As String 'maneja la fecha de expiración de la membresía vip
If Trim(txtAcc.Text) = "" Or Trim(txtDate.Text) = "" Then 'verificamos que no esten vacios los textbox
   MsgBox "Caja de texto vacía, no es posible dejarla asi", vbOKOnly + vbCritical, "Error: Atención!"
   Exit Sub
End If
If IsDate(txtDate.Text) Then 'verificamos que la fecha sea válida
   FechaExp = Trim(txtDate.Text)
   Kuenta = Trim(txtAcc.Text)
Else
   MsgBox "Fecha Invalida"
Exit Sub
End If
ListaAcc listAcc, Trim(Kuenta) 'funcion detallada mas abajo
If RepCuenta = True Then 'si la cuenta esta en la lista avisa del error
   MsgBox "Ésta cuenta ya tiene acceso Vip, Verifique", vbOKOnly + vbCritical, "Atención: Datos ambiguos"
   Exit Sub
Else
   'agrega vip ya que la cuenta no está ingresada
   RepCuenta = False
   Open App.Path & "\Connectmember.txt" For Append As #1 'abrimos txt
   Write #1, Trim(Kuenta), Trim(FechaExp) 'printeamos linea
   listAcc.AddItem xDD.Text & Kuenta & xDD.Text 'valores por sesion
   listDate.AddItem xDD.Text & FechaExp & xDD.Text
   Close #1
   MsgBox "Agregado con éxito", vbOKOnly + vbCritical, "xd"
End If
End Sub



Procedimiento que busca y compara cuentas, si encuentra coincidencia impide la ejecución del código
ya que la cuenta es existente y no es posible duplicar datos

Private Sub ListaAcc(unListado As ListBox, unaKuenta As String)
Dim x As Integer
For x = 0 To unListado.ListCount
    If Trim(unListado.List(x)) = Trim(xDD.Text) & Trim(unaKuenta) & Trim(xDD.Text) Then
       RepCuenta = True
       Exit Sub
    End If
Next x
End Sub


Private Sub cmdAK_Click()
Dim Cuenta As Integer
Open App.Path & "\ConnectMember.txt" For Output As #1
Print #1, "//Usuario"
Print #1, "// Vencimiento Vip formato dd/mm/aaaa"
Print #1, "//Txt Comando Acceso de servidor Vip"
For Cuenta = 0 To listAcc.ListCount - 1
   Print #1, listAcc.List(Cuenta) & "," & listDate.List(Cuenta)
Next Cuenta
Close #1
End Sub
Private Sub cmdCancelar_Click()
Label5.Visible = False
txtFechaAct.Visible = False
listAcc.Enabled = True
listDate.Enabled = True
cmdConf.Visible = False
cmdCancelar.Visible = False
End Sub
Private Sub cmdConf_Click()
Dim FechaAct As Date
If Trim(txtFechaAct.Text) = "" Then
   MsgBox "Caja de texto vacía, no es posible dejarla asi", vbOKOnly + vbCritical, "Error: Atención!"
   Exit Sub
End If
If IsDate(txtFechaAct.Text) Then
   FechaAct = Trim(txtFechaAct.Text)
Else
   MsgBox "Fecha Inválida"
Exit Sub
End If
listDate.List(Actual) = xDD.Text & FechaAct & xDD.Text
'cmdListar.Visible = True
Label5.Visible = False
txtFechaAct.Visible = False
listAcc.Enabled = True
listDate.Enabled = True
cmdConf.Visible = False
cmdCancelar.Visible = False
End Sub


Private Sub cmdListar_Click() 'devuelve una cadena con cuentas actuales en el archivo
Dim Linea As String
Dim EkisDe As Variant
Dim Kontrol As Integer
Dim CuentaLinea As Integer
listAcc.Clear
listDate.Clear
CuentaLinea = 0
Open App.Path & "\ConnectMember.txt" For Input As 1
Do While Not EOF(1)
    CuentaLinea = CuentaLinea + 1
    Line Input #1, Linea
    Kontrol = 1
    If CuentaLinea < 4 Then GoTo Seguir
       For Each EkisDe In Split(Linea, ",")
           If Kontrol = 1 Then
              listAcc.AddItem Trim(EkisDe)
              Kontrol = 2
           Else
              listDate.AddItem Trim(EkisDe)
           End If
       Next
Seguir:
    Loop
Close
Exit Sub
errSub:
MsgBox "Número de error: " & Err.Number & vbNewLine & _
       "Descripción del error: " & Err.Description, vbCritical, "Atención: Error!"
End Sub



Private Sub Form_Load()
RepCuenta = False
cmdListar_Click
Actual = -1
End Sub
Private Sub Form_Unload(Cancel As Integer)
If frmMenu.mnuChk.Checked = True Then
   cmdAK_Click
End If
End
End Sub


Private Sub listAcc_Click()
On Error Resume Next
listDate.ListIndex = (listAcc.ListIndex)
End Sub
Private Sub listAcc_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
If listAcc.ListCount = 0 Or listAcc.ListIndex = -1 Then Exit Sub
If Button = 2 Then
   Actual = listAcc.ListIndex
   frmMenu.PopupMenu frmMenu.mnuIni
End If
End Sub


Private Sub listDate_Click()
On Error Resume Next
listAcc.ListIndex = (listDate.ListIndex)
End Sub
Private Sub listDate_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
If listAcc.ListCount = 0 Or listAcc.ListIndex = -1 Then Exit Sub
If Button = 2 Then
   Actual = listAcc.ListIndex
   frmMenu.PopupMenu frmMenu.mnuIni
End If
End Sub


Es una muestra del manejo del txt en base a determinadas necesidades, se puede modificar perfectamente para extraer info de cualquier archivo de texto plano.


Saludos.

No hay comentarios:

Publicar un comentario