elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Security Series.XSS. [Cross Site Scripting]


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [Source] CopyNew VB		0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Source] CopyNew VB  (Leído 2,284 veces)
The Swash

Desconectado Desconectado

Mensajes: 194


Programmer


Ver Perfil WWW
[Source] CopyNew VB
« en: 21 Enero 2010, 18:13 pm »
Gracias a todos por sus comentarios.
@ BlackZeroX que mensajes subliminales  :rolleyes: XD
En base a lo que un dia me dijiste.. el comando Kill depende de que el archivo sea normal para poder eliminarlo asi que decidi verificar con GetFileAttributes y eliminar con DeleteFile.

Codigo Actualizado:
Código:
'***************************************************************
'* Coded By BlackZeroX & The Swash Updated 21/01/2010.         *
'* Function copy using Other method.                           *
'* Web: http://Infrangelux.sytes.net & www.indetectables.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                 *
'***************************************************************
Option Explicit

Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
Const CREATE_NEW = 1
Const OPEN_EXISTING = 3
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FExist Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long

Public Function CopyNew(OldPath As String, NewPath As String) As Long

Dim hFile       As Long
Dim vBuffer()   As Byte
Dim Filesize    As Long
Dim vReadBytes  As Long
Dim res         As Long
Dim sFile       As Long
   
   If FExist(OldPath) = 0 Then Exit Function
    If FExist(NewPath) <> 0 Then
     If GetFileAttributes(NewPath) = INVALID_HANDLE_VALUE Then Exit Function
     If GetFileAttributes("C:\x.exe") = FILE_ATTRIBUTE_ARCHIVE Then DeleteFile NewPath
    End If
     
     hFile = CreateFile(OldPath, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
     If hFile > 0 Then
        Filesize = GetFileSize(hFile, 0)
        ReDim vBuffer(1 To Filesize)
        res = ReadFile(hFile, vBuffer(1), UBound(vBuffer), vReadBytes, ByVal 0&)
        sFile = CreateFile(NewPath, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, CREATE_NEW, 0, 0)
        WriteFile sFile, vBuffer(1), UBound(vBuffer), vReadBytes, ByVal 0&
        Call CloseHandle(hFile)
        Call CloseHandle(sFile)
     End If
     If FExist(NewPath) <> 0 Then CopyNew = 1

End Function

Reprovad0:
Código:
Private Sub Command1_Click()
 If CopyNew("C:\x.exe", "C:\cd.exe") = 1 Then
  MsgBox "File copied"
  Else
  MsgBox "File not copied"
 End If
End Sub

Scan:

File Info

Report generated: 20.1.2010 at 22.51.51 (GMT 1)
Filename: Project1.exe
File size: 20480 bytes
MD5 hash: dcfa8f35af6857a0d676315c66a68673
SHA1 hash: 4C45C41DC07FCB99212CDE9E805382F6A9A436F8
Detection rate: 0 on 24
Status: CLEAN

Detections

a-squared - - Nothing Found!
Avira AntiVir - - Nothing Found!
Avast - - Nothing Found!
AVG - - Nothing Found!
BitDefender - - Nothing Found!
ClamAV - - Nothing Found!
Comodo - - Nothing Found!
Dr.Web - - Nothing Found!
Ewido - - Nothing Found!
F-PROT6 - - Nothing Found!
G-Data - - Nothing Found!
Ikarus T3 - - Nothing Found!
Kaspersky - - Nothing Found!
McAfee - - Nothing Found!
NOD32 v3 - - Nothing Found!
Norman - - Nothing Found!
Panda - - Nothing Found!
QuickHeal - - Nothing Found!
Solo Antivirus - - Nothing Found!
Sophos - - Nothing Found!
TrendMicro - - Nothing Found!
VBA32 - - Nothing Found!
VirusBuster - - Nothing Found!
ZonerAntivirus - - Nothing Found!

Scan report generated by
NoVirusThanks.org[/quote]
En línea
cobein


Desconectado Desconectado

Mensajes: 759



Ver Perfil WWW
Re: [Source] CopyNew VB
« Respuesta #1 en: 21 Enero 2010, 20:47 pm »
En mi opinion necesita un poco mas de trabajo la funcion.

Código:
    If FExist(NewPath) <> 0 Then
     If GetFileAttributes(NewPath) = INVALID_HANDLE_VALUE Then Exit Function
     If GetFileAttributes("C:\x.exe") = FILE_ATTRIBUTE_ARCHIVE Then DeleteFile NewPath
    End If

Aca aparenetemente se te quedo algo del codigo de testeo.

Código:
     hFile = CreateFile(OldPath, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
     If hFile > 0 Then
        Filesize = GetFileSize(hFile, 0)
        ReDim vBuffer(1 To Filesize)
        res = ReadFile(hFile, vBuffer(1), UBound(vBuffer), vReadBytes, ByVal 0&)
        sFile = CreateFile(NewPath, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, CREATE_NEW, 0, 0)
        WriteFile sFile, vBuffer(1), UBound(vBuffer), vReadBytes, ByVal 0&
        Call CloseHandle(hFile)
        Call CloseHandle(sFile)
     End If
     If FExist(NewPath) <> 0 Then CopyNew = 1

Esta necesita un poco de organizacion, el segundo handle por ejemplo (archivo de destino) nunca se verifica el valor de retorno y algunas cositas como en vez de verificar que el archivo de destino existe, podrias ver que writefile haya escrito la cantidad de bytes que se leyeron (en mi opinion tiene mas logica) y una cosa mas que podrias hacer es copiar los atributos.
En línea
http://www.advancevb.com.ar
Más Argentino que el morcipan
Aguante el Uvita tinto, Tigre, Ford y seba123neo
Karcrack es un capo.
The Swash

Desconectado Desconectado

Mensajes: 194


Programmer


Ver Perfil WWW
Re: [Source] CopyNew VB
« Respuesta #2 en: 22 Enero 2010, 00:43 am »
Código:
'***************************************************************
'* Coded By BlackZeroX & The Swash Updated 21/01/2010.         *
'* Function copy using Other method.                           *
'* Web: http://Infrangelux.sytes.net & www.indetectables.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                 *
'***************************************************************
Option Explicit

Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
Const CREATE_NEW = 1
Const OPEN_EXISTING = 3
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20

Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function PathFileExistsA Lib "shlwapi.dll" (ByVal pszPath As String) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long

Public Function CopyNew(aPath As String, nPath As String) As Long

Dim vBuffer()   As Byte
Dim Filesize    As Long
Dim vReadBytes  As Long
Dim res         As Long
Dim sFile       As Long
Dim RetDel      As Long
   
    If Not PathFileExistsA(aPath) = 0 Then
     If GetFileAttributes(nPath) = FILE_ATTRIBUTE_ARCHIVE Then RetDel = 1
        Call DeleteFile(nPath)
        If RetDel > 0 Then
         
         sFile = CreateFile(aPath, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, ByVal 0&, ByVal 0&)
         Filesize = GetFileSize(sFile, 0)
         ReDim vBuffer(1 To Filesize)
         
         res = ReadFile(sFile, vBuffer(1), UBound(vBuffer), vReadBytes, ByVal 0&)
         sFile = CreateFile(nPath, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, CREATE_NEW, 0, 0)
         WriteFile sFile, vBuffer(1), UBound(vBuffer), vReadBytes, ByVal 0&
         
         If Len(res) = Len(sFile) Then
          SetFileAttributes nPath, GetFileAttributes(aPath)
          CopyNew = 1
         End If
         Call CloseHandle(sFile)
     
     End If
    End If
End Function

Uso:
Código:
Private Sub cmdTest_Click()
  If CopyNew("C:\z.exe", "C:\xd.exe") = 1 Then
   MsgBox "done"
   Else
   MsgBox "fail"
  End If
End Sub

Otro uso:
Código:
Private Sub cmdTest_Click()
  MsgBox IIf(CopyNew("C:\z.exe", "C:\xd.exe") = 1,"Done","Fail")
End Sub

@BlackZeroX Gracias por tus ideas para la optimizacion cada una sirvio!

@Cobein es un capo! xD, gracias por tus recomendaciones cada una fue aplicada, el code trabaja en cualquier situacion ^^.
En línea
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [Source] CopyNew VB
« Respuesta #3 en: 22 Enero 2010, 01:16 am »
.
Sigue estando mal xP

El archivo Source JAMAS LO CIERRAS
La logica de si existe y borrar esta mal xS, mas enconcreto la linea If RetDel > 0 Then

Aqui esta algo que hice (Aun que ya te lo había enseñado pongo):

Código
  1.  
  2. '
  3. ' ////////////////////////////////////////////////////////////////
  4. ' // Autores: BlackZeroX ( Ortega Avila Miguel Angel )          //
  5. ' //          The Swash  ( Idea Principal )                     //
  6. ' //                                                            //
  7. ' // Web: http://InfrAngeluX.Sytes.Net/                         //
  8. ' //                                                            //
  9. ' // |-> Pueden Distribuir Este Código siempre y cuando         //
  10. ' // no se eliminen los créditos originales de este código      //
  11. ' // No importando que sea modificado/editado o engrandecido    //
  12. ' // o achicado, si es en base a este código                    //
  13. ' // |-> Si usas el codigo para algun fin da los Creditos       //
  14. ' //       repectivos asi seguiremos liberando Source           //
  15. ' ////////////////////////////////////////////////////////////////
  16.  
  17. Option Explicit
  18. '   //  Globales
  19. Const INVALID_HANDLE_VALUE = -1
  20. '   //  Para Archivos y similares
  21. Const FILE_ATTRIBUTE_ARCHIVE = &H20
  22. Const FILE_ATTRIBUTE_DIRECTORY = &H10
  23. Const FILE_ATTRIBUTE_HIDDEN = &H2
  24. Const FILE_ATTRIBUTE_NORMAL = &H80
  25. Const FILE_ATTRIBUTE_READONLY = &H1
  26. Const FILE_ATTRIBUTE_SYSTEM = &H4
  27. Const FILE_ATTRIBUTE_TEMPORARY = &H100
  28. '   //  Tratadod de Archivos
  29. Const FILE_BEGIN = 0
  30. Const FILE_SHARE_READ = &H1
  31. Const FILE_SHARE_WRITE = &H2
  32. Const CREATE_NEW = 1
  33. Const OPEN_EXISTING = 3
  34. Const GENERIC_READ = &H80000000
  35. Const GENERIC_WRITE = &H40000000
  36.  
  37. '   //  Declaracion de Apis
  38. Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
  39. Private Declare Function CreateFileA Lib "kernel32" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
  40. Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
  41. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  42. Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
  43. Private Declare Function DeleteFileA Lib "kernel32" (ByVal lpFileName As String) As Long
  44. Private Declare Function PathFileExistsA Lib "shlwapi.dll" (ByVal pszPath As String) As Long
  45. Private Declare Function GetFileAttributesA Lib "kernel32" (ByVal lpFileName As String) As Long
  46. Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
  47. Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
  48.  
  49. Public Function XCopyFile(ByVal strSource As String, ByVal strDest As String, Optional ByVal ReplaceFile As Boolean = False, Optional CopyAttributes As Boolean = True) As Long
  50. Dim FileDestAttributes          As Long
  51.     If GetFileAttributesA(strSource) And FILE_ATTRIBUTE_ARCHIVE Then
  52.         FileDestAttributes = GetFileAttributesA(strDest)
  53.         If ReplaceFile And (Not FileDestAttributes = INVALID_HANDLE_VALUE) Then
  54.             If FileDestAttributes And FILE_ATTRIBUTE_ARCHIVE Then
  55.                 SetFileAttributes strDest, FILE_ATTRIBUTE_NORMAL  '   //  Por si las Moscas xP
  56.                 FileDestAttributes = DeleteFileA(strDest)
  57.             End If
  58.             If Not FileDestAttributes > 0 And ReplaceFile Then Exit Function
  59.         End If
  60.         XCopyFile = XWriteFileByte(strDest, XReadFileByte(strSource), , ReplaceFile, True)
  61.         If XCopyFile And CopyAttributes Then SetFileAttributes strDest, GetFileAttributesA(strSource)
  62.     End If
  63. End Function
  64.  
  65. Public Function XReadFile(strSource As String, Optional ByteIni As Long = 1, Optional LenBuffer As Long = -1) As String
  66. On Error Resume Next
  67.     XReadFile = StrConv(XReadFileByte(strSource, ByteIni, LenBuffer), vbUnicode)
  68. End Function
  69. Public Function XReadFileByte(strSource As String, Optional ByteIni As Long = 1, Optional LenBuffer As Long = 0) As Byte()
  70. Dim hFile           As Long
  71. Dim vBuffer()       As Byte
  72. Dim LFilesize       As Long
  73. Dim vReadBytes      As Long
  74. Dim ResPointerFile  As Long
  75.  
  76.     If GetFileAttributesA(strSource) And FILE_ATTRIBUTE_ARCHIVE Then
  77.         hFile = CreateFileA(strSource, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
  78.         If Not hFile = INVALID_HANDLE_VALUE Then
  79.             ResPointerFile = 1
  80.             If ByteIni > 1 Then
  81.                 ResPointerFile = SetFilePointer(hFile, ByteIni - 1, 0, FILE_BEGIN)
  82.             End If
  83.             If ResPointerFile Then
  84.                 LFilesize = GetFileSize(hFile, 0)
  85.                 If LenBuffer > 0 And LenBuffer < LFilesize Then
  86.                     LFilesize = LFilesize - ByteIni + 1
  87.                     If LenBuffer + ByteIni < LFilesize Then
  88.                         LFilesize = LenBuffer
  89.                     End If
  90.                 End If
  91.                 ReDim vBuffer(LFilesize)
  92.                 If ReadFile(hFile, vBuffer(LBound(vBuffer)), UBound(vBuffer), vReadBytes, ByVal 0&) Then
  93.                     XReadFileByte = vBuffer
  94.                 End If
  95.             End If
  96.             Call CloseHandle(hFile)
  97.         End If
  98.     End If
  99. End Function
  100. Public Function XWriteFile(srtSource As String, vDataWrite As String, Optional ByteIni As Long = 1, Optional RemplaceData As Boolean = False, Optional CreateFile As Boolean = True) As Long
  101. On Error Resume Next
  102. Dim vArray()        As Byte
  103.     vArray = StrConv(vDataWrite, vbFromUnicode)
  104.     ReDim Preserve vArray(UBound(vArray) + 1)
  105.     XWriteFile = XWriteFileByte(srtSource, vArray, ByteIni, RemplaceData, CreateFile)
  106. End Function
  107. Public Function XWriteFileByte(srtSource As String, vDataWrite() As Byte, Optional ByteIni As Long = 1, Optional RemplaceData As Boolean = False, Optional CreateFile As Boolean = True) As Long
  108. Dim hFile           As Long
  109. Dim LDataSize       As Long
  110. Dim vWriteBytes     As Long
  111. Dim FileSize        As Long
  112.  
  113.     If Not ((Not vDataWrite) = -1) Then
  114.         LDataSize = UBound(vDataWrite) - LBound(vDataWrite)
  115.         If LDataSize >= 0 And ByteIni > 0 Then
  116.             If CreateFile And (PathFileExistsA(srtSource) = False) Then
  117.                 hFile = CreateFileA(srtSource, GENERIC_WRITE, FILE_SHARE_WRITE, ByVal 0&, CREATE_NEW, 0, 0)
  118.             ElseIf GetFileAttributesA(srtSource) And FILE_ATTRIBUTE_ARCHIVE And (RemplaceData Or ByteIni > 0) Then
  119.                 hFile = CreateFileA(srtSource, GENERIC_WRITE, FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
  120.             Else
  121.                 hFile = INVALID_HANDLE_VALUE
  122.             End If
  123.             If Not hFile = INVALID_HANDLE_VALUE Then
  124.             FileSize = GetFileSize(hFile, ByVal 0&)
  125.                 If ByteIni >= FileSize Then
  126.                     ByteIni = FileSize + 1
  127.                 End If
  128.                 If ByteIni > 1 Then
  129.                     SetFilePointer hFile, ByteIni - 1, 0, FILE_BEGIN
  130.                 End If
  131.                 XWriteFileByte = WriteFile(hFile, vDataWrite(LBound(vDataWrite)), UBound(vDataWrite), vWriteBytes, ByVal 0&)
  132.                 Call CloseHandle(hFile)
  133.             End If
  134.         End If
  135.     End If
  136. End Function
  137.  
  138.  


Forma de uso:

Código
  1.  
  2. Sub main()
  3. Dim Datos               As String
  4. Dim ResXCopy            As Boolean
  5. Const StrFile1          As String = "c:\archivox.txt"
  6. Const StrFile2          As String = "c:\archivoY.txt"
  7. Const MSG               As String = "Hola"
  8.     ResXCopy = XCopyFile(StrFile1, StrFile2, True, True)      '   //  Copiamos, reemplazamos y pegamos atributos al destino
  9.     Debug.Print "Copy " & IIf(ResXCopy, "Ok", "Fail")   '   //  Presentamos
  10.     Datos = XReadFile(StrFile1)                         '   //  leemos todo el archivo
  11.     Debug.Print "ReadALlFile " & Datos
  12.     Datos = XReadFile(StrFile1, , 5)                    '   //  leemos Solo los 5 primeros bytes
  13.     Debug.Print "ReadALlFile " & Datos
  14.     Datos = XReadFile(StrFile1, 7)                      '   //  leemos desde la posicion numero 7
  15.     Debug.Print "ReadALlFile " & Datos
  16.     Datos = XReadFile(StrFile1, 7, 2)                   '   //  leemos dos datos
  17.     Debug.Print "ReadALlFile " & Datos
  18.     If XWriteFile(StrFile2, MSG, 5, , True) Then Debug.Print "WriteFileOk"
  19. End Sub
  20.  
  21.  

Ojo en la funciones Read el ultimo caracter es un byte 0 o caracter NUll (se debe a que use un array desde Index 0 xP y no desde 1, uan que el XCopyFile trabaja bien, sin agregar nada)

P.D.: Estoy trabajando en un modulo de clase para mejorarlo (cuando lo termine lo posteo), mientras el código de arriba funciona para lo que se desea.

Temible Lunas!¡.
.
« Última modificación: 22 Enero 2010, 02:53 am por ░▒▓BlackZeroҖ▓▒░ » En línea
The Dark Shadow is my passion.
The Swash

Desconectado Desconectado

Mensajes: 194


Programmer


Ver Perfil WWW
Re: [Source] CopyNew VB
« Respuesta #4 en: 22 Enero 2010, 15:31 pm »
Código:
'***************************************************************
'* Coded By BlackZeroX & The Swash Updated 21/01/2010.         *
'* Function copy using Other method.                           *
'* Web: http://Infrangelux.sytes.net & www.indetectables.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                 *
'***************************************************************
Option Explicit

Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
Const CREATE_NEW = 1
Const OPEN_EXISTING = 3
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20

Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function PathFileExistsA Lib "shlwapi.dll" (ByVal pszPath As String) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long

Public Function CopyNew(aPath As String, nPath As String) As Long

Dim vBuffer()   As Byte
Dim Filesize    As Long
Dim vReadBytes  As Long
Dim res         As Long
Dim sFile       As Long
Dim RetDel      As Long
   
    If Not PathFileExistsA(aPath) = 0 Then
      If GetFileAttributes(nPath) = FILE_ATTRIBUTE_ARCHIVE Then
        RetDel = DeleteFile(nPath)
        If RetDel = 0 Then Exit Function
        End If
         
         sFile = CreateFile(aPath, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, ByVal 0&, ByVal 0&)
         Filesize = GetFileSize(sFile, 0)
         ReDim vBuffer(1 To Filesize)
         
         res = ReadFile(sFile, vBuffer(1), UBound(vBuffer), vReadBytes, ByVal 0&)
         CloseHandle sFile

         sFile = CreateFile(nPath, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, CREATE_NEW, 0, 0)
         WriteFile sFile, vBuffer(1), UBound(vBuffer), vReadBytes, ByVal 0&
         
         If Len(res) = Len(sFile) Then
          SetFileAttributes nPath, GetFileAttributes(aPath)
          CopyNew = 1
         End If
         Call CloseHandle(sFile)
     
     End If
    
End Function

@ BlackZeroX que gay  :-X , tenias razon en cuanto a la hora de borrar archivos ahora va de 10!, en cuanto al handle pues lo cierro cuando termina la primera parte y lo cierro cuando termina la segunda.. Haber con que me sales ahora xD
¬¬''
Salu2  ;D
« Última modificación: 22 Enero 2010, 15:40 pm por The Swash » En línea
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines