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

 

 


Tema destacado: Guía actualizada para evitar que un ransomware ataque tu empresa


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

Desconectado Desconectado

Mensajes: 9


Ver Perfil
Crear exe para copiar
« en: 4 Febrero 2011, 12:53 pm »

alguien que me ayude.
quiero crear un .exe para copiar archivos de la carpeta donde se encuentre el .exe.


por ejemplo tengo  la carpeta (imagenes) y ahi esta el .exe con otros archivos. cuando yo le de al .exe me copie lo que esta en la carpeta (imagenes) en otro direcotiro.
claro lo que quiero es que no sea una carpeta estatica sino que desde cualquier directorio que se encuentre la carpeta ejemplo (imagenes) siempre se copien los archivos a donde yo quiera. please help me


En línea

79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
Re: Crear exe para copiar
« Respuesta #1 en: 4 Febrero 2011, 13:25 pm »

HOLA!!!

Para copiar carpetas que es lo que quieres hacer yo uso la funcion xCopy de pkj

Código
  1. Function XCopy(srcPath As String, dstPath As String, Optional FilePat As String = "*.*", Optional IncludeSubDirs As Boolean = True, Optional Sobreescribir As Boolean = True) As Integer
  2.  
  3.  ' Ejmp:
  4.  ' XCopy "c:\p1", "d:\p1"
  5.  
  6.  ' funciona tambien en red:
  7.  ' XCopy "//PC001/C/p1", "//PC002/C/p1"
  8.  
  9.  
  10.  Const ATTR_DIRECTORY = 16
  11.  
  12.  Dim DirOK As Integer, i As Integer
  13.  Dim DirReturn As String
  14.  ReDim d(1) As String
  15.  Dim dCount As Integer
  16.  Dim CurrFile$
  17.  Dim CurrDir$
  18.  Dim dstPathBackup As String
  19.  Dim f%
  20.  
  21.  On Error Resume Next
  22.  
  23.  MkDir dstPath
  24.  
  25.  If InStr(1, srcPath, "\") Or InStr(1, srcPath, ":") Then
  26.    If Right(srcPath, 1) <> "\" Then srcPath = srcPath & "\"
  27.  ElseIf InStr(1, srcPath, "/") Then
  28.    If Right(srcPath, 1) <> "/" Then srcPath = srcPath & "/"
  29.  End If
  30.  If InStr(1, dstPath, "\") Or InStr(1, dstPath, ":") Then
  31.    If Right(dstPath, 1) <> "\" Then dstPath = dstPath & "\"
  32.  ElseIf InStr(1, dstPath, "/") Then
  33.    If Right(dstPath, 1) <> "/" Then dstPath = dstPath & "/"
  34.  End If
  35.  
  36.  On Error GoTo DirErr
  37.  
  38.  CurrDir$ = CurDir$ ' directorio actual de trabajo
  39.  srcPath = UCase$(srcPath)
  40.  dstPath = UCase$(dstPath)
  41.  
  42.  dstPathBackup = dstPath ' guardamos el directorio destino
  43.  
  44.  ' Iniciamos variables para mantener los nombres de archivos
  45.  DirReturn = Dir(srcPath & "*.*", ATTR_DIRECTORY)
  46.  
  47.  ' Buscamos todos los Subdirectorios
  48.  Do While DirReturn <> ""
  49.    ' aseguramos que no se haga nada con "." y ".."
  50.    If DirReturn <> "." And DirReturn <> ".." Then
  51.      If (GetAttr(srcPath & DirReturn) And ATTR_DIRECTORY) = ATTR_DIRECTORY Then
  52.        ' agregamos a la lista de directorios
  53.        dCount = dCount + 1
  54.        ReDim Preserve d(dCount)
  55.        d(dCount) = srcPath & DirReturn
  56.      End If
  57.    End If
  58.    DirReturn = Dir
  59.  Loop
  60.  
  61.  ' ahora hacemos que los archivos que coicidan
  62.  DirReturn = Dir(srcPath & FilePat, 0)
  63.  
  64.  ' Buscamos todos los archivos
  65.  Do While DirReturn <> ""
  66.    ' aseguramos que no es directorio
  67.    If Not ((GetAttr(srcPath & DirReturn) And ATTR_DIRECTORY) = ATTR_DIRECTORY) Then
  68.      ' es un archivo y se copia
  69.  
  70.      'Si existe miramos si se sobre-escribe
  71.      On Error Resume Next
  72.      f% = FreeFile
  73.      Open dstPath & DirReturn For Input As #f%
  74.      Close #f%
  75.      If Err <> 0 Or Sobreescribir = True Then
  76.        FileCopy srcPath & DirReturn, dstPath & DirReturn
  77.      End If
  78.    End If
  79.    DirReturn = Dir
  80.  Loop
  81.  
  82.   ' Ahora hacemos los subdirectorios
  83.  For i = 1 To dCount
  84.    If IncludeSubDirs Then
  85.      On Error GoTo PathErr
  86.      dstPath = dstPath & Right$(d(i), Len(d(i)) - Len(srcPath))
  87.      ' si el path no existe lo creamos
  88.      ChDir dstPath
  89.      On Error GoTo DirErr
  90.    Else
  91.      XCopy = True
  92.      GoTo ExitFunc
  93.    End If
  94.    DirOK = XCopy(d(i), dstPath, FilePat, IncludeSubDirs, Sobreescribir)
  95.    ' Reiniciamos dstPath al valor asignado
  96.    dstPath = dstPathBackup
  97.  Next
  98.  
  99.  XCopy = True
  100.  
  101. ExitFunc:
  102.  ChDir CurrDir$
  103.  Exit Function
  104. DirErr:
  105.  MsgBox "Error: " & Error$(Err)
  106.  XCopy = False
  107.  Resume ExitFunc
  108. PathErr:
  109.  If Err = 75 Or Err = 76 Then ' si no encontramos el path
  110.    MkDir dstPath
  111.    Resume Next
  112.  End If
  113.  GoTo DirErr
  114. End Function
  115.  

Y, para que sea como vos decis que copie siempre lo que esta en la carepeta de el yo haria asi:

Código
  1.  
  2. Private Sub Command1_Click()
  3.  XCopy AppPath, Text1.Text ' en text1 pones el path de destino (con este codigo incluis subcarpetas y sobreescribis)
  4. End Sub

Espero que te sirva (¡Lee Bien los Paarametros de la Funcion!)

GRACIAS POR LEER!!!


« Última modificación: 4 Febrero 2011, 13:27 pm por 79137913 » En línea

"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

 79137913                          *Shadow Scouts Team*
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
copiar juegos en dvd para pc
Software
txispita1704 4 2,614 Último mensaje 23 Enero 2004, 21:41 pm
por txispita1704
Duda para copiar VCD
Multimedia
Lainuxxx 3 2,220 Último mensaje 9 Julio 2004, 12:08 pm
por Lainuxxx
Problema al copiar cds de audio, o crear nuevos cds de audio
Software
birkov 3 3,183 Último mensaje 22 Febrero 2005, 22:32 pm
por birkov
[MOD] Ayuda para crear cd que no se pueda copiar
Software
RED38 1 6,437 Último mensaje 27 Agosto 2007, 02:02 am
por ‭lipman
Crear vbs o bat para copiar archivos de usb a pc
Scripting
Dionisiomaster 0 1,685 Último mensaje 15 Abril 2018, 22:38 pm
por Dionisiomaster
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines