
21/01/2008, 17:27
|
 | | | Fecha de Ingreso: marzo-2007
Mensajes: 307
Antigüedad: 18 años, 2 meses Puntos: 17 | |
Re: Como crear un Updater ya pelao,
crea un formulario en tu proyecto (obvio)
en el area de declaraciondes de variablesn pega esto :
Public o_Fso As New FileSystemObject
Public o_fso2 As New FileSystemObject
Public Archivo As File
Public archivo2 As File
Public percentvalue As Variant
declara las siguientes funciones como publicas
Function CopyFile(Src As String, Dst As String) As Single
pctbox.BackColor = vbWhite
Static Buf$
Dim BTest!, FSize! 'declare the needed variables
Dim Chunk%, F1%, F2%
Const BUFSIZE = 1024 'set the buffer size
If Len(Dir(Dst)) Then 'check to see if the destination file already exists
'Response = MsgBox(Dst + Chr(10) + Chr(10) + "Ya existe el fichero destino. ¿Quiere sustituirlo?", vbYesNo + vbQuestion) 'prompt the user with a message box
response = vbYes
If response = vbNo Then 'if the "No" button was clicked
Exit Function 'exit the procedure
Else 'otherwise
Kill Dst 'delete the already found file, and carryon with the code
End If
End If
'On Error GoTo FileCopyError 'incase of error goto this label
F1 = FreeFile 'returns file number available
Open Src For Binary As F1 'open the source file
F2 = FreeFile 'returns file number available
Open Dst For Binary As F2 'open the destination file
FSize = LOF(F1)
BTest = FSize - LOF(F2)
Do
If BTest < BUFSIZE Then
Chunk = BTest
Else
Chunk = BUFSIZE
End If
Buf = String(Chunk, " ")
Get F1, , Buf
Put F2, , Buf
BTest = FSize - LOF(F2)
'ProgressBar.Value = (100 - Int(100 * BTest / FSize)) 'advance the progress bar as the file is copied
percentvalue = (100 - Int(100 * BTest / FSize)) 'advance the progress bar as the file is copied
llenapic
Loop Until BTest = 0
Close F1 'closes the source file
Close F2 'closes the destination file
CopyFile = FSize
'Cancel.SetFocus
'ProgressBar.Value = 0 'returns the progress bar to zero
Exit Function 'exit the procedure
FileCopyError: 'file copy error label
MsgBox "Error en la copia!. Repítala, por favor..." 'display message box with error
Close F1 'closes the source file
Close F2 'closes the destination file
Exit Function 'exit the procedure
End Function
Public Sub llenapic()
'percentvalue = (cuenta * 100) / totalreg
pctbox.Line (0, 0)-((pctbox.Width * percentvalue) / 100, pctbox.Height), pctbox.ForeColor, BF
strPercent = Format$(Int(percentvalue)) & "%"
'strPercent = Format(percentvalue, "###") & "%"
intWidth = pctbox.TextWidth(strPercent)
intHeight = pctbox.TextHeight(strPercent)
intX = pctbox.Width / 2 - intWidth / 2
intY = pctbox.Height / 2 - intHeight / 2
pctbox.DrawMode = 13
pctbox.AutoRedraw = True
'pctbox.Line (intX, intY)-(intWidth, intHeight), pctbox.BackColor, BF
pctbox.CurrentX = intX
pctbox.CurrentY = intY
'pctbox.Print strPercent
'pctbox.Line (0, 0)-(percentvalue, pctbox.Height), pctbox.ForeColor, BF
Debug.Print Format(percentvalue, "0000000000.00")
'llenapic
pctbox.Refresh
'reproc.Refresh
End Sub
ahora crea un boton y un picturebox (para usarlo como un progressbar), al picturebox ponle el nombre de pctbox
y por ultimo pega el siguiente codigo en tu boton
'Variable de tipo FileSystemObject y File
Dim o_Fso As New FileSystemObject
Dim Archivo As File
' Lee las propiedades del archivo mediante GetFile
Set Archivo = o_Fso.GetFile("c:\petricio\petricio.exe")
Set archivo2 = o_fso2.GetFile("petricio.exe")
'Visualiza el resultado: Creación ,acceso y modificado etc..'
If Archivo.DateLastModified <> archivo2.DateLastModified Then
xx = CopyFile("tuarchivo.exe", "c:\ruta\tuarchivo.exe")
End If
' Elimina las variables de objeto
Set Archivo = Nothing
Set o_Fso = Nothing
que hace? copia un archivo llamado tuarchivo.exe en turuta\tuarchivo.exe, en teoria la copia la hace cuando la fecha de ultima modiicacion no es la misma en los dos archivos, pero a mi me copia siempre...
para eso utiliza la funcion copyfile y dentro de ese copyfile, hace un llamado a la funcion llenapic, que es donde el picturebox cambia de color para hacerlas como un picturebox, esto lo puedes hacer para todos los archivos que necesites
a meterle mano y rmperse el coco para ke puedas mejrar esta custion (que a proposito lo encontre en internet, no lo hice yo!!!!) |