Ayuda Urgente con un Generador de Curp en Visual Basic 6

[Dalix_xd]

Estoy haciendo un programa que cuando tu le das el nombre, la fecha de nacimiento, el genero, etc; te genera el curp, pero mi problema es que en el curp te piden caracteres especificos, como el de la primera vocal de tu primer apellido y las consonantes de tus apellidos y nombre. Si alguien pudiera ayudar se apreciaría mucho ya que es algo un tanto urgente. Todo esto esta siendo creado por Visual Basic 6.0

[Serapis]

Empieza por hacerte entender...

¿Qué es un 'Curp' ?. Puedo imaginar que se trate de algún tipo de codificación específica, pero seguramente tan específica que fuera de cierto ámbito, nadie más sepa de qué se trata.

Haciendo una búsqueda llego a wikipedia: https://es.wikipedia.org/wiki/Clave_Única_de_Registro_de_Población

Donde se aclara que tal 'Curp' es en efecto una codificación específica de Méjico.
Pués no parece tan complicado generar dicho código. Simplemente crea funciones para obtener cada campo solicitado que se vayan concatenando...

Sea al caso los datos:
Nombre: José de la Cierva
Apellidos: Columbus Pacificus
Fecha de Nacimiento: 2020/12-31
Género: Varón
País de Nacimiento: Méjico, Yucatán

Código ( vb) [Seleccionar] Expandir



public function CrrearCurp(byref Nombre as string, byref Apellidos as string, byref FechaNac as date, byval Varon as boolean, byref NacidoEn as string, optional EsExtranjero as boolean)
  dim curp as string

  curp = spaces(18)

  mid$(curp,1,2)= GetDataApellido1(apellidos)   ' CO...
  mid$(curp,3,1) = GetDataApellido2(apellidos)   ' COP...
  mid$(curp,4,1) = GetDataNombre(Nombre)      ' COPC
  mid$(curp,5,6) = GetFechaToString(FechaNac) ' COPC201231...
  mid$(curp, 11,1) = GetValueGenero(varon)   ' COPC201231H...

  ' ya ya tienes 11 de los 18 dígitos... el resto tampoco son más complicados....

  CrearCurp = ucase$(curp) ' todo en mayúsculas...
end function

' se reclama primera letra y y primera vocal del primer apellido:
private function GetDataApellido1(byref Apellidos as string) as string
   dim k as integer, j as integer, vocal as string, letra1 as string

   letra1 = left$(apellidos)
   vocal = GetFirstVocal(Apellidos, 2)

   GetDataApellido1 = (letra1 & vocal)
end function

' se considera que no habrá errores, luego no se tratan...
private function GetFirstVocal(byref Word as string, byval Inicio as integer) as string
   dim k as integer

   k = instr(ucase$(word), "A", " ", Inicio)
   If (k= 0) then  
       k = instr(ucase$(word), "E", " ", Inicio)
       If (k= 0) then
           k = instr(ucase$(word), "I", " ", Inicio)
           If (k= 0) then
               k = instr(ucase$(word), "O", " ", Inicio)
               If (k= 0) then    
                   k = instr(ucase$(word), "U", " ", Inicio)  
               end if
           end if
       end if
   end if

   GetFirstVocal = mid$(word, inicio, 1)
end function

Código ( vb) [Seleccionar] Expandir


private function GetFirstVocal(byref Word as string, byval Inicio as integer) as string
   dim k as integer, j as integre, i as integer

    j=len(Word)
   Word = ucase$(Word)
   For k =Inicio to j
       i= instr("AEIOU", mid$(Word, k))
       If i >0 then
           GetFirstVocal=mid$("AEIOU", i, 1)
           Exit for
       End if
   Next
End function

' se reclama solo la primera letra del segundo apellido
private function GetDataApellido2(byref Apellidos as string) as string
   dim k as integer

   k= instr(apellidos," ",1)
   GetDataApellido2 = mid$(apellidos,k,1)
end function

' se reclama solo la primera letra del nombre y si es compuesto la primera del ultimo sobrenombre, si dicho sobrenombre fueran: Maria o José.
private function GetDataNombre(byref Nombre as string) as string
   dim k as integer

   k= instrrev(nombre, " ")
   if (k=0) then
       GetDataNombre = left$(Nombre, 1)
   else    ' si el nombre es compuesto, se devuelve la primera letra del último sobrenombre 'José de la Cierva', devuelve la 'C' de 'cierva'
       sobrenombre = ucase$(right$(nombre, k, len(nombre)-k))
       if ((sobrenombre = "MARÍA") or (sobrenombre= "JOSÉ")) then            
           GetDataNombre = mid$(nombre, k,1)
       else
           GetDataNombre = left$(Nombre, 1)
       end if
   end if
end function

' entendemos que viene en el formato tipo de datos 'date' si viene en otro formato, desde luego debe ajustarse al caso...
private function GetFechaToString(byref Fecha as date) as string
   dim f as string

   f= Format(fecha, "yy/MM/dd")

   GetFechaToString = replace(f, "/", "")
end function

' Los valores elegidos para representar el campo son ambiguos, pués ambos pueden siginificar ambas cosas, son intercambiables, como se ve:
'    H = "Hombre" o "Hembra"
'    M = "Macho/Masculino" o "Mujer"
private function GetValueGenero(byval Varon as boolean) as string
   if (varon= true) then
       GetValueGenero = "H"  'ver comentario, igual es el otro...
   else
       GetValueGenero = "M"  'ver comentario, igual es el otro...
   end if


Te he resuelto los primeros 11 caracteres del código, a tu esfuerzo queda el resto....
Date cuenta que hay más condicionantes, que dado que tu eres el interesado tendrás que empaparte de ellos, y corregir donde proceda... yo solo he leído el artículo de wikipedia por encima... y seguramente en la página del gobierno puedas encontrar una descripción más  detallada de cada detalle de los campos.

P. D.: me edito... Antes de mirar en Wikipedia, leí en otra parte una desafortunada descripción que me indujo a malinterpretar el segundo valor del código.. . Y al verlo hoy recordé que luego olvidé corregir... La función tachada...