|
Artículo |
Copiando Archivos |
|
Autor / Fuente |
Harvey Triana |
|
Tema |
Programación general de manejo de archivos con Visual Basic |
|
Actualización |
Septiembre 20 de 1997 |
|
Descripción |
Rutina para copiar un archivo en código Basic |
¿Se pueden escribir un código en Basic para copiar archivos de cualquier tipo?. Pues sí, aquí les presento un ejemplo completo y funcional. ¿Porqué quisiera escribir código para copiar archivos si ya existe FileCopy?. Les enumero unas buenas razones.
Como estas, deben existir más razones. Para implementar cualquiera de estos temas debe personalizar el código, úselo como guía simplemente. El origen de este procedimiento fue la creacción de un programa de instalación personalizado (esto implementa un código más extenso dentro del procedimiento).
Comentarios
El código se muestra a continuación:
'---------------------------------------------------------------------
'Copia un archivo.
'Sintaxis
'FileCopy fuente, destino [, sobre escritura]
'Argumentos:
'SourceFile: nombre completo de un archivo a copiarse
'DestinationPath: nombre de la ruta de destino
'OverWrite: Opción de especificar sobre escritura.
'Por Harvey Triana, Petrosoft Co., 1996
'---------------------------------------------------------------------
Sub PetrosoftCopyFile(SourceFile As String, DestinationPath As String, Optional OverWrite As Variant)
Const INLINE = 2 ^ 10
Dim Tem As String
Dim i As Integer
Dim RCnl As Integer
Dim WCnl As Integer
Dim Bytes As Long
Dim Groups As Long
Dim SBytes As Long
'Este bloque verifica la sobre escritura si al archivo exise
Tem = DestinationPath + FileNameFromPath(SourceFile)
If Len(Dir(Tem)) Then
If IsMissing(OverWrite) Then
Kill Tem
Else
If OverWrite Then
Kill Tem
Else
Exit Sub
End If
End If
End If
RCnl = FreeFile
Open SourceFile For Binary Access Read As #RCnl
WCnl = FreeFile
Open Tem For Binary Access Write As #WCnl
'Copia por grupos de bytes
Bytes = LOF(RCnl)
Groups = Int((Bytes / INLINE))
SBytes = (Bytes - Groups * INLINE)
If Groups > 0 Then
For i = 1 To Groups
Tem = Input$(INLINE, #RCnl)
Put #WCnl, , Tem
Next
End If
If SBytes > 0 Then
Tem = Input$(SBytes, #RCnl)
Put #WCnl, , Tem
End If
Close RCnl, WCnl
End Sub
Public Function FileNameFromPath(Tem As String) As String
Dim x As String, i
If InStr(Tem, "\") Then
i = Len(Tem)
Do
x = Mid$(Tem, i, 1)
i = i - 1
Loop Until x = "\" Or i = 0
FileNameFromPath = Mid$(Tem, i + 2)
Else
FileNameFromPath = Tem
End If
End Function