'Comentarios:  Retardo( en microsegundos )    
'Rutinas al final

    VddOn (TextPor.Text)
    Retardo (10000)
    VppOn (TextPor.Text)
    Retardo (10000)                 'En modo de Programación/Borrado/Verificación


'Lectura del pic 18F4620 envia los datos leidos a un archivo

            Print #1, "PIC -> " & TextPi.Text
            Print #1,
            Print #1,
            Print #1, "Area de Programa"
            Print #1,
            
            enviocom4 (CoIn)
            enviodato16 (&H8EA6)     'BSF  EECON1, EEPGD
            enviocom4 (CoIn)
            enviodato16 (&H9CA6)     'BCF  EECON1, CFGS
            
            enviocom4 (CoIn)
            enviodato16 (&HE00)      'MOVLW Addr[21:16] 00h
            enviocom4 (CoIn)
            enviodato16 (&H6EF8)     'MOVWF TBLPTRU
            enviocom4 (CoIn)
            enviodato16 (&HE00)      'MOVLW Addr[15:8] 00h
            enviocom4 (CoIn)
            enviodato16 (&H6EF7)     'MOVWF TBLPTRH
            enviocom4 (CoIn)
            enviodato16 (&HE00)      'MOVLW Addr[7:0] 00h
            enviocom4 (CoIn)
            enviodato16 (&H6EF6)     'MOVWF TBLPTRL
            
            For aux = 0 To (pmax - 1) Step 2  'Leo área de programa
                enviocom4 (TaRe_PoI)
                dato1 = leodato16()
                a1 = Hex(aux + pbase)
                d1 = Hex(dato1)
                la1 = Len(a1)
                ld1 = Len(d1)
                enviocom4 (TaRe_PoI)
                dato2 = leodato16()
                d2 = Hex(dato2)
                ld2 = Len(d2)
                
                linea = String((8 - la1), " ") & a1 & "   " & String((4 - ld1), " ") & d1 & String((2 - ld2), "0") & d2
                Print #1, linea
            Next
               
             Print #1,
             Print #1,
             Print #1, "Area de Identificación (ID)"
             Print #1,
            
            
             enviocom4 (CoIn)
             enviodato16 (&HE20)      'MOVLW Addr[21:16] 20h
             enviocom4 (CoIn)
             enviodato16 (&H6EF8)     'MOVWF TBLPTRU
             enviocom4 (CoIn)
             enviodato16 (&HE00)      'MOVLW Addr[15:8] 00h
             enviocom4 (CoIn)
             enviodato16 (&H6EF7)     'MOVWF TBLPTRH
             enviocom4 (CoIn)
             enviodato16 (&HE00)      'MOVLW Addr[7:0] 00h
             enviocom4 (CoIn)
             enviodato16 (&H6EF6)     'MOVWF TBLPTRL
            
             For aux = 0 To (imax - 1) Step 1  'Leo área de ID
                 enviocom4 (TaRe_PoI)
                 dato1 = leodato16()
                 a1 = Hex(aux + ibase)
                 d1 = Hex(dato1)
                 la1 = Len(a1)
                 ld1 = Len(d1)

                 linea = String((8 - la1), " ") & a1 & "   " & String((4 - ld1), " ") & d1
                 Print #1, linea
             Next

             Print #1,
             Print #1,
             Print #1, "Area de Configuración"
             Print #1,


             enviocom4 (CoIn)
             enviodato16 (&HE30)      'MOVLW Addr[21:16] 30h
             enviocom4 (CoIn)
             enviodato16 (&H6EF8)     'MOVWF TBLPTRU
             enviocom4 (CoIn)
             enviodato16 (&HE00)      'MOVLW Addr[15:8] 00h
             enviocom4 (CoIn)
             enviodato16 (&H6EF7)     'MOVWF TBLPTRH
             enviocom4 (CoIn)
             enviodato16 (&HE00)      'MOVLW Addr[7:0] 00h
             enviocom4 (CoIn)
             enviodato16 (&H6EF6)     'MOVWF TBLPTRL
 
             For aux = 0 To (cmax - 1) Step 1  'Leo área de Configuración
                 enviocom4 (TaRe_PoI)
                 dato1 = leodato16()
                 a1 = Hex(aux + cbase)
                 d1 = Hex(dato1)
                 la1 = Len(a1)
                 ld1 = Len(d1)
 
                 linea = String((8 - la1), " ") & a1 & "   " & String((4 - ld1), " ") & d1
                 Print #1, linea
             Next
 
             Print #1,
             Print #1,
             Print #1, "Area de data EEPROM"
             Print #1,
 
 
             enviocom4 (CoIn)
             enviodato16 (&HEF0)      'MOVLW Addr[21:16] F0h
             enviocom4 (CoIn)
             enviodato16 (&H6EF8)     'MOVWF TBLPTRU
             enviocom4 (CoIn)
             enviodato16 (&HE00)      'MOVLW Addr[15:8] 00h
             enviocom4 (CoIn)
             enviodato16 (&H6EF7)     'MOVWF TBLPTRH
             enviocom4 (CoIn)
             enviodato16 (&HE00)      'MOVLW Addr[7:0] 00h
             enviocom4 (CoIn)
             enviodato16 (&H6EF6)     'MOVWF TBLPTRL
 
             For aux = 0 To (dmax - 1) Step 1  'Leo área de data EEPROM
                 enviocom4 (TaRe_PoI)
                 dato1 = leodato16()
                 a1 = Hex(aux + dbase)
                 d1 = Hex(dato1)
                 la1 = Len(a1)
                 ld1 = Len(d1)
 
                 linea = String((8 - la1), " ") & a1 & "   " & String((4 - ld1), " ") & d1
                 Print #1, linea
             Next

            Print #1,
            Print #1,
            Print #1, "Area de data Device Information"
            Print #1,

            aux = 0
            
            enviocom4 (CoIn)
            enviodato16 (&HE3F)      'MOVLW Addr[21:16] 3Fh
            enviocom4 (CoIn)
            enviodato16 (&H6EF8)     'MOVWF TBLPTRU
            enviocom4 (CoIn)
            enviodato16 (&HEFF)      'MOVLW Addr[15:8] FFh
            enviocom4 (CoIn)
            enviodato16 (&H6EF7)     'MOVWF TBLPTRH
            enviocom4 (CoIn)
            enviodato16 (&HEFE)      'MOVLW Addr[7:0] FEh
            enviocom4 (CoIn)
            enviodato16 (&H6EF6)     'MOVWF TBLPTRL

            enviocom4 (TaRe_PoI)
            dato1 = leodato16()
            a1 = Hex(aux + devbase)
            d1 = Hex(dato1)
            la1 = Len(a1)
            ld1 = Len(d1)

            linea = String((8 - la1), " ") & a1 & "   " & String((4 - ld1), " ") & d1
            Print #1, linea
            
            aux = aux + 1
            
            enviocom4 (CoIn)
            enviodato16 (&HE3F)      'MOVLW Addr[21:16] 3Fh
            enviocom4 (CoIn)
            enviodato16 (&H6EF8)     'MOVWF TBLPTRU
            enviocom4 (CoIn)
            enviodato16 (&HEFF)      'MOVLW Addr[15:8] FFh
            enviocom4 (CoIn)
            enviodato16 (&H6EF7)     'MOVWF TBLPTRH
            enviocom4 (CoIn)
            enviodato16 (&HEFF)      'MOVLW Addr[7:0] FFh
            enviocom4 (CoIn)
            enviodato16 (&H6EF6)     'MOVWF TBLPTRL

            enviocom4 (TaRe_PoI)
            dato1 = leodato16()
            a1 = Hex(aux + devbase)
            d1 = Hex(dato1)
            la1 = Len(a1)
            ld1 = Len(d1)

            linea = String((8 - la1), " ") & a1 & "   " & String((4 - ld1), " ") & d1
            Print #1, linea



'Rutinas

'Habilitación de Acceso a puertos
Public Declare Function Inp Lib "C:\Programador Luis VB\Lp\inpout32.dll" _
Alias "Inp32" (ByVal PortAddress As Integer) As Integer
Public Declare Sub Out Lib "C:\Programador Luis VB\Lp\inpout32.dll" _
Alias "Out32" (ByVal PortAddress As Integer, ByVal Value As Integer)

'------------------------------------------------------------------
'Declaración de constantes 18F4620
'------------------------------------------------------------------
'
Public Const CoIn = &H0                     'Core Instruction
Public Const ShOuTA = &H2                   'Shift Out TABLAT register
Public Const TaRe = &H8                     'Table Read
Public Const TaRe_PoI = &H9                 'Table Read Post Increment
Public Const TaRe_PoD = &HA                 'Table Read Post Decrement
Public Const TaRe_PrI = &HB                 'Table Read Pre Increment
Public Const TaWr = &HC                     'Table Write
Public Const TaWr_PoI2 = &HD                'Table Write Post Increment by 2
Public Const TaWrSP_PoI2 = &HE              'Table Write Start Programing Post Increment by 2
Public Const TaWrSP = &HF                   'Table Write Start Programing


'Lectura de bits de datos enviados por pic

Function ValorS6(puerto As Integer) As Byte     'Datos enviados por el pic
    Dim aux As Integer
    
    aux = Inp(puerto + 1)
    
    If (aux And 64) = 64 Then
        ValorS6 = 1
    Else
        ValorS6 = 0
    End If

End Function

Sub AllOff(ByVal puerto As Integer)
    VppOff (puerto)
    Retardo (25000)
    DataOff (puerto)
    Retardo (25000)
    ClockOff (puerto)
    Retardo (25000)
    VddOff (puerto)
    Retardo (25000)
    
End Sub

Sub VppReset(ByVal puerto As Integer)
    VppOff (puerto)
    Retardo (25000)
    DataOff (puerto)
    Retardo (25000)
    ClockOff (puerto)
    Retardo (25000)
    VddOff (puerto)
    Retardo (25000)
    VddOn (puerto)
    Retardo (25000)
    VppOn (puerto)
    Retardo (25000)

End Sub

Sub ClockDataOff(ByVal puerto As Integer)
    DataOff (puerto)
    Retardo (1000)
    ClockOff (puerto)
    Retardo (1000)

End Sub
Sub VppOn(ByVal puerto As Integer)
    Dim aux As Integer

    aux = Inp(puerto)
    aux = aux Or 8          'Bit D3 en 1
    Out puerto, aux

End Sub

Sub VppOff(ByVal puerto As Integer)
    Dim aux As Integer

    aux = Inp(puerto)
    aux = aux And (Not 8)          'Bit D3 en 0
    Out puerto, aux

End Sub

Sub VddOn(ByVal puerto As Integer)
    Dim aux As Integer

    aux = Inp(puerto)
    aux = aux Or 4          'Bit D2 en 1
    Out puerto, aux

End Sub

Sub VddOff(ByVal puerto As Integer)
    Dim aux As Integer

    aux = Inp(puerto)
    aux = aux And (Not 4)          'Bit D2 en 0
    Out puerto, aux

End Sub

Sub DataOn(ByVal puerto As Integer)
    Dim aux As Integer

    aux = Inp(puerto)
    aux = aux Or 1          'Bit D0 en 1
    Out puerto, aux

End Sub

Sub DataOff(ByVal puerto As Integer)
    Dim aux As Integer

    aux = Inp(puerto)
    aux = aux And (Not 1)          'Bit D0 en 0
    Out puerto, aux

End Sub

Sub ClockOn(ByVal puerto As Integer)
    Dim aux As Integer

    aux = Inp(puerto)
    aux = aux Or 2          'Bit D1 en 1
    Out puerto, aux

End Sub

Sub ClockOff(ByVal puerto As Integer)
    Dim aux As Integer

    aux = Inp(puerto)
    aux = aux And (Not 2)          'Bit D1 en 0
    Out puerto, aux

End Sub

'Envio comando a pic 18F4620

Sub enviocom4(ByVal comando As Integer)
    Dim aux As Byte
    
    For aux = 0 To 3
        ClockOn (FLp.TextPor.Text)
        
        If ((comando And (2 ^ aux)) / (2 ^ aux)) = 1 Then
            DataOn (FLp.TextPor.Text)
        Else
            DataOff (FLp.TextPor.Text)
        End If
        Retardo (p3)
        ClockOff (FLp.TextPor.Text)         'Bit de comando leido por pic
        Retardo (p4)
        DataOff (FLp.TextPor.Text)
        
    Next aux
    
   Retardo (p5)
   
End Sub


'Envio dato a pic 18F4620

Sub enviodato16(ByVal dato As Long)
    Dim aux As Byte
    
    For aux = 0 To 15
        ClockOn (FLp.TextPor.Text)
        
        If ((dato And (2 ^ (aux - 1))) / (2 ^ (aux - 1))) = 1 Then
            DataOn (FLp.TextPor.Text)
        Else
            DataOff (FLp.TextPor.Text)
        End If
        Retardo (p3)
        ClockOff (FLp.TextPor.Text)         'Bit de dato leido por pic
        Retardo (p4)
        DataOff (FLp.TextPor.Text)
    
    Next aux
    
    Retardo (p6)
    
End Sub


'Leo dato del pic 18F4620

Function leodato16() As Integer
    Dim aux As Byte
    Dim dato As Integer
    
    dato = 0
    
    For aux = 0 To 15
        ClockOn (FLp.TextPor.Text)
        Retardo (p3)
        ClockOff (FLp.TextPor.Text)         'Bit escrito por pic
        
        If aux = 7 Then                     'Separación para lectura del byte
            Retardo (p6)
        Else
            Retardo (p4)
        End If
              
        If aux > 7 Then
            dato = dato + ValorS6(FLp.TextPor.Text) * (2 ^ (aux - 8))
        End If
    
    Next aux
    
    Retardo (p6)
    
    leodato16 = dato

End Function