Programación General > Visual Basic 6.0 e inferiores
Validar Extension Del Archivo
UserCode:
Hola que onda..
unda duda, yo tengo un CommonDialog que abre la ventanita para buscar un archivo de Imange, busca archivos JPG aunque tambien se permite GIF, BMO y PNG, pero el caso es que a pesar de indicar *.JPG esto puede presentar un error.
Se supone que el usuario busca una foto por esta ventanita del CommonDialog y luego de tener el archivo se abre una ventana FrmFoto de forma Modal la cual muestra en un Picture la foto. Pero si por pura casualidad, el usuario busca un archivo de otra extension, sea .txt, .doc, etc.. es decir que no es ni .jpg, ni nada de imagen, pues al llegarse al codigo del Picture, se produce un error.
Este es el codigo del ComonDialog:
--- Código: Text --- With CommonDialog1 .DialogTitle = "Buscando Foto" .CancelError = False .Filter = "Todos los archivos (*.JPG)|*.JPG" .ShowOpen If Len(.FileName) = 0 Then File = "" Exit Sub End If If CommonDialog1.FileName = "" Then File = "" Exit Sub End If File = .FileName End With FrmFoto.Show vbModal
Bueno evite el error asi:
--- Código: Text --- On Error GoTo errorhandler 'AQUI CODIGO ETC.. 'Formato de archivo de imagen incorrecto (.txt, doc, etc...)errorhandler: If Err.Number Then 'Error: 481 MsgBox("Formato de Archivo Incorrecto, verifique") End If
Realmente cualquier error raro que suceda con el Picture sacara ese aviso, pero en un alto porcentaje el error en el Picture seria ese, buscar un archivo que no sea de imagen, asi que se ataja con eso y saca el aviso, ahi todo bien.
Pero existe un problemita, resulta que el programa tiene un codigo que valida si el archivo buscado por el CommonDialog existe o no, el cual es este:
Si existe el archivo, se guardó y está ahi para consultas del registro con Foto en la carpeta "Fotos":
--- Código: Text --- 'Foto encontrada (si existe en la carpeta Fotos): If Dir(App.Path & "\Imagenes\Fotos\" & strNombre & ".JPG") <> "" Then 'FrmPrincipal.PictureX.Picture = LoadPicture(Dir(App.Path & "\Imagenes\Fotos\" & strNombre & ".JPG")) FrmPrincipal.PictFoto.Picture = LoadPicture(App.Path & "\Imagenes\JPG\Fondo_Foto.JPG") FrmPrincipal.PictureX.Picture = LoadPicture(App.Path & "\Imagenes\Fotos\" & strNombre & ".JPG") Call Stretchpic2(FrmPrincipal.PictureX, FrmPrincipal.PictFoto) Exit Sub Else 'El Archivo No Existe (No Encontrado) FrmPrincipal.PictFoto.Picture = LoadPicture(App.Path + "\Imagenes\Fotos\Foto.JPG") End If
entonces obviamente el archivo (.txt, .doc, etc...) si existe por lo que el programa procede a hacer una copia del archivo en una carpeta llamda "Fotos" dentro de la carpeta del programa. No es un archivo de imagen pero como si existia el archivo sea TXt o otro formato, pues lo guardó... y al cargarse el FrmFoto con el Picture produce error.
Entonces...
Frene el error de cargarse el archivo (no imagen) en el Picture al buscarlo por el CommonDialog y asociarlo al registro del cliente, pero como el programa si guardo el archivo porque si existe, luego al hacerle una consulta al registro de este cliente, el programa busca la foto, consigue el archivo Txt o X formato e intenta con la consulta cargar la imagen en el Picture, pero como el archivo no es de imagen, el Picture saca el error.
Con un IF o algo asi, como podria validar que el archivo si es un archivo de Imagen para evitar este error, estuve viendo algo de If Right(File,4)<>".JPG" Then pero no me dio buenos resultados. File es la variable que tiene el String de la ruta\archivo.extension.
Quien ha trabajo con validar formato de archivos de imagene o no imagen asi?
saludos gente :hola:
cpmario:
También tengo un programa que guarda fotos en un directorio y en un campo de la base de datos guardo el nombre del archivo.
Lo hago en 2 pasos, al agregar un registro nuevo con un botón command tomo la foto y la coloco en el control picture, en un cuadro de texto coloco el nombre del archivo a guardar. En un segundo paso, el nombre de archivo que estaba en el cuadro de texto lo coloco en uno de los campos de la base de datos, y con otro botón command guardo el registro.
En caso de existir el error que mencionas, de archivo inválido, no coloco el nombre del archivo en el cuadro de texto.
Lo que no muestras es el código que guarda la referencia de la foto y en que momento lo haces.
Uso este código para seleccionar y abrir la imagen
--- Código: Text ---Private Sub cmdInsertFileFoto_Click() On Error GoTo ErrorcmdInsertFile gstrDialogTitle = "¿En dónde están las Fotografías?" gstrFilename = "" gstrFilter = "Todos los archivos (*.*)|*.*|Imagenes (*.bmp,*.jpg,*.gif)|*.bmp;*.jpg;*.gif|Archivos Bitmap (*.bmp)|*.bmp|Archivos JPG (*.jpg)|*.jpg|Archivos GIP (*.gif)|*.gif" gintFilterIndex = 2 gintDlgAction = 1 'Abrir Call GetWorkingDir 'Obtener directorio de trabajo, del registro Call FileSelecter(gstrFotoWorkDir) ' Llamar commonDialog con el directorio de trabajo gstrFotoWorkDir = gstrWorkDir Call WriteWorkingDir 'Escribir directorio de trabajo, al registro If Not gblnCancel Then Picture2.Picture = LoadPicture(gstrFullFilename) 'si existe error no se ejecuta el código siguiente Picture2.ZOrder vbBringToFront Call Stretchpic(Picture2, picFoto) txtFotoFilename.Text = txtNameID.Text & "@" & lblIDPacID & ".jpg" End IfExit SubErrorcmdInsertFile: gstrMsg = "Existe un error al insertar la imagen desde archivo, " & _ vbCrLf & "Error Nº " & Err.Number & " = " & Err.Description & "." MsgBox gstrMsg, vbCritical, gstrAppTitleExit SubEnd Sub
El siguiente código lo uso para abrir o guardar varios tipos de archivos
--- Código: Text ---Sub FileSelecter(strWorkingDir As String) Dim blnDirError As Boolean On Error GoTo ErrorFileSelecter gstrFullFilename = "" gblnCancel = False With frmHistoria .cdlConsulta.DialogTitle = gstrDialogTitle .cdlConsulta.Filter = gstrFilter .cdlConsulta.FilterIndex = gintFilterIndex .cdlConsulta.Filename = gstrFilename .cdlConsulta.DefaultExt = gstrDefaultExt .cdlConsulta.CancelError = True blnDirError = True If DirExists(strWorkingDir) Then .cdlConsulta.InitDir = strWorkingDir Else .cdlConsulta.InitDir = FindDocsFolder End If blnDirError = False .cdlConsulta.Action = gintDlgAction gstrFullFilename = .cdlConsulta.Filename End With gstrFilename = ExtractFilename(gstrFullFilename) gstrWorkDir = CurDir Exit SubErrorFileSelecter: If blnDirError Then frmHistoria.cdlConsulta.InitDir = FindDocsFolder Resume Next ElseIf Err <> cdlCancel Then GenErrorHandler "modFile/FileSelecter() ", Err.Number, Err.Description Else gblnCancel = True End If Exit SubEnd Sub Algunas de las rutinas no te las coloqué pero si las deseas las escribo, por ejemplo: FindDocsFolder, ExtractFilename
:comp:
cpmario:
Agregando a la respuesta, si deseas saber que extensión tiene un archivo usa este código:
--- Código: Text --- Function ExtractExtension(strFilename As String) Dim intBackslash As Integer Dim intPoint As Integer Dim intLenFilename As Integer Dim intTemp As Integer Dim strFname As String On Error GoTo ErrorExtractExtension gblnExistExtension = True strFname = Trim$(strFilename) intLenFilename = Len(strFname) 'Find last \ Do intBackslash = intTemp intTemp = InStr(intBackslash + 1, strFname, "\") Loop Until intTemp = 0 'Find "." Do intPoint = intTemp intTemp = InStr(intPoint + 1, strFname, ".") Loop Until intTemp = 0 'Ext no exist If intPoint < intBackslash Then intPoint = 0 gblnExistExtension = False ElseIf intPoint = 0 And intBackslash = 0 Then gblnExistExtension = False End If If gblnExistExtension = True Then ExtractExtension = "." & Right$(strFname, intLenFilename - intPoint) Else ExtractExtension = "" End If Exit FunctionErrorExtractExtension: GenErrorHandler "modFile/ExtractExtension() ", Err.Number, Err.DescriptionEnd Function Llamas a esta función con algo parecido a esto:
strExtension = ExtractExtension(gstrFullFilename)
Y obtienes algo como esto-> ".RTF"
:comp:
UserCode:
--- Citar --- (cpmario)
Lo que no muestras es el código que guarda la referencia de la foto y en que momento lo haces.
--- Fin de la cita ---
Si cierto verdad, aqui esta es este:
--- Código: Text --- On Error GoTo errorhandler 'Validando que no existan campos nulos: 'Evitando asociar la Foto a unos TextBox vacios If FrmPrincipal.TxtBuscar.Text = "" And _ FrmPrincipal.TxtNombre.Text = "" Then Unload Me MsgBox("Debe indicar los datos del registro para procesar") Exit Sub End If 'Referenciado a: 'Microsoft Scripting Runtime: Dim CopyFile As Scripting.FileSystemObject Set CopyFile = New Scripting.FileSystemObject 'Verificando nuevamente si el archivo de la Foto existe o no If Existe = vbNullString Then 'No Existe el Archivo de la Foto Unload Me Exit Sub 'No se muestra ningun aviso pq ese ya sale con el Load 'Esta ventana ya carga en su Load la Foto buscada con el CommonDialog 'que se encuentra en la ventana Principal. End If 'Si existe el archivo de la Foto, proceguimos... 'Primero revisamos que la foto será asociada a un 'registro existente en la BD: (buscamos el registro) If Rs.RecordCount > 0 Then Rs.MoveFirst While Not Rs.EOF If UCase(FrmPrincipal.TxtBuscar.Text) = Rs("TxtBuscar") Then 'Si existe el registro en la Bd: 'Verificando existencia de la foto y guardandola: '(nueva foto o cambiando anterior por una nueva) If CopyFile.FileExists(File) Then CopyFile.CopyFile File, App.Path & "\Imagenes\Fotos\" & FrmPrincipal.TxtBuscar.Text & ".JPG", True Unload Me BUSCANDO_FOTO 'Aviso de Foto Guardada: MsgBox("La Foto ha sido Guardada y asocidada al Contacto") Exit Sub End If End If Rs.MoveNext Wend Unload Me 'No se encontro el registro en la Bd: 'Se guarda el nuevo registro: Rs.AddNew Rs("TxtBuscar") = UCase(FrmPrincipal.TxtBuscar.Text) 'Nombre Clave Rs("TxtNombre") = FrmPrincipal.TxtNombre.Text Rs("TxtTelefCel") = FrmPrincipal.TxtTelefCel.Text Rs("TxtTelefHab") = FrmPrincipal.TxtTelefHab.Text Rs("TxtTelefTrab") = FrmPrincipal.TxtTelefTrab.Text Rs("TxtFax") = FrmPrincipal.TxtFax.Text Rs("TxtEmail") = FrmPrincipal.TxtEmail.Text Rs("TxtCumple") = FrmPrincipal.TxtCumple.Text Rs("TxtDireccion") = FrmPrincipal.TxtDireccion.Text Rs("TxtObservaciones") = FrmPrincipal.TxtObservaciones.Text Rs.Update '....................... 'Guardando la Foto: If CopyFile.FileExists(File) Then CopyFile.CopyFile File, App.Path & "\Imagenes\Fotos\" & FrmPrincipaol.TxtBuscar.Text & ".JPG", True Unload Me BUSCANDO_FOTO 'para mostrar de una vez. End If End If MsgBox("Registro Guardado") 'Formato de archivo de imagen incorrecto (.txt, doc, etc...)errorhandler: If Err.Number Then 'Error: 481 MsgBox("No Existe el Archivo de Imagen") Exit Sub End If
Esto busca la Foto en la carpeta "Fotos" y la muestra con su registro de una vez.
en caso de que el registro tenga foto, sino tiene, entonces muestra una imagen (un logo -> Foto.jpg) que esta guardado en la carpeta "Fotos" para los registros que no tengan Foto.
--- Código: Text --- 'BUSCANDO LA FOTO DEL CONTACTO EN LA CARPETA "FOTOS" DENTRO DE LA CARPETA DEL PROGRAMA:Private Sub BUSCANDO_FOTO() Dim strNombre As String strNombre = FrmPrincipal.TxtBuscar.Text 'En caso de que las Carpetas Imagenes y Fotos hayan sido borradas 'se crean nuevamente: ExisteCarpeta App.Path & "\Imagenes" ExisteCarpeta App.Path & "\Imagenes\Fotos" On Error GoTo errorhandler 'Foto encontrada (si existe en la carpeta Fotos): If Dir(App.Path & "\Imagenes\Fotos\" & strNombre & ".JPG") <> "" Then FrmPrincipal.PictFoto.Picture = LoadPicture(App.Path & "\Imagenes\JPG\Fondo_Foto.JPG") FrmPrincipal.PictureX.Picture = LoadPicture(App.Path & "\Imagenes\Fotos\" & strNombre & ".JPG") Call Stretchpic2(FrmTelefonos.PictureX, FrmPrincipal.PictFoto) Exit Sub Else 'El Archivo No Existe (No Encontrado) FrmPrincipal.PictFoto.Picture = LoadPicture(App.Path + "\Imagenes\Fotos\Foto.JPG") End If 'Formato de archivo de imagen incorrecto (.txt, doc, etc...)errorhandler: If Err.Number Then 'Error: 481 'Aviso No Existe el Archivo de la Foto: Msgbox("La Foto seleccionada para el registro no existe, verifique") End IfEnd Sub
:huh: Algo que se me paso comentar es que el problema puede ser algo más problematico de lo que pensé, porque cuando guardo el archivo en la carpeta "Fotos" el programa le pone extension .JPG eso quiere decir que si selecciono un archivo TXT el programa le cambiara el .TXT por un .JPG y entonces un codigo que valide la extensión del archivo para saber si es un archivo de imagen o no, es algo que no me sirve porque ese codigo de validacion de extension siempre encontrara la extension .JPG y no la .TXT ta fea la cosa verdad :blink:
Voy a ver tu codigo para ver si anexo algo que resuelva eso, bueno yo no tengo que hacer nada de eso que haces en tu programa, eso de buscar la foto y poner el nombre en un TextBox, el programa hace todo esto más Automaticamente él solo, el usuario solo busca la foto y el programa se encarga de verificar que exista, lo guarda de una vez en la carpeta Fotos y el propio programa le cambia el nombre alarchivo por el CampoID del registro.
Es decir, si consulto al usuario o cliente "Pepe" el programa el cambia el nombre a la foto y le pone "Pepe" y al consultar el registro busca el archivo "Pepe" en la carpeta "Fotos" el lo que respecta a la foto el usuario solo usa el mouse para buscar la foto y darle guardar, para que el programa lo asocie con el registro.
Me parece muy buena idea lo del Textbox en donde se escribe el nombre del archivo de imagen, lo que pasa es que los usuarios que no saben nada de PCs les gusta todo mas facil y sencillo, darle un click aqui y allá, y listo, entonces uno trata de facilitarle las cosas, aunque seria muy vaga la persona que le pese darle a un boton para buscar la imagen (a juro tiene que hacerlo) y luego escribir el nombre del archivo en otra parte y luego guardar, eso no cuesta nada hacerlo, aunque lo mio ya esta todo hecho asi como decia, pero vere si le hago sus ajustes de buscar y guardar la imagen dependiendo de lo problematico que torne esto del formato de imagen.
cpmario:
El problema que tienes es que basas parte de la programación en verificar que el archivo existe o no. Si el usuario lo toma con el commomdialog es obvio que existe y no es necesario verificar que existe, valga la redundancia. Además de verificar que el archivo exista debes verificar que sea un archivo válido, cargándolo en un cuadro picture.
Si el usuario escoge un archivo que no existe o que no sea válido, se generará un error que debes aprovechar para evitar guardar el archivo erroneo. Este manejo de error es anterior a guardar el archivo de la foto y el registro de la base de datos.
En mi programa si el archivo existe o no tiene error coloco el nombre del archivo en el cuadro de texto (con propiedad visible= false que no ve el usuario y que está enlazado a un datacontrol listo para grabarse en la base de datos) .
Y si hay error dejo al cuadro de texto vació y no se graba nada en la base de datos.
-------------
Hay problemas en el foro para que se muestren los emoticones :-)
Navegación
[#] Página Siguiente
Ir a la versión completa