send
Grupo de Telegram
play_arrow
  3. [VB] xCopyVBasic (Funcion Copiar archivo)
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.
« anterior próximo »
Páginas: [1]   Ir Abajo

[VB] xCopyVBasic (Funcion Copiar archivo)

  • 0 Respuestas
  • 1406 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Desconectado ProcessKill

  • *
  • Underc0der
  • Mensajes: 154
  • Actividad:
    0%
  • Reputación 0
  • Arriba los hackers de Argentina!
    • Ver Perfil
    • Email

[VB] xCopyVBasic (Funcion Copiar archivo)

« en: Febrero 22, 2010, 04:45:21 pm »
Que tal gente! Les traigo el codigo creado por BlackZeroX. Esta funcion permite copiar archivos sin ninguna modificacion en el mismo

Código: You are not allowed to view links. Register or Login
'
' ////////////////////////////////////////////////////////////////
' // 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 Explicit

Public Function xCopyVBasic(ArchivoOrigen As String, ArchivoDestino As String, Optional CopyAtributes As Boolean = True, Optional ReemplaceFile As Boolean = False) As Long
On Error GoTo ErrorFatal:           '   //  Ocasiona error este cuando el archivo Origen/Destino este abierto y no pueda Abrir/Crear/Escribir
Dim ff(1)           As Integer
Dim Bytes()         As Byte
Dim lenBytesFile    As Long
Dim ExitsFile(1)    As Boolean
Const 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 If
End Function

Modo de uso:

Código: You are not allowed to view links. Register or Login
'
' ////////////////////////////////////////////////////////////////
' // 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 Explicit
Sub 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
Sepan aprovecharlo!!

Saludos!  8)
En línea
Páginas: [1]   Ir Arriba
« anterior próximo »
 

¿Te gustó el post? COMPARTILO!



Evasión de antivirus en archivo por lotes

Iniciado por sadfud

 Respuestas: 4
Vistas: 1826 		Último mensaje Febrero 23, 2018, 01:33:26 am
por Manzana
[Funcion] sAres - Spread Ares (Basico)

Iniciado por k0ws

 Respuestas: 1
Vistas: 1326 		Último mensaje Marzo 31, 2012, 06:25:37 pm
por ANTRAX