C/Visual C - ayuda

 
Vista:

ayuda

Publicado por ALVARO RODRIGUEZ  (1 intervención) el 15/12/2009 01:33:58
HOLA AMIGOS DEL FORO.

LES COMENTO RAPIDAMENTE.

TENGO PROBLEMAS CON UN CODIGO QUE ESTOY DISEÑANDO, ESTE CODIGO ES PARA UN PROGRAMA DE FILTRADO LLAMADO TEXCONVERT, EL PROBLEMA QUE TENGO ES QUE SALTA EL FILTRADO DE LOS NOMBRES, SI ALGIEN ME PUEDE AYUDAR SE LOS AGRADECERIA.

ANEXO CODIGO...

Option Explicit
Dim v(), nf, A1(), A2(), mx1, mx2, fl, yr
nf = DictOut.GetFieldCount()
Redim v(nf)
mx1 = 0: mx2 = 0
'----------------- OnRecord -----------------
Function OnRecord
Dim s, c, i

s = DictIn.Field_1.value
c = Trim(Mid(s, 45, 15))

If fl Then
v(6) = GetCode(s)
v(13) = GetDate(s, "")
yr = Left(v(13), 4)
fl = 0
End If
If InStr(s, "BOLETÍN LABORAL") Then fl = 1

If Trim(Mid(s, 200)) = "JLC A" Then
For i = 0 To Ubound(A2): AddStr A2(i), A1, mx1: Next
mx2 = 0
ReDim A2(mx2)
ElseIf InStr(s, "PÁGINA") = 0 And InStr(s, "http://www.") = 0 Then
AddStr Left(s, 117), A1, mx1
AddStr Mid(s, 119), A2, mx2
End If
This.SkipRecord
End Function

'----------------- OnFinishProcess -----------------
Function OnFinishProcess
AddRecords(A1)
End Function

'-----------------
Function AddRecords(ByRef ar)
Dim k, s, i, j, c, p, r, ind, num, a, n, c1, c2, nmax
If IsArray(ar) Then
nmax = Ubound(ar)
For k = 0 To nmax
s = ar(k)
If InStr(s, "JUNTA ESPECIAL") Then v(18) = TranNum(GetByTag(ar(k+1), "NUMERO", " "))
If Len(Trim(Left(s, 35))) Then
s = Trim(s)
p = InStr(s, ".-")
If p Then
num = Trim(Left(s, p-1))
If IsNumeric(num) Then
If ind > 0 Then
c = GetByReg(r, "\d+/\d+")
If Len(c) Then v(19) = c Else c = "EXP."

c1 = GetByTag(r, c, "VS" )
c1 = Trim(Replace(c1, "-", Empty))
c1 = Trim(Replace(c1, ".", Empty))
c1 = Trim(Replace(c1, ".-", Empty))

c2 = GetByTag(r, "VS", "-" )
c2 = Trim(Replace(c2, "-", Empty))
c2 = Trim(Replace(c2, ".", Empty))

If IsCompany(c1) Then
v(10) = c1
v(1) = c2
Else
SetParties c1, 1, 2, 3, 4
End If
v(9) = 1
v(11) = 8
v(12) = 1

'c = GetByTag(r, "AL", ".-", ",")
'If Len(c) = 0 Then c = GetByTag(r, "NOTIFIQUESE A", ".-", ",")
'a = Split(c, " ")
'If IsArray(a) Then
' n = Ubound(a)
' j = 0
' For i = 0 To n
' If j > 0 Then
' If InStr(a(j), "S.A.", "DE", "C.V") Then b(j-1) = b(j-1) & " " & a(i): Exit For
' End If
' ReDim Preserve b(j)
' b(j) = a(i)
' j = j + 1
' Next

' n = Ubound(b)
' If n = 0 Then
' v(14) = Trim(b(0))
' ElseIf n = 1 Then
' v(14) = Trim(b(0))
' v(15) = Trim(b(1))
' ElseIf n = 2 Then
' v(14) = Trim(b(0))
' v(15) = Trim(b(1))
' v(16) = Trim(b(2))
' ElseIf n > 2 Then
' v(14) = Trim(b(0))
' v(15) = Trim(b(1))
' v(16) = Trim(b(2))
' v(17) = Trim(b(3))
' End If
'Else
' v(14) = Trim(c)
'End If

v(14) = Trim(c2)

'v(22) = This.GetInputFile()
If Len(v(8)) <> 10 Then v(8) = v(13)
v(19) = v(19) & "." & ".-" & ","
p = InStr(r, "ACUERDO")
If p Then v(21) = Trim(Mid(r, p))
v(23) = 0

This.AppendStart
For i = 1 To nf: DictOut.SetFieldValue i, v(i): Next
This.AppendRecord
For i = 1 To 4: v(i) = Empty: Next
v(10) = Empty
For i = 14 To 17: v(i) = Empty: Next
v(21) = Empty
r = Empty
End If
ind = 1
End If
End If
If ind >= 0 Then
ind = ind + 1
r = r & " " & s
End If
End If
Next
End If
End Function

'Target.Message This.GetRecordNumber() & " - " & s & ".-" & ","
'Target.Message This.GetRecordNumber() & "c1: " & c1
'Target.Message This.GetRecordNumber() & "c2: " & c2

'-----------------
Function SetParties(c, i1, i2, i3, i4)
Dim i, j, a, b(), n
If Len(c) Then
c = Replace(c, "DE LA", "DE_LA_")
a = Split(c, " ")
If IsArray(a) Then
n = Ubound(a)
j = 0
For i = 0 To n
If Len(a(i)) > 2 Then
ReDim Preserve b(j)
b(j) = a(i)
j = j + 1
End If
Next

If IsArray(b) Then
n = Ubound(b)
'Target.Message This.GetRecordNumber() & " - " & b(0) & " - " & n
If n = 1 Then
v(i1) = Replace(b(1), "DE_LA_", "DE LA")
v(i4) = Replace(b(0), "DE_LA_", "DE LA")
ElseIf n = 2 Then
v(i1) = Replace(b(2), "DE_LA_", "DE LA")
v(i3) = Replace(b(0), "DE_LA_", "DE LA")
v(i4) = Replace(b(1), "DE_LA_", "DE LA")
ElseIf n = 3 Then
v(i1) = Replace(b(2), "DE_LA_", "DE LA")
v(i2) = Replace(b(3), "DE_LA_", "DE LA")
v(i3) = Replace(b(0), "DE_LA_", "DE LA")
v(i4) = Replace(b(1), "DE_LA_", "DE LA ")
ElseIf n = 4 Then
v(i1) = Replace(b(3) & " " & b(4), "DE_LA_", "DE LA ")
v(i3) = Replace(b(0), "DE_LA_", "DE LA")
v(i4) = Replace(b(1) & " " & b(2), "DE_LA_", "DE LA")
ElseIf n = 5 Then
v(i1) = Replace(b(3) & " " & b(4) & " " & b(5), "DE_LA_", "DE LA")
v(i2) = Replace(b(5), "DE_LA_", "DE LA")
v(i3) = Replace(b(0), "DE_LA_", "DE LA")
v(i4) = Replace(b(1), "DE_LA_", "DE LA")
End If
End If
End If
End If
End Function

'If InStr(c, "GARCIA") Then Target.Message This.GetRecordNumber() & " - " & i & " - " & a(i) & " - " & c & ".-"

Dim mth, ar1(32)

ar1(1) = "AGUASCALIENTES"
ar1(2) = "BAJA CALIFORNIA"
ar1(3) = "BAJA CALIFORNIA SUR"
ar1(4) = "CAMPECHE"
ar1(5) = "COAHUILA"
ar1(6) = "COLIMA"
ar1(7) = "CHIAPAS"
ar1(8) = "CHIHUAHUA"
ar1(9) = "MÉXICO, D.F."
ar1(10) = "DURANGO"
ar1(11) = "GUANAJUATO"
ar1(12) = "GUERRERO"
ar1(13) = "HIDALGO"
ar1(14) = "JALISCO"
ar1(15) = "EDO DE MEXICO"
ar1(16) = "MICHOACAN"
ar1(17) = "MORELOS"
ar1(18) = "NAYARIT"
ar1(19) = "NUEVO LEON"
ar1(20) = "OAXACA"
ar1(21) = "PUEBLA"
ar1(22) = "QUERETARO"
ar1(23) = "QUINTANA ROO"
ar1(24) = "SAN LUIS POTOSI"
ar1(25) = "SINALOA"
ar1(26) = "SONORA"
ar1(27) = "TABASCO"
ar1(28) = "TAMAULIPAS"
ar1(29) = "TLAXCALA"
ar1(30) = "VERACRUZ"
ar1(31) = "YUCATAN"
ar1(32) = "VERACRUZ"
'-----------------
Function GetCode(s)
Dim c, i

For i = 1 To 32
If InStr(s, ar1(i)) Then GetCode = i: Exit Function
Next
End Function

mth = Array("ENERO", "FEBRERO", "MARZO", "ABRIL", "MAYO", "JUNIO", "JULIO", "AGOSTO", "SEPTIEMBRE", "OCTUBRE", "NOVIEMBRE", "DICIEMBRE", "Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio", "Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre")
'-----------------
Function GetDate(s, kw)
Dim p, i, yy, mm, dd

If Len(kw) Then
p = InStr(s, kw)
If p Then
s = Trim(Mid(s, p+9))
GetDate = FormatDate(s, 0)
End If
Else
GetDate = FormatDate(s, 1)
End If
End Function

'-----------------
Function FormatDate(s, fl)
Dim p, i, yy, mm, dd

If fl Then
yy = Mid(s, InStrRev(s, " "))
yy = Trim(Replace(yy, ".", Empty))
Else
yy = yr
End If
For i = 0 To Ubound(mth)
p = InStr(1, s, mth(i), 1)
If p Then mm = i+1: Exit For
Next
If Len(mm) = 1 Then mm = "0" & mm
dd = GetByTagRev(s, "DE " & mth(mm-1), " ")
If Not IsNumeric(dd) Then dd = Empty
FormatDate = yy & "-" & mm & "-" & dd
End Function

'-----------------
Function TranNum(s)
Dim c
Select Case s
Case "UNO" : c = 1
Case "DOS" : c = 2
Case "TRES" : c = 3
Case "CUATRO" : c = 4
Case "CINCO" : c = 5
Case "SEIS" : c = 6
Case "SIETE" : c = 7
Case "OCHO" : c = 8
Case "NUEVE" : c = 9
Case "DIEZ" : c = 10
Case "ONCE" : c = 11
Case "DOCE" : c = 12
Case "TRECE" : c = 13
Case "CATORCE" : c = 14
Case "QUINCE" : c = 15
Case "DIECISEIS" : c = 16
Case "DIECISIETE" : c = 17
Case "DIECIOCHO" : c = 18
Case "DIECINUEVE" : c = 19
Case "VEINTE" : c = 20
End Select
TranNum = c
End Function

'-----------------
Function IsCompany(c)
Dim r
If InStr(c, "DE ") Or _
InStr(c, "PP ") Or _
InStr(c, "SERVICIO") Or _
InStr(c, "S.C.") Then IsCompany = true Else IsCompany = false
End Function

'-----------------
Function SetByTag(i, s, t1, t2)
Dim p1, p2, d, r, c
r = Empty
d = Len(t1)
p1 = InStr(1, s, t1, 1) + d
If d = 0 Then p1 = 1
If p1 > d Then
r = Trim(Mid(s, p1))
If Len(t2) > 0 Then
p2 = InStr(1, r, t2, 1)
If p2 > 0 Then r = Trim(Left(r, p2 - 1))
End If
End If
If Len(r) > 0 Then v(i) = r
End Function

'-----------------
Function AddStr(s, ByRef a, ByRef mx)
If Len(Trim(s)) Then
ReDim Preserve a(mx)
a(mx) = s
mx = mx + 1
End If
End Function

'-----------------
Function GetByTag(s, t1, t2)
Dim p1, p2, d, c, a
c = Empty
d = Len(t1)
p1 = InStr( 1, s, t1, 1 ) + d
If d = 0 Then p1 = 1
If p1 > d Then
c = LTrim(Mid(s, p1))
If Len(t2) > 0 Then
p2 = InStr(c, t2)
If p2 > 0 Then c = Left(c, p2-1)
End If
End If
GetByTag = Trim(c)
End Function

'-----------------
Function GetWordRev(s, t1, t2)
Dim p1, p2, d, c
If Len(t1) > 0 Then
p1 = InStr( 1, s, t1, 1 )
If p1 > 0 Then
c = Trim(Left(s, p1 - 1))
d = Len(t2)
If d > 0 Then
p2 = InStrRev(c, t2)
If p2 > 0 Then c = Mid(c, p2 + d, p1 - p2 - d)
End If
GetWordRev = Trim(c)
End If
End If
End Function

Dim regEx, Matches
Set regEx = New RegExp
regEx.Global = True
regEx.IgnoreCase = True

'-----------------
Function GetByReg(s, reg)
RegEx.Pattern = reg
Set Matches = RegEx.Execute(s)
If Matches.count > 0 Then GetByReg = Matches(0).value
End Function

'-----------------
Function GetByTagRev(s, t1, t2)
Dim p1, p2, d, c
If Len(t1) > 0 Then
p1 = InStr( 1, s, t1, 1 )
If p1 > 0 Then
c = Trim(Left(s, p1 - 1))
d = Len(t2)
If d > 0 Then
p2 = InStrRev(c, t2)
If p2 > 0 Then c = Mid(c, p2 + d, p1 - p2 - d)
End If
GetByTagRev = Trim(c)
End If
End If
End Function
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder