Buenas



[Sintesis: ¿funcion que compare un string con un "pattern" (tipo: M*.txt)?]



Tengo un textbox donde se ingresa el nombre de un archivo.
Acompañándolo hay un boton que hace un browse con un commonDialog. En
otro lugar del sistema el usuario definio cual es el "tipo de archivo"
a ingresar (puede haber definido cualquier cosa que se acepta como
filtro; ejemplos: *.* *.BMP TMP*.*
PRUE?A.txt etc)



Ahora, necesito que se verifique que el archivo elegido o ingresado por
texto sea valido segun este filtro (puede no exisitir el archivo, eso
no me interesa).



Al commondDialog le seteo la propiedad Filter; pero el usuario puede
escribir *.*, dar ENTER y ahi le lista todos, o tanto en el Dialog como
en mi textbox puede escribir cualquier cosa y listo.



Para ello necesito una funcion a la cual le pase como parametro el
texto ingresado y el "pattern" para ver si este lo cumple o no.



Gracias, Omar

Aqui te dejo una funcion para lo que ocupas ...
Pones el codigo en modulo estandard para que lo puedas usar en cualquier parte de tu proyecto ...

Espero te sirva ...

Saludos !
'''''''''''''''''''''''''''

' El parametroMascara puede incluir uno o mas de los siguientes
' caracteres comodin: *, ?
' Ej... *.Dbf, Data*.mdb, Este*Aquel?.?xt
'
' Ej Uso:
' If Pattern("CanalVisual.mdb", "C*V*.mdb") then
' MsgBox "Coinciden !"
' End If
' If Not Pattern("Este Archivo.dbf", "*e*ivo.tmp") then
' MsgBox "No Coinciden !"
' End If



Public Function Pattern(ByVal Texto_A_Validar As String, ByVal Mascara As String) As Boolean
Dim aPattern() As String
Dim nPos As Long, nLastPos As Long, nInStr As Long
Dim nMascaras As Long

' Algunas validaciones preliminares ...
' Si no pasas un Texto o una Mascara, forzamos FALSE en la funcion
If LTrim(RTrim(Texto_A_Validar)) = "" Then
Pattern = False
Exit Function
End If

If LTrim(RTrim(Pattern)) = "" Then
Pattern = False
Exit Function
End If

Texto_A_Validar = UCase(Texto_A_Validar)
Mascara = UCase(Mascara)

' El texto a validar no debe traer caracteres comodin ...

If InStr(1, Texto_A_Validar, "*") > 0 Or _
InStr(1, Texto_A_Validar, "?") > 0 Then
Pattern = False
Exit Function
End If

' Partimos la mascara en segmentosy guardamos los mismos en una matriz; un segmento por cada comodin y por cada zona de texto fijo
nMascaras = 0
nLastPos = 1

For nPos = 1 To Len(Mascara)
If Mid(Mascara, nPos, 1) = "*" Or _
Mid(Mascara, nPos, 1) = "?" Then

If nLastPos <> nPos Then
nMascaras = nMascaras + 1
ReDim Preserve aPattern(nMascaras)
aPattern(nMascaras) = Mid(Mascara, nLastPos, nPos - nLastPos)
End If

nMascaras = nMascaras + 1
ReDim Preserve aPattern(nMascaras)
aPattern(nMascaras) = Mid(Mascara, nPos, 1)
nLastPos = nPos + 1

ElseIf nPos = Len(Mascara) Then

nMascaras = nMascaras + 1
ReDim Preserve aPattern(nMascaras)
aPattern(nMascaras) = Mid(Mascara, nLastPos)

End If
Next

' Validamos el Texto pasado contra los segmentos guardados en la matriz previamente. Todo segmento que no sea "*" en la mascara debe existir en el Texto_A_Validar; por cada "?" debe existir un caracter cualquiera ...

nLastPos = 1
nInStr = 0

For nPos = 1 To nMascaras
If aPattern(nPos) <> "*" Then

If aPattern(nPos) = "?" Then
If (nLastPos + 1) > Len(Texto_A_Validar) Then
If Not nPos = nMascaras Then
Pattern = False
Exit Function
End If
End If
nInStr = nLastPos

ElseIf nPos = 1 Then
If Left(Texto_A_Validar, Len(aPattern(1))) = aPattern(1) Then
nInStr = 1
Else
nInStr = 0
End If
Else
nInStr = InStr(nLastPos, Texto_A_Validar, aPattern(nPos), vbBinaryCompare)
End If

If nInStr <= 0 Then
Pattern = False
Exit Function
End If

nLastPos = (nInStr + Len(aPattern(nPos)))
End If
Next

Pattern = True


' Si el ultimo segmento no es "*" deberemos haber recorrido en su totalidad el Texto_A_Validar;de lo contrario, entonces faltaron caracteres en el Texto que se paso y no se le pudo aplicar la mascara completa ...

If Not aPattern(UBound(aPattern)) = "*" Then
If nLastPos <= Len(Texto_A_Validar) Then
Pattern = False
End If
End If


End Function

Seguramente me será útil

¡Muchas gracias!



Omar