VERSION 5.00
Object = "{0F987290-56EE-11D0-9C43-00A0C90F29FC}#1.0#0"; "ActBar.ocx"
Object = "{9FE8BEE1-8569-4532-8518-BB32F08FC1EB}#2.0#0"; "dtF4.ocx"
Begin VB.Form FCO5030 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Archivos DIAN"
   ClientHeight    =   1905
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   4680
   BeginProperty Font 
      Name            =   "Arial"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "FCO5030 Archivos DIAN.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   1905
   ScaleWidth      =   4680
   Begin VB.CheckBox chkXML 
      Caption         =   "Generar en formato XML"
      Height          =   255
      Left            =   1320
      TabIndex        =   6
      Top             =   1440
      Visible         =   0   'False
      Width           =   2175
   End
   Begin VB.TextBox txtRuta 
      BackColor       =   &H8000000F&
      Height          =   315
      Left            =   240
      Locked          =   -1  'True
      TabIndex        =   4
      Top             =   960
      Width           =   3975
   End
   Begin DataTec_F4.dtF4 dtF41 
      Height          =   255
      Left            =   4320
      TabIndex        =   3
      Top             =   960
      Width           =   255
      _ExtentX        =   450
      _ExtentY        =   450
   End
   Begin VB.TextBox txtAnio 
      Height          =   315
      Left            =   720
      MaxLength       =   4
      TabIndex        =   1
      Top             =   240
      Width           =   735
   End
   Begin VB.Label lblProgreso 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Procesando..."
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   240
      Left            =   1680
      TabIndex        =   5
      Top             =   240
      Width           =   1215
   End
   Begin ActiveBarLibraryCtl.ActiveBar abToolbar 
      Left            =   240
      Top             =   1320
      _ExtentX        =   847
      _ExtentY        =   847
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Bands           =   "FCO5030 Archivos DIAN.frx":030A
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "En la ruta:"
      Height          =   210
      Index           =   1
      Left            =   240
      TabIndex        =   2
      Top             =   720
      Width           =   720
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Año:"
      Height          =   210
      Index           =   0
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   345
   End
End
Attribute VB_Name = "FCO5030"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private MAdo As ODBC.ODBCDirecto
Private MiCx As Integer 'Conexión

Private Sub abToolbar_Click(ByVal Tool As ActiveBarLibraryCtl.Tool)
    Select Case LCase(Tool.Name)
        Case "tlpreview": Procesa
        Case "tlsalida": Unload Me
    End Select
End Sub

Private Sub dtF41_Click()
    Dim sRuta As String
    sRuta = BrowseForFolder(txtRuta, Me.hwnd, "&Seleccione una carpeta:")
    If Trim(sRuta) <> "" Then
        txtRuta = sRuta
        GuardarIni "FCO.ini", "DIAN", "Carpeta", txtRuta
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyF3: Unload Me
        Case vbKeyF4: If LCase(ActiveControl.Name) = "txtruta" Then dtF41_Click
    End Select
End Sub

Private Sub Form_Load()
    lblProgreso = ""
    
    GbAError = False
    Me.Tag = GiVenMax%
    Gven(Val(Me.Tag)).icx = Gicx%
    MiCx = Gven(Val(Me.Tag)).icx
    Set MAdo = Gtc(MiCx).Ado
        
    Width = 4800
    Height = 2655
    Caption = GsDsn & " / " & GsCveCia & " - Archivos DIAN"
    
    AsignaIconos abToolbar, 3, LPREVIEW, LSALIDA
    
    txtAnio = Year(Date) - 1
    txtRuta = sLeerIni("FCO.ini", "DIAN", "Carpeta")
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set MAdo = Nothing
    Gtc(MiCx).ihijas = Gtc(MiCx).ihijas - 1
    Set FCO5030 = Nothing
End Sub

Private Sub txtAnio_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        On Error Resume Next
        dtF41.SetFocus
    Else
        KeyAscii = iValidarDato(KeyAscii, "0123456789", True, True)
    End If
End Sub

Private Sub Procesa()
    Dim bUsarTemp As Boolean
    Dim sRutaLocal As String
    Dim f As FileSystemObject
    Dim t As TextStream
    Dim sRuta As String
    Dim sFormato(1 To 4) As String
    Dim i As Byte
    Dim sArchivo As String
    Dim x As Long

    If Val(txtAnio) = 0 Then
        clsMsgbox.Mensaje "Año no válido", mAceptar, mAdvierte, GsTitMsg
        On Error Resume Next
        txtAnio.SetFocus
        Exit Sub
    End If
    
    lblProgreso = "Procesando información..."
    DoEvents
    
    Screen.MousePointer = vbHourglass
    
    sFormato(1) = "1001"
    sFormato(2) = "1002"
    sFormato(3) = "1009"
    sFormato(4) = "1008"
    
    If Trim(txtRuta) = "" Then txtRuta = "c:\"

    If UCase(sParametroFDT(MAdo, "otros", "COL", 99)) = "SI" Then
        bUsarTemp = True
        MAdo.Sql = "SELECT dato_largo FROM vw_fdt_parametros" & _
        " WHERE pais = 'COL' AND compania = '" & GsCveCia & "'" & _
        " AND parametro = 'otros' AND secuencia = 99"
        If MAdo.SendSQL Then
            sRutaLocal = MAdo.GetField(1)
        Else
            bUsarTemp = False
        End If
    Else
        bUsarTemp = False
    End If

    MAdo.Sql = "sp_fco_archivos_dian '" & GsCveCia & "', " & txtAnio
    If MAdo.ExecSQL <> -1 Then
        Set f = CreateObject("Scripting.FileSystemObject")
        If bUsarTemp Then
            If f.FolderExists(sRutaLocal) Then
                sRuta = sRutaLocal
            Else
                sRuta = "C:"
            End If
        Else
            sRuta = txtRuta
        End If
        
        For i = 1 To 4
            MAdo.Sql = _
            " SELECT registros FROM fntb_fco_dian_" & sFormato(i) & _
            " ('" & GsCveCia & "', " & txtAnio & ")" & _
            " ORDER BY secuencia"
            
            If MAdo.SendSQL Then
                If Not MAdo.EOF Then
                    'Generar el archivo
                    'Para el caso de Grasco se hace en una ruta local y luego se copia al equipo del usuario
                    sArchivo = Trim(GsCveCia) & "_" & Trim(txtAnio) & "_" & sFormato(i) & ".csv"
                    Set t = f.CreateTextFile(sRuta & IIf(Right(sRuta, 1) = "\", "", "\") & sArchivo, True)
                    Do Until MAdo.EOF
                        t.WriteLine MAdo.GetField(1)
                        MAdo.Mnext
                    Loop
                    t.Close
                    'Mover el archivo al equipo del usuario
                    If bUsarTemp Then
                        If f.FileExists(txtRuta & IIf(Right(sRuta, 1) = "\", "", "\") & sArchivo) Then
                            f.DeleteFile txtRuta & IIf(Right(sRuta, 1) = "\", "", "\") & sArchivo, True
                        End If
                        f.MoveFile sRuta & IIf(Right(sRuta, 1) = "\", "", "\") & sArchivo, txtRuta & "\" & sArchivo
                    End If
                    'Mostrar el archivo por pantalla
                    x = ShellExecute(Me.hwnd, "Open", txtRuta & IIf(Right(sRuta, 1) = "\", "", "\") & sArchivo, "", "", 1)
                End If
            End If
        Next i
        
        Set f = Nothing
    End If
    
    lblProgreso = ""
    DoEvents
    
    Screen.MousePointer = vbDefault
End Sub
