Autor
|
Tema: [Duda] Insertar a este código, Mensaje de Error en caso de... (Leído 2,169 veces)
|
Soir
Desconectado
Mensajes: 25
|
Hola!... Bueno, tengo una duda, y msdn, no me ayuda mucho en esto... Tengo el siguiente código. Private Sub cmdDownload_Click() Screen.MousePointer = vbHourglass
ProgressBar1.Value = 0
ProgressBar1.Visible = True 'Mostrar barra de progreso
'Lista de Archivos de Descarga DownloadFile "http://dynamite.es/updates/WoD.exe", App.Path & "\WoD.exe" DownloadFile "http://dynamite.es/updates/Patch-a.MPQ", App.Path & "\Data\Patch-a.MPQ"
Screen.MousePointer = vbDefault MsgBox "Actualización Completada"
ProgressBar1.Visible = False
End Sub
Private Sub Form_Load()
Me.Caption = "Dynamite Updater - V1.0"
ProgressBar1.Visible = True
End Sub
Sub DownloadProgress(intPercent As String) ProgressBar1.Value = intPercent ' Actualizar Proceso Mientras se Descarga End Sub
'Funcion de Descarga de Archivo (strURL As String, strDestination As String) As Boolean Public Sub DownloadFile(strURL As String, strDestination As String) 'As Boolean Const CHUNK_SIZE As Long = 1024 Dim intFile As Integer Dim lngBytesReceived As Long Dim lngFileLength As Long Dim strHeader As String Dim b() As Byte Dim i As Integer
DoEvents With Inet1 .URL = strURL .Execute , "GET", , "Range: bytes=" & CStr(lngBytesReceived) & "-" & vbCrLf While .StillExecuting DoEvents Wend
strHeader = .GetHeader End With strHeader = Inet1.GetHeader("Content-Length") lngFileLength = Val(strHeader)
DoEvents lngBytesReceived = 0
intFile = FreeFile()
Open strDestination For Binary Access Write As #intFile
Do b = Inet1.GetChunk(CHUNK_SIZE, icByteArray) Put #intFile, , b lngBytesReceived = lngBytesReceived + UBound(b, 1) + 1
DownloadProgress (Round((lngBytesReceived / lngFileLength) * 100)) DoEvents Loop While UBound(b, 1) > 0
Close #intFile End Sub
Este código lo uso para actualizar unos archivos de un juego... Que son imprescindibles para mi servidor. La duda, es, el programa descarga los archivos y uno de esos archivos, lo inserta en la carpeta \Data\ Entonces, quería saber, como insertarle un mensaje para que cuando el programa no encuentre la carpeta \Data\ salga X mensaje. Ahora, cuando no la encuentra sale este error: Espero la ayuda... Muchas gracias
|
|
« Última modificación: 14 Agosto 2010, 18:02 pm por Soir »
|
En línea
|
|
|
|
Fitoschido
|
On Error GoTo RutinaError ... RutinaError:
Y bajo RutinaError pones: Si Carpeta "\Data" no existe Entonces MsgBox "No se encontró la carpeta de datos del juego" (o lo que quieras. Te lo pongo como pseudocódigo porque no sé si lo de FileExists existe en VB6, y no me acuerdo ahorita
|
|
|
En línea
|
El que sabe hace, el que no enseñaMiembro oficial del proyecto Ubuntu, traductor de LibreOffice/Ubuntu/Xfce/Gnome.
|
|
|
Soir
Desconectado
Mensajes: 25
|
On Error GoTo RutinaError ... RutinaError:
Y bajo RutinaError pones: Si Carpeta "\Data" no existe Entonces MsgBox "No se encontró la carpeta de datos del juego" (o lo que quieras. Te lo pongo como pseudocódigo porque no sé si lo de FileExists existe en VB6, y no me acuerdo ahorita Mira se lo inserte aqui: Private Sub cmdDownload_Click() Screen.MousePointer = vbHourglass
ProgressBar1.Value = 0
ProgressBar1.Visible = True 'Mostrar barra de progreso
'Lista de Archivos de Descarga DownloadFile "http://dynamite.es/updates/WoD.exe", App.Path & "\WoD.exe" DownloadFile "http://dynamite.es/updates/Patch-a.MPQ", App.Path & "\Data\Patch-a.MPQ"
[b]On Error GoTo RutinaError RutinaError: MsgBox "No se encontró la carpeta de datos del juego"[/b]
Screen.MousePointer = vbDefault MsgBox "Actualización Completada"
ProgressBar1.Visible = False
End Sub
Private Sub Form_Load()
Me.Caption = "Dynamite Updater - V1.0"
ProgressBar1.Visible = True
End Sub
Sub DownloadProgress(intPercent As String) ProgressBar1.Value = intPercent ' Actualizar Proceso Mientras se Descarga End Sub
'Funcion de Descarga de Archivo (strURL As String, strDestination As String) As Boolean Public Sub DownloadFile(strURL As String, strDestination As String) 'As Boolean Const CHUNK_SIZE As Long = 1024 Dim intFile As Integer Dim lngBytesReceived As Long Dim lngFileLength As Long Dim strHeader As String Dim b() As Byte Dim i As Integer
DoEvents With Inet1 .URL = strURL .Execute , "GET", , "Range: bytes=" & CStr(lngBytesReceived) & "-" & vbCrLf While .StillExecuting DoEvents Wend
strHeader = .GetHeader End With strHeader = Inet1.GetHeader("Content-Length") lngFileLength = Val(strHeader)
DoEvents lngBytesReceived = 0
intFile = FreeFile()
Open strDestination For Binary Access Write As #intFile
Do b = Inet1.GetChunk(CHUNK_SIZE, icByteArray) Put #intFile, , b lngBytesReceived = lngBytesReceived + UBound(b, 1) + 1
DownloadProgress (Round((lngBytesReceived / lngFileLength) * 100)) DoEvents Loop While UBound(b, 1) > 0
Close #intFile End Sub
Y sale, cuando descarga los archivos, salen los 2 mensajes... Probaré a cambiarlo de lugar... Gracias ^^
|
|
|
En línea
|
|
|
|
cassiani
Desconectado
Mensajes: 978
« Anterior | Próximo »
|
debes colocar un Exit Function antes de la etiqueta RutinaErrorAsí está mal: [b]On Error GoTo RutinaError RutinaError: MsgBox "No se encontró la carpeta de datos del juego"[/b]
Screen.MousePointer = vbDefault MsgBox "Actualización Completada"
ProgressBar1.Visible = False
End Sub La etiqueta RutinaError la pones al final del sub, la idea es que el procedimiento que sigue luego de ella se ejecute solo si se produce el error
|
|
|
En línea
|
|
|
|
Fitoschido
|
Haz lo que te dice Cassiani, y quitale los "[ b ]" que hay en la etiqueta... ¿No te causa Syntax Error? xD
|
|
« Última modificación: 15 Agosto 2010, 00:22 am por Fitoschido »
|
En línea
|
El que sabe hace, el que no enseñaMiembro oficial del proyecto Ubuntu, traductor de LibreOffice/Ubuntu/Xfce/Gnome.
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
error...no sé como suprimir este mensaje ....
Foro Libre
|
Constance
|
6
|
3,088
|
26 Abril 2011, 03:30 am
por flacc
|
|
|
Problema con este programa, me aparece un mensaje de error.
Programación C/C++
|
Anastacio
|
6
|
5,585
|
21 Enero 2012, 03:25 am
por Anastacio
|
|
|
¿Cómo añadir parámetros y mensaje de error al código jQuery?
Desarrollo Web
|
Piratings
|
1
|
1,729
|
17 Septiembre 2016, 01:05 am
por Jeferi
|
|
|
[DUDA] Insertar dentro de un String codigo html
Desarrollo Web
|
kevenvarela
|
2
|
5,825
|
5 Junio 2017, 06:19 am
por kevenvarela
|
|
|
Error al insertar codigo jQuery en PhpMailer
Desarrollo Web
|
Alarkon_88
|
1
|
1,419
|
12 Agosto 2018, 17:07 pm
por #!drvy
|
|