elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Sigue las noticias más importantes de seguridad informática en el Twitter! de elhacker.NET


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [RETO] uCaseCorrect. Corrector de Mayusculas!
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: 1 [2] 3 4 Ir Abajo Respuesta Imprimir
Autor Tema: [RETO] uCaseCorrect. Corrector de Mayusculas!  (Leído 17,741 veces)
79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
Re: [RETO] uCaseCorrect. Corrector de Mayusculas!
« Respuesta #10 en: 16 Febrero 2011, 19:17 pm »

HOLA!!!

@BlackZeroX▓▓▒▒░░: SOLUCIONADO, proba con el codigo nuevo.

GRACIAS POR LEER!!!


En línea

"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

 79137913                          *Shadow Scouts Team*
Edu


Desconectado Desconectado

Mensajes: 1.082


Ex XXX-ZERO-XXX


Ver Perfil
Re: [RETO] uCaseCorrect. Corrector de Mayusculas!
« Respuesta #11 en: 16 Febrero 2011, 20:04 pm »

Bueno ahora con nuevas reglas tengo q cambiar el codigo -_-' pero queda re simple ahora, mejor dejo asi ;)


En línea

Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [RETO] uCaseCorrect. Corrector de Mayusculas!
« Respuesta #12 en: 16 Febrero 2011, 20:13 pm »

Bueno, aquí dejo mi forma de hacerlo :rolleyes: :

Con una clase:
Código
  1. Option Explicit
  2. '======================================================================
  3. ' º Class      : cFrogUCase.cls
  4. ' º Version    : 1.3
  5. ' º Author     : Mr.Frog ©
  6. ' º Country    : Spain
  7. ' º Mail       : vbpsyke1@mixmail.com
  8. ' º Date       : 16/02/2011
  9. ' º Twitter    : http://twitter.com/#!/PsYkE1
  10. ' º Recommended Websites :
  11. '       http://foro.h-sec.org
  12. '       http://visual-coders.com.ar
  13. '       http://InfrAngeluX.Sytes.Net
  14. '======================================================================
  15. Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
  16. Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
  17. Private Declare Function IsCharLowerA Lib "user32" (ByVal cChar As Integer) As Long
  18. Private Declare Function IsCharAlphaNumericA Lib "user32" (ByVal cChar As Integer) As Long
  19. Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal olestr As Long, ByVal BLen As Long) As Long
  20.  
  21. Private lngAscHeader&(0 To 5)
  22. Private intAsc%()
  23.  
  24. Friend Function CorrectUCase(ByRef strText$) As String
  25. Dim lngLength&, Q&
  26.  
  27.    lngLength = LenB(strText) \ 2
  28.    If lngLength Then
  29.        lngAscHeader(3) = StrPtr(strText)
  30.  
  31.        Do While Q < lngLength
  32.            If IsCharAlphaNumericA(intAsc(Q)) Then
  33.                If IsCharLowerA(intAsc(Q)) Then intAsc(Q) = intAsc(Q) - 32
  34.                Exit Do
  35.            End If
  36.            Q = Q + 1
  37.        Loop
  38.  
  39.        Q = Q + 1
  40.        Do While Q < lngLength
  41.            If intAsc(Q) < 64 Then
  42.                Select Case intAsc(Q)
  43.                    Case 33, 46, 63 '! . ?
  44.                        Do
  45.                            Q = Q + 1
  46.                            Select Case intAsc(Q)
  47.                                Case 59, 44, 46 '; , .
  48.                                    Q = Q + 1
  49.                                    GoTo Next_:
  50.                            End Select
  51.                        Loop While Q < lngLength And IsCharAlphaNumericA(intAsc(Q)) = 0
  52.  
  53.                        If IsCharLowerA(intAsc(Q)) Then intAsc(Q) = intAsc(Q) - 32
  54.                End Select
  55.            End If
  56. Next_:      Q = Q + 1
  57.        Loop
  58.  
  59.        PutMem4 VarPtr(CorrectUCase), SysAllocStringByteLen(VarPtr(intAsc(0)), lngLength + lngLength)
  60.    End If
  61. End Function
  62.  
  63. Private Sub Class_Initialize()
  64.    lngAscHeader(0) = &H1&: lngAscHeader(1) = &H2&: lngAscHeader(4) = &H7FFFFFFF
  65.    PutMem4 VarPtrArray(intAsc), VarPtr(lngAscHeader(0))
  66. End Sub
  67.  
  68. Private Sub Class_Terminate()
  69.    PutMem4 VarPtrArray(intAsc), 0&
  70. End Sub

Prueba:
Código
  1. Private Sub Form_Load()
  2.    Dim c As New cFrogUCase
  3.    Debug.Print c.CorrectUCase("¿hola como estás?  esto es sólo una prueba Miguel... y además : ¡funciona genial!  amo a las ranas!.")
  4.    Set c = Nothing
  5. End Sub

Retorno:
Código:
¿Hola como estás?  Esto es sólo una prueba Miguel... Y además : ¡funciona genial!  Amo a las ranas!.

DoEvents! :P
« Última modificación: 18 Febrero 2011, 18:01 pm por Mr.Frog™ » En línea

Edu


Desconectado Desconectado

Mensajes: 1.082


Ex XXX-ZERO-XXX


Ver Perfil
Re: [RETO] uCaseCorrect. Corrector de Mayusculas!
« Respuesta #13 en: 16 Febrero 2011, 21:16 pm »

Je y entonces frog porq le decias a 79137913 de cambiar el reto? xD entonces mi codigo es valido, hace lo mismo q el tuyo :P
En línea

Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [RETO] uCaseCorrect. Corrector de Mayusculas!
« Respuesta #14 en: 16 Febrero 2011, 21:20 pm »

Je y entonces frog porq le decias a 79137913 de cambiar el reto? xD entonces mi codigo es valido, hace lo mismo q el tuyo :P
Me confundí al copiar el resultado después de tantas pruebas que hice, ya está arreglado. ;)

DoEvents! :P
En línea

Edu


Desconectado Desconectado

Mensajes: 1.082


Ex XXX-ZERO-XXX


Ver Perfil
Re: [RETO] uCaseCorrect. Corrector de Mayusculas!
« Respuesta #15 en: 16 Febrero 2011, 21:26 pm »

Citar
Retorno:
Código:
¿Hola como estás?  Esto es sólo una prueba Miguel... Y además : ¡funciona genial!  Amo a las ranas!.

Despues de "¿Hola como estás? " no empezaria en minuscula?

Esta bien de cualkier forma q lo hagan para mi, la idea del reto se cumple ;)
En línea

Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [RETO] uCaseCorrect. Corrector de Mayusculas!
« Respuesta #16 en: 16 Febrero 2011, 21:31 pm »

Despues de "¿Hola como estás? " no empezaria en minuscula?

Esta bien de cualkier forma q lo hagan para mi, la idea del reto se cumple ;)
Mayúsculas después de :
Código:
.
!
?

DoEvents! :P
En línea

Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [RETO] uCaseCorrect. Corrector de Mayusculas!
« Respuesta #17 en: 17 Febrero 2011, 02:19 am »

Error:

Código
  1. Debug.Print uCaseCorrect7913(" hola. esto es solo! ¿una prueba? jajjaja")

Código:
Llamada a argumento o procedimiento no válidos

Código
  1. Private Function uCaseCorrect7913(Txt As String) As String
  2. Dim X         As Long
  3. Dim Y         As Long
  4. Dim Aux()     As String
  5. Dim MED       As Long
  6. Dim Ubi()     As Long
  7. Dim SIGNO(4)  As String
  8.  
  9. SIGNO(0) = ".": SIGNO(1) = "?": SIGNO(2) = "!"   'TOMADO DE XXX-ZERO-XXX
  10.  
  11.  
  12. Txt = Txt & "a"
  13. ReDim Ubi(Len(Txt) + 5)
  14.    '.?¡
  15.    For X = 0 To 2
  16.        Do
  17.            Y = Y + 1
  18.            Ubi(Y) = InStr(Ubi(Y - 1) + 1, Txt, SIGNO(X))
  19.        Loop While Ubi(Y) <> 0
  20.    Next
  21.    'vbNewLine--------vbNewLine
  22.    Aux = Split(Txt, vbNewLine)
  23.    For X = 0 To UBound(Aux)
  24.        Mid$(Aux(X), 1, 1) = UCase$(Mid$(Aux(X), 1, 1))
  25.    Next
  26.    For X = 0 To UBound(Aux)
  27.        If X = 0 Then
  28.            Mid$(Aux(X), 1, 1) = UCase$(Mid$(Aux(X), 1, 1))
  29.        Else
  30.            If Right$(Aux(X - 1), 1) = "." Or Right$(Aux(X - 1), 1) = "?" Or Right$(Aux(X - 1), 1) = "!" Then
  31.                Mid$(Aux(X), 1, 1) = UCase$(Mid$(Aux(X), 1, 1))
  32.            End If
  33.        End If
  34.    Next
  35.    uCaseCorrect7913 = Mid$(uCaseCorrect7913, 1, Len(uCaseCorrect7913) - 3)
  36. End Function

DoEvents! :P
En línea

BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [RETO] uCaseCorrect. Corrector de Mayusculas!
« Respuesta #18 en: 17 Febrero 2011, 05:10 am »

@Mr. Frog

Errores:

Código:

¡Cómo ha nevado esta noche!; ¡qué blanco está todo!; ¡qué frío vamos a pasar hoy!» [RAE: Ortografía, 1999, § 5.6.4]


Código:

¿hola como estás? , esto es sólo una prueba Miguel... y además : ¡funciona genial!  amo a las ranas!.


Dulces Lunas!¡.
« Última modificación: 17 Febrero 2011, 05:15 am por BlackZeroX▓▓▒▒░░ » En línea

The Dark Shadow is my passion.
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [RETO] uCaseCorrect. Corrector de Mayusculas!
« Respuesta #19 en: 17 Febrero 2011, 09:23 am »

Ook, gracias, ya modifiqué, ahora creo que ya está. :D

Código
  1. Private Sub Form_Load()
  2.    Dim c As New Class1
  3.    Debug.Print "----------------------------------------------------"
  4.    Debug.Print c.CorrectUCase("¡Cómo ha nevado esta noche!; ¡qué blanco está todo!; ¡qué frío vamos a pasar hoy!» [RAE: Ortografía, 1999, § 5.6.4]")
  5.    Debug.Print c.CorrectUCase("¿hola como estás? , esto es sólo una prueba Miguel... y además : ¡funciona genial!  amo a las ranas!.")
  6.    Set c = Nothing
  7. End Sub

Resultado:
Código:
----------------------------------------------------
¡Cómo ha nevado esta noche!; ¡qué blanco está todo!; ¡qué frío vamos a pasar hoy!» [RAE: Ortografía, 1999, § 5.6.4]
¿Hola como estás? , Esto es sólo una prueba Miguel... Y además : ¡funciona genial!  Amo a las ranas!.

Si veis algún detalle más a corregir decirlo ;)

DoEvents! :P
« Última modificación: 17 Febrero 2011, 11:15 am por Mr. Frog © » En línea

Páginas: 1 [2] 3 4 Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Corrector ortografico « 1 2 3 »
Sugerencias y dudas sobre el Foro
d(-_-)b 23 15,096 Último mensaje 9 Diciembre 2007, 20:21 pm
por Ragnarok
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines