Mensajes

Bueno aqui mejore el codigo originalmente posteado, no se si sea mas rapido porque no lo probe con tantos registros, solo con los que el puso de ejemplo.

Utiliza la memoria para realizar el proceso y no necesita del archivo RUTS.txt aunque lo deje por si acaso. Hize un solo bucle para todo el proceso lo cual es mas rapido ya que antes dijiste que campo1 y 2 no son necesarios.

Suponiendo que el "rut" no se encuentra en los campos 1 o 2 hize este code:

Código (vb) [Seleccionar] Expandir



Option Explicit

Private Sub Command1_Click()

    Dim DIRECCION As String
    Dim Sumatoria As String
    Dim Content() As String
    Dim I         As Long
    Dim Regs      As String
    Dim Llave     As String
    Dim Ruts      As String
    Dim V         As Integer

    If Dir$(App.Path & "\RUTS.txt") <> "" Then Kill App.Path & "\RUTS.txt"

    If Dir$(App.Path & "\ARCHIVO_FINAL.txt") <> "" Then Kill App.Path & "\ARCHIVO_FINAL.txt"

    cd.ShowOpen    ' abre una ventana para buscar el archivo base
    DIRECCION = cd.FileName   ' la direccion se guarda en una variable

    Open DIRECCION For Input As #1     ' abrimos el archivo               ' lo recorremos mientras no sea fin de archivo

    Content = Split(Input$(LOF(1), #1), vbCrLf)

    Close #1

    For I = LBound(Content) To UBound(Content)

        If Content(I) <> "" Then

            Llave = Mid$(Content(I), 58, 9)
            Sumatoria = Mid$(Content(I), 35, 8)

            If Llave <> "" Then

                V = InStr(1, Regs, Llave)

                If V = 0 Then

                    Regs = Regs & Llave & vbCrLf
                    Ruts = Ruts & Content(I) & vbCrLf
                    EscriveLog Llave, "RUTS"

                Else

                    V = InStr(1, Ruts, Llave)
                    Ruts = Replace$(Ruts, Mid$(Ruts, V - 23, 8), Format$(Val(Mid$(Ruts, V - 23, 8)) + Val(Sumatoria), "00000000"))

                End If

            End If

        End If

    Next
   
    Ruts = Mid$(Ruts, 1, Len(Ruts) - 2)

    EscriveLog Ruts, "ARCHIVO_FINAL"
    MsgBox "FIN"

End Sub



Modulo:

Código (vb) [Seleccionar] Expandir



Public Function EscriveLog(ByRef Texto As String, ByRef tipo As String) ', ByRef xTipo As Byte)

    Dim strFile As String
    Dim fn      As Long
    Dim strLog  As String

    strFile = App.Path & "\" & tipo & ".txt"
    fn = FreeFile
    strLog = Texto

    Open strFile For Append As fn

    Print #fn, strLog

    Close fn

End Function



Seria bueno que subieras el archivo base original para ver que tanto podemos optimizar el code. (comprimido) si es que no pesa mucho.

y si usas split?

Buenas , esta vez tengo una pregunta y es que he buscado pero no he encontrado mucho, queria saber si es posible grabar los datos de una estructura UDT como string u otro tipo de variable, para luego cargar los datos de nuevo asignadolo al UDT. He visto que se puede grabar una UDT en un archivo binario, pero necesito que no sea en un archivo binario.

PD: Necesito espesificamente guardar los datos de la UDT en una campo de una base de datos, para luego poder leer esa UDT otra vez.

[@DarkMatrix]

@DarkMatrix

http://www.recursosvisualbasic.com.ar/htm/tutoriales/modulos-de-clase-menu.htm

Mas o menos es esto lo que quieres o me equivoco?!¡...

Código (vb) [Seleccionar] Expandir



Function Funcion2()
    Debug.Print "Empezo la funcion 2"
    Do
        WaitMessage
        DoEvents
    Loop Until Variable = 2 Or Variable = 1
    Debug.Print "Acabo la funcion 2 "
End Function



No exactamente porque la Funcion 1 es distinta de la 2 y si una cambia la otra no se ve afectada, el problema surge que cuando ejecuto las 2 o mas de 2 solo me analiza la ultima en ejecutar por tanto si Variable = 1 y la ultima funcion ejecutada es la 2 no sale del bucle la 1 y asi se queda.

La idea es permanecer en ambos bucles de ambas funciones por separado de modo que si la variable toma un valor u otro las funciones reaccionen deacuerdo a su condicion de bucle.

PD: le hechare un vistazo a los modulos de clase Saludos!

No manejo mucho los modulos de calse pero podrias dar un ejemplo de como lo harias? Aqui pongo un ejemplo de lo que quiero hacer:

En un form:

Código (vb) [Seleccionar] Expandir

Option Explicit

Dim Variable            As Integer

Private Sub Command1_Click()
    Variable = 1
End Sub

Private Sub Command2_Click()
    Variable = 2
End Sub

Private Sub Form_Load()
    Timer1.Enabled = True
    Timer2.Enabled = True
    MsgBox "Se ejecutaron las funciones"
End Sub

Function Funcion1()

    Debug.Print "Empezo la funcion 1"

    Do
        WaitMessage
        DoEvents
    Loop Until Variable = 1

    MsgBox "Acabo la funcion 1 "

End Function

Function Funcion2()

    Debug.Print "Empezo la funcion 2"

    Do
        WaitMessage
        DoEvents
    Loop Until Variable = 2

    MsgBox "Acabo la funcion 2 "

End Function

Private Sub Timer1_Timer()
    Timer1.Enabled = False
    Call Funcion1
End Sub

Private Sub Timer2_Timer()
    Timer2.Enabled = False
    Call Funcion2
End Sub


Tengo 2 botones y dos funciones, los timers son para llamar a ambas funciones al mismo tiempo. Si se corre el ejemplo veran que las dos funciones inicializan pero la ultima en iniciar es la que se mantiene en el bucle mientras que la otra no.

Ejemplo si inicio la aplicacion y empieza la funcion1 y despues la funcion2 si aprieto el command1 que es el que modifica la variable para que salga de la funcion 1 no pasa nada pero si pulso el command2 si sale de la funcion 2 :S a ver si me pueden hechar una mano, he pensado en varias cosas pero no me sirven gracias de ante mano.

Buenas, tengo un inconveniente y no encuentro una solucion. Veran tengo una aplicacion que necesita ejecutar una funcion, esta funcion se debe mantener activa hasta que la en la aplicacion suceda algo por ejemplo que cambie una variable, en pequeño ejemplo:

Código (vb) [Seleccionar] Expandir

Sub Funcion()

    ' La aplicacion activa un suceso, ejemplo activa un command botton.

    ' La aplicacion se mantiene en esta linea sin pasar a la siguiente linea hasta que
    ' una variable cambie de valor, cuando la variable cambia de valor entonces
    ' pasa a la siguiente linea.

    ' Desactiva el suceso antes activado.

End Function


Esto yo lo habia logrado aplicando un doEvents junto con waitmessage, pero el problema surge cuando tengo que llamar dos veces a esa funcion, solo me ejecuta una a la vez, el doevents se mantiene en una funcion pero no me analiza la otra y esto me causa problemas, ya que ambas tienen condiciones diferentes, y si la condicion de una cambia mientras el bucle esta en la otra entonces se queda pegada esa funcion y no me sirve :S. Quisiera saber si saben alguna forma de solucionar esto o alguna alternativa que me sirva Gracias.

Saludos! XD!

Tengo este code en mis codes almacenados ( No es mia la funcion ), Espero que te sirva XD!

Código (vb) [Seleccionar] Expandir


'---------------------------------------------------------------------------------------
' Module : mLocIP
' DateTime: 19/12/2009 08:55PM
' Author : Kresha7
' Mail: kresha7@hotmail.com
' Purpose : Gets Information about the location of an IP address
'---------------------------------------------------------------------------------------
Public Function LocateIP(IPAddr As String) As String

    Dim HTTP As Object
    Dim StrRes As String
    Dim IP As String, Region As String, Country As String, City As String, Latitude As String, Longitude As String, TZone As String, ISP As String, ConT As String
   
    Const URL = "http://www.ip2location.com/"
   
    Set HTTP = CreateObject("Winhttp.Winhttprequest.5.1")
   
    With HTTP
        .Open "POST", URL & IPAddr
        .Send
        StrRes = .ResponseText
    End With
   
    IP = Mid(Split(Split(StrRes, "dgLookup__ctl2_lblICountry")(1), "</span>")(0), 3)
    Region = Mid(Split(Split(StrRes, "dgLookup__ctl2_lblIRegion")(1), "</span>")(0), 3)
    Country = Mid(Split(Split(StrRes, "dgLookup__ctl2_lblICity")(1), "</span>")(0), 3)
    Latitude = Mid(Split(Split(StrRes, "dgLookup__ctl2_lblILatitude")(1), "</span>")(0), 3)
    Longitude = Mid(Split(Split(StrRes, "dgLookup__ctl2_lblILongitude")(1), "</span>")(0), 3)
    TZone = Mid(Split(Split(StrRes, "dgLookup__ctl2_lblITimeZone")(1), "</span>")(0), 3)
    ConT = Mid(Split(Split(StrRes, "dgLookup__ctl2_lblINetSpeed")(1), "</span>")(0), 3)
    ISP = Mid(Split(Split(StrRes, "dgLookup__ctl2_lblIISP")(1), "</span>")(0), 3)
    LocateIP = IP & vbNewLine & Region & vbNewLine & Country & vbNewLine & Latitude & vbNewLine & Longitude & vbNewLine & TZone & vbNewLine & ConT & vbNewLine & ISP
   
End Function


Buenas, he buscado en la web algun codigo o algo que me sirva para obtener un codigo unico para una maquina, que solo lo tenga esa maquina y ningun otra. Si alguien tiene algo que me ayude se agradece Saludos!

El link de descargar esta el source.

PD: Perdon por el doble post.