0 Usuarios y 1 Visitante están viendo este tema.
'' ////////////////////////////////////////////////////////////////' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) //' // //' // Web: http://InfrAngeluX.Sytes.Net/ //' // //' // |-> Pueden Distribuir Este Código siempre y cuando //' // no se eliminen los créditos originales de este código //' // No importando que sea modificado/editado o engrandecido //' // o achicado, si es en base a este código //' // |-> Si usas el código para algún fin da los Créditos //' // respectivos así seguiremos liberando Source //' ////////////////////////////////////////////////////////////////Option ExplicitPublic Function xCopyVBasic(ArchivoOrigen As String, ArchivoDestino As String, Optional CopyAtributes As Boolean = True, Optional ReemplaceFile As Boolean = False) As LongOn Error GoTo ErrorFatal: ' // Ocasiona error este cuando el archivo Origen/Destino este abierto y no pueda Abrir/Crear/EscribirDim ff(1) As IntegerDim Bytes() As ByteDim lenBytesFile As LongDim ExitsFile(1) As BooleanConst InvalidByte As Long = -1 xCopyVBasic = InvalidByte ' // Ponemos de una buena ves el valor de error lenBytesFile = InvalidByte ' // Es un pequeño seguro ExitsFile(0) = Not Dir(ArchivoOrigen, vbArchive) = "" ExitsFile(1) = Not Dir(ArchivoDestino, vbArchive) = "" If ExitsFile(0) Then ff(0) = FreeFile Open ArchivoOrigen For Binary As ff(0) If ReemplaceFile = True And ExitsFile(1) Then Call SetAttr(ArchivoDestino, vbNormal) Call Kill(ArchivoDestino) ExitsFile(1) = Not ExitsFile(1) End If If ExitsFile(1) = False Then ' // Se puede quitar este if then pero lo dejo por las dudas (puede ocurrir algo xP). ff(1) = FreeFile Open ArchivoDestino For Binary As ff(1) lenBytesFile = LOF(ff(0)) ' // Hacemos la longitud exacta del archivo en el array If lenBytesFile > 0 Then ReDim Bytes(lenBytesFile - 1) Get ff(0), 1, Bytes() Put ff(1), 1, Bytes() Erase Bytes() End If xCopyVBasic = lenBytesFile End If ' // Este se puede quitar siempre y cuando el it then del mismo nivel sea removido.ErrorFatal: Close ff(1) Close ff(0) If Err.Number = 0 And CopyAtributes And Not lenBytesFile = InvalidByte Then Call SetAttr(ArchivoDestino, GetAttr(ArchivoOrigen)) End If End IfEnd Function
'' ////////////////////////////////////////////////////////////////' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) //' // //' // Web: http://InfrAngeluX.Sytes.Net/ //' // //' // |-> Pueden Distribuir Este Código siempre y cuando //' // no se eliminen los créditos originales de este código //' // No importando que sea modificado/editado o engrandecido //' // o achicado, si es en base a este código //' // |-> Si usas el código para algún fin da los Créditos //' // respectivos así seguiremos liberando Source //' ////////////////////////////////////////////////////////////////Option ExplicitSub Main()Const archivo1 As String = "C:\aaa.txt"Const archivo2 As String = "C:\bbb.txt"Dim vRes As Long vRes = xCopyVBasic(archivo1, archivo2, True, True) MsgBox IIf(Not vRes = -1, "Todo esta bien" & vbCrLf & "Se a copiado un archivo de " & vRes & " Bytes", "a fallado la funcion")End Sub