Hola, a ver si me podeis ayudar...
Es muy sencillo lo que pido...
Tengo esto:
Esto me saca todos los "hola" del texto, pero como seria para que no hiciera distincion entre mayusculas y minusculas?¿
Es decir que me sacara tambien :
Gracias  

Pd: Utilizo VB...

DoEvents¡!

Hola, bueno aqui os traigo este buscador de adminpaths, no es que me apasione el tema del Deface y esas cosas, pero en fin...
Aviso de antemano que no tengo ni idea de esto, si veis cualquier cosa decidmela...

'----------------------------------------------------------------------------------------
' *Module  : mCheckAdminPath.bas
' *Author  : *PsYkE1*
' *Mail    : vbpsyke1@mixmail.com
' *Date    : 28/7/10
' *Purpose : Search admin paths of a Website
' *Greets  : xassiz
' *Web     : http://foro.rthacker.net
' *References : http://xassiz.blogspot.com/2009/12/tool-xassiz-pathfinder-by-xassiz.html
'----------------------------------------------------------------------------------------
 
Option Explicit
 
Public Function Check_Admin_Path(ByVal sWebSite As String) As String
    Dim sPosiblePath()          As String
    Dim sPosiblePass()          As String
    Dim sActualPath             As String
    Dim lTotalPosiblePass       As Long
    Dim lTotalPosiblePaths      As Long
    Dim y                       As Long
    Dim x                       As Long
 
    Const Paths As String = "admin/,paneldecontrol/,login/,adm/,cms/,admon/,administrador/,admin/login.php,ADMIN/login.php,admin/home.php,admin/controlpanel.html,admin/controlpanel.php,admin.php,admin.html,admin/cp.php,admin/cp.html,cp.php,cp.html,controlpanel/,panelc/,administrator/index.php,administrator/login.html,administrator/login.php,administrator/account.html," _
& "administrator/account.php,administrator.php,administrator.html,login.php,login.html,modelsearch/login.php,moderator.php,moderator.html,moderator/login.php,moderator/login.html,moderator/admin.php,moderator/admin.html,moderator/,account.php,account.html,controlpanel/," _
& "admin/index.asp,admin/login.asp,admin/home.asp,admin/controlpanel.asp,admin.asp,admin/cp.asp,cp.asp,administrator/index.asp,administrator/login.asp,administrator/account.asp,administrator.asp,login.asp,modelsearch/login.asp,moderator.asp,moderator/login.asp,moderator/admin.asp,account.asp," _
& "controlpanel.asp,admincontrol.asp,adminpanel.asp,fileadmin/,fileadmin.php,fileadmin.asp,fileadmin.html,administration/,administration.php,administration.html,sysadmin.php,sysadmin.html,phpmyadmin/,myadmin/,sysadmin.asp,sysadmin/,ur-admin.asp,ur-admin.php,ur-admin.html,ur-admin/,Server.php,Server.html,Server.asp,Server/,wp-admin/,administr8.php,administr8.html," _
& "administr8/,administr8.asp,webadmin/,webadmin.php,webadmin.asp,webadmin.html,administratie/,admins/,admins.php,admins.asp,admins.html,administrivia/,Database_Administration/,WebAdmin/,sysadmins/,admin1/,system-administration/,administrators/,pgadmin/,directadmin/,staradmin/,ServerAdministrator/,SysAdmin/,administer/,sys-admin/,typo3/," _
& "panel/,cpanel/,cPanel/,cpanel_file/,platz_login/,rcLogin/,blogindex/,formslogin/,autologin/,support_login/,meta_login/,manuallogin/,simpleLogin/,loginflat/,utility_login/,showlogin/,memlogin/,members/,login-redirect/,sub-login/,wp-login/,login1/,dir-login/,login_db/,xlogin/,smblogin/,customer_login/,login-us/,acct_login/,admin_area/,bigadmin/,project-admins/,phppgadmin/,pureadmin/," _
& "sql-admin/,radmind/,openvpnadmin/,wizmysqladmin/,vadmind/,ezsqliteadmin/,pwebjetadmin/,newsadmin/,adminpro/,Lotus_Domino_Admin/,bbadmin/,vmailadmin/,Indy_admin/,ccp14admin/,irc-macadmin/,banneradmin/,sshadmin/,phpldapadmin/,macadmin/,administratoraccounts/,admin4_account/,admin4_colon/,radmind-1/,Super-Admin/,AdminTools/,cmsadmin/,SysAdmin2/,globes_admin/,cadmins/,phpSQLiteAdmin/,navSiteAdmin/,server_admin_small/," _
& "logo_sysadmin/,server/,database_administration/,ADMIN/login.html,system_administration/,ss_vms_admin_sm/"
 
    Const Pass As String = "username/,usuario/,user/,password/,contraseña/,senha/,pass/,pwd/,psswrd/"
 
    If Len(sWebSite) > 0 Then
        If Right$(sWebSite, 1) <> "/" Then sWebSite = sWebSite & "/"
 
        sPosiblePass() = Split(Pass, ",")
        sPosiblePath() = Split(Paths, ",")
        lTotalPosiblePass = UBound(sPosiblePass())
        lTotalPosiblePaths = UBound(sPosiblePath())
 
        If Check_Web_Exists(sWebSite) = True Then
            For x = 0 To lTotalPosiblePaths
                sActualPath = sWebSite & sPosiblePath(x)
                If Check_Web_Exists(sActualPath) = True Then
                    For y = 0 To lTotalPosiblePass
                        sActualPath = sWebSite & sPosiblePath(x) & sPosiblePass(y)
                        If Check_Web_Exists(sActualPath) = True Then
                            Check_Admin_Path = sActualPath
                            Exit Function
                        End If
                    Next
                End If
            Next
        End If
    End If
End Function
 
Function Check_Web_Exists(ByVal sURL As String) As Boolean
    Dim oXHTTP          As Object
    Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
 
    If Not UCase$(sURL) Like "HTTP:*" Then sURL = "http://" & sURL
 
    On Error GoTo Error_
    With oXHTTP
        .Open "HEAD", sURL, False
        .Send
        If .Status = 200 Then Check_Web_Exists = True
    End With
 
    Set oXHTTP = Nothing
    Exit Function
Error_:
End Function

Un ejemplo:

Private Sub Form_Load()
    Dim sWeb        As String
    Dim sResult     As String
 
    sWeb = "http://www.xxxxxxxxxxx.net"
    sResult = Check_Admin_Path(sWeb)
 
    If Len(sResult) > 0 Then
        Debug.Print sResult
    Else
        Debug.Print "Not Found... :("
    End If
End Sub

Devuelve por ejemplo:

DoEvents¡!

'-------------------------------------------------------
' *Module  : mTranslator
' *Author  : *PsYkE1*
' *Mail    : vbpsyke1@mixmail.com
' *Date    : 27/7/10
' *Purpose : Translate any text using Google Translator
' *Web     : http://foro.rthacker.net
'-------------------------------------------------------
 
Option Explicit
 
Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
 
Public Const IF_NO_CACHE_WRITE = &H4000000
 
Public Function Get_Html_Code(sURL As String) As String
    Dim sBuffer         As String * 1000
    Dim lInternet       As Long
    Dim lFile           As Long
    Dim lRead           As Long
 
    lInternet = InternetOpen(0, 1, vbNullString, vbNullString, 0)
    If lInternet <> 0 Then
        lFile = InternetOpenUrl(lInternet, sURL, vbNullString, 0, IF_NO_CACHE_WRITE, 0)
        If lFile <> 0 Then
            Do
                Call InternetReadFile(lFile, sBuffer, 1000, lRead): DoEvents
                Get_Html_Code = Get_Html_Code & Left$(sBuffer, lRead)
            Loop While lRead <> 0
        End If
        Call InternetCloseHandle(lInternet)
    End If
End Function
 
Public Function Simplified_Language(ByVal sLenguage As String) As String
 
    sLenguage = LCase$(sLenguage)
 
    Select Case sLenguage
        Case "albanian":        Simplified_Language = "sq"
        Case "german":          Simplified_Language = "de"
        Case "armenian":        Simplified_Language = "hy"
        Case "bulgarsk":        Simplified_Language = "bg"
        Case "greek":           Simplified_Language = "el"
        Case "dutch":           Simplified_Language = "nl"
        Case "polish":          Simplified_Language = "pl"
        Case "portuguese":      Simplified_Language = "pt"
        Case "spanish":         Simplified_Language = "es"
        Case "swedish":         Simplified_Language = "sv"
        Case "czech":           Simplified_Language = "cs"
        Case "german":          Simplified_Language = "de"
        Case Else
            Simplified_Language = Left$(sLenguage, 2)
        End Select
End Function
 
Public Function Text_Between_Words(ByVal sTextToAnalyze As String, ByVal sStartWord As String, ByVal sEndWord As String) As String
    Dim lPosition1             As Double
    Dim lPosition2             As Double
    Dim lStart                 As Double
 
    lPosition1 = InStr(sTextToAnalyze, sStartWord)
    If lPosition1 <> 0 Then
        lStart = lPosition1 + Len(sStartWord)
        lPosition2 = InStr(lStart, sTextToAnalyze, sEndWord)
    Else
        Exit Function
    End If
    If lPosition2 <> 0 Then Text_Between_Words = Mid$(sTextToAnalyze, lStart, lPosition2 - lStart)
End Function
 
Public Function Translate_Text(ByVal sTextToTranslate As String, ByVal sActualLenguage As String, ByVal sFutureLenguage As String) As String
    Const sGoogleTransUrl As String = "http://translate.google.com/?js=y&prev=_t&hl=es&ie=UTF-8&layout=1&eotf=1&text="
 
    '# Delimiters
    Const START_TRANSLATED_TEXT        As String = "onmouseout=""this.style.backgroundColor='#fff'"">"
    Const END_TRANSLATED_TEXT          As String = "<br>"
 
    Dim sGoogleHtml As String
 
    If sActualLenguage <> sFutureLenguage Then
        sTextToTranslate = Replace$(sTextToTranslate, Chr$(32), "%20")
        sActualLenguage = Simplified_Language(sActualLenguage)
        sFutureLenguage = Simplified_Language(sFutureLenguage)
 
        sGoogleHtml = Get_Html_Code(sGoogleTransUrl & sTextToTranslate & "%0D%0A%0D%0A&file=&sl=" & sActualLenguage & "&tl=" & sFutureLenguage & "#submit")
 
        Translate_Text = RTrim$(Text_Between_Words(sGoogleHtml, START_TRANSLATED_TEXT, END_TRANSLATED_TEXT))
    Else
        Translate_Text = sTextToTranslate
    End If
End Function

An example:

Debug.Print Translate_Text("Hoy estoy un poco cansado, pero creo que este proyecto sera grande.", "spanish", "english")

It returns:

DoEvents¡!

¿Como hago para poder leer caracteres especiales en un TextBox?
Necesito agregar algo asi por ejemplo:

Muchas gracias

DoEvents¡!

Hola, aver si me podeis ayudar:
Veamos, esta es mi expresion regular para obtener todo aquiello que este entre parentesis:
Como hago para que seleccione todo lo que esta entre parentesis peeeeeero sin el parentesis, me explico?

Gracias¡!

Hola, aqui os dejo una función para obtener la configuracion electronica de cualquier elemento de la tabla periódica...

Mas info: http://es.wikipedia.org/wiki/Configuraci%C3%B3n_electr%C3%B3nica

' ////////////////////////////////////////////////////////////////
' // *Autor: *PsYkE1* [vbpsyke1@mixmail.com]                    //
' // *Fecha: 20/7/10                                            //
' // *Podeis agrandar o reducir el codigo, siempre y cuando se  //
' //  respete la autoria y se me comuniquen esos cambios.       //
' // *Agradecimientos a raul338                                 //
' // *Visita http://foro.rthacker.net                           //
' ////////////////////////////////////////////////////////////////
 
Option Explicit
 
Public Function Get_Electronic_Configuration(ByVal bElementValence As Byte) As Collection
 
    Const ELECTRONIC_CONF        As String = "1s,2s,2p,3s,3p,4s,3d,4p,5s,4d,5p,6s,4f,5d,6p,7s,5f,6d"
    Const EXCEPTION_VALENCES_A   As String = "24,29"               '# Cr & Cu
    Const EXCEPTION_VALENCES_B   As String = "41,42,44,45,46,47"   '# Zr, Nb, Tc, Ru, Rh, Pd & Ag
    Const EXCEPTION_VALENCES_C   As String = "78,79"               '# Pt & Au
 
    Const LIMIT_SUBLEVEL_S   As Byte = 2
    Const LIMIT_SUBLEVEL_P   As Byte = 6
    Const LIMIT_SUBLEVEL_D   As Byte = 10
    Const LIMIT_SUBLEVEL_F   As Byte = 14
 
    Dim cTemp               As New Collection
    Dim sSubLevel()         As String
    Dim sActualItem         As String * 2
    Dim bInvalidValenceA    As Boolean
    Dim bInvalidValenceB    As Boolean
    Dim bInvalidValenceC    As Boolean
    Dim bElectron           As Byte
    Dim bActualLimit        As Byte
    Dim x                   As Byte
    Dim n                   As Byte
    Dim y                   As Byte
 
    If bElementValence > 0 And bElementValence < 112 Then '# Hasta el elemento Roentgenio [Uuu]
        sSubLevel() = Split(ELECTRONIC_CONF, ",")
 
        '# Compruebo si la valencia introducida es una excepción
        bInvalidValenceA = CBool (InStr(EXCEPTION_VALENCES_A, CStr(bElementValence)))
        bInvalidValenceB = CBool (InStr(EXCEPTION_VALENCES_B, CStr(bElementValence)))
        bInvalidValenceC = CBool (InStr(EXCEPTION_VALENCES_C, CStr(bElementValence)))
 
        For x = 0 To UBound(sSubLevel())
            sActualItem = sSubLevel(x)
 
            '# Reviso el subnivel en el que me encuentro
            Select Case Right$(sActualItem, 1)
                Case "s": bActualLimit = LIMIT_SUBLEVEL_S
                Case "p": bActualLimit = LIMIT_SUBLEVEL_P
                Case "d": bActualLimit = LIMIT_SUBLEVEL_D
                Case "f": bActualLimit = LIMIT_SUBLEVEL_F
            End Select
 
            '# Relleno cada capa de eletrones
            For y = 1 To bActualLimit
                If n <> bElementValence Then n = n + 1 Else Exit For
 
                '# Hay excepciones: Si la configuración electrónica acaba en d4 o en d9
                '# el subnivel anterior cede un electrón para estabilizarlo (en la mayoria de los casos)
                If (sActualItem = "4s" And bInvalidValenceA = True) Or (sActualItem = "5s" And bInvalidValenceB = True) Or _
                sActualItem = "6s" And bInvalidValenceC = True Then
                    bElectron = 1
                    Exit For
                Else
                    bElectron = bElectron + 1
                End If
            Next y
 
            '# Añado el Item con los electrones que tenga
            cTemp.Add sActualItem & CStr(bElectron)
 
            If n = bElementValence Then Exit For
            bElectron = 0
        Next x
        Set Get_Electronic_Configuration = cTemp
    End If
End Function

Para que veais, un ejemplo:

Private Sub Form_Load()
    Dim sResult        As String
    Dim vItem          As Variant
    Dim z              As Byte
 
    z = 29 '# El Cobre [Cu]
 
    For Each vItem In Get_Electronic_Configuration(z)
        sResult = sResult & vItem & " "
    Next vItem
 
    Debug.Print sResult
End Sub

Me devuelve esto:

Si en la variable z pongo 97 (Berkelio [Bk]) me da esto:

Bueno esto es todo...

PD: Saludo a mi profesora de clases Marta Suarez  

DoEvents¡!

Creo que puede ser divertido, empezare yo:

• Escéptico
• Gracioso
• Insistente

SAlu2!

Hola chicos, esta es mi ultima funcion que sirve para simplificar arrays numéricos.
En realidad es un reto que me puso mi maestro BlackZer0X!

Añadir mi clase cCollectionEx.cls

'=========================================================
' º Function : Abbreviate_Numeric_Array
' º Author   : Mr. Frog ©
' º Mail     : vbpsyke1@mixmail.com
' º Recommended Websites :
'       http://blog.visual-coders.com.ar/
'       http://InfrAngeluX.Sytes.Net/
'=========================================================
Option Explicit
Option Base 0
 
Rem Añadir mi clase cCollectionEx.cls
 
Public Function Abbreviate_Numeric_Array(ByRef vNumberList() As Variant) As cCollectionEx
If (Not vNumberList) = -1 Then Exit Function
Dim cExTemp                                         As New cCollectionEx
Dim lActualNumber                                   As Variant
Dim lToTalNumbers                                   As Long
Dim Q                                               As Long
Dim W                                               As Long
    lToTalNumbers = UBound(vNumberList())
    If lToTalNumbers > 2 Then
        Do While Q <= lToTalNumbers
            lActualNumber = vNumberList(Q)
            W = 0
            If (Q < lToTalNumbers) Then
                Do While (vNumberList(Q) + 1 = vNumberList(Q + 1)) Or _
                         (vNumberList(Q) = vNumberList(Q + 1))
                    Q = Q + 1
                    W = W + 1
                Loop
            End If
            With cExTemp
                If W > 1 Then
                    .Add lActualNumber & "~" & vNumberList(Q)
                Else
                    .Add lActualNumber
                End If
            End With
            If Not (W = 1) Then Q = Q + 1
        Loop
        Set Abbreviate_Numeric_Array = cExTemp
    End If
End Function

Ejemplo:

Private Sub Form_Load()
Dim Q                                   As Long
Dim dArray()                            As Variant
Dim sResult                             As String
 
    dArray() = Array(1, 2, 3, 4, 4, 5, 6, 7, 7, 7, 65, 345, 4545, 4546, 4547, 9999999, 9999999999#)
 
    With Abbreviate_Numeric_Array(dArray)
        For Q = 1 To .Count
            sResult = sResult & .Item(Q) & "|"
        Next Q
    End With
 
    Debug.Print sResult
End Sub

Obtengo esto:

---

Ahora mi funcion para desabreviar...

'=========================================================
' º Function : DeAbbreviate_Numeric_Array
' º Author   : Mr. Frog ©
' º Mail     : vbpsyke1@mixmail.com
' º Recommended Websites :
'       http://blog.visual-coders.com.ar/
'       http://InfrAngeluX.Sytes.Net/
'=========================================================
Option Explicit
Option Base 0
 
Public Function DeAbbreviate_Numeric_Array(ByRef sNumbersItems() As String) As cCollectionEx
If (Not sNumbersItems) = -1 Then Exit Function
Dim cExTemp                                         As New cCollectionEx
Dim sActualItem                                     As String
Dim sNumbers()                                      As String
Dim lToTalItems                                     As Long
Dim Q                                               As Long
Dim W                                               As Long
    lToTalItems = UBound(sNumbersItems())
    If lToTalItems > 2 Then
        For Q = 0 To lToTalItems
            sActualItem = sNumbersItems(Q)
            If sActualItem Like "*~*" Then
                sNumbers() = Split(sActualItem, "~")
                For W = CDbl(sNumbers(0)) To CDbl(sNumbers(1))
                    cExTemp.Add W
                Next W
            Else
                cExTemp.Add sActualItem
            End If
        Next Q
        Set DeAbbreviate_Numeric_Array = cExTemp
    End If
End Function

Un ejemplo:

Private Sub Form_Load()
Dim sArray()                    As String
Dim Q                           As Long
 
    sArray() = Split("1|2|8|9|34|56~58|9999~10002|", "|")
    With DeAbbreviate_Numeric_Array(sArray())
        For Q = 1 To .Count
            Debug.Print .Item(Q)
        Next Q
    End With
End Sub

Me da esto:

DoEvents!

Pues eso...
¿Cual es la pero pelicula que has visto en la vida?
A ver si alguien supera a esta:



Salu2!

Hola, se que debo de ser un pesado ya con tanta cadena, pero bueno...
Aqui os dejo esta funcion que acabo de hacer, que igual a alguien le es util...

' ////////////////////////////////////////////////////////////////
' // *Autor: *PsYkE1* (miguelin.majo@gmail.com)                 //
' // *Podeis agrandar o reducir el codigo, siempre y cuando se  //
' // respete la autoria y se me comuniquen esos cambios.        //
' // *Visita http://foro.rthacker.net                           //
' ////////////////////////////////////////////////////////////////
 
Option Explicit
 
Public Function Text_Beetwen_Chars(ByVal sStringToAnalyze, ByVal sCharStart, ByVal sCharEnd, _
Optional ByVal bRemoveString As Boolean = True)
    Dim sActualChar          As String * 1
    Dim sPreviousChar        As String * 1
    Dim bFlag                As Boolean
    Dim lToTalLen            As Long
    Dim lToTalChar           As Long
    Dim x                    As Long
    Dim y                    As Long
 
    lToTalChar = Len(sStringToAnalyze)
    If (lToTalChar > 0) And (sCharStart <> sCharEnd) Then
        For x = 1 To lToTalChar
            If x > 1 Then sPreviousChar = Mid$(sStringToAnalyze, x - 1, 1)
            sActualChar = Mid$(sStringToAnalyze, x, 1)
            lToTalLen = Len(Text_Beetwen_Chars)
            Select Case sActualChar
                Case sCharStart
                    If bFlag = False Then bFlag = True Else y = y + 1
                    If sPreviousChar = Chr$(32) And y = 0 And lToTalLen > 0 Then
                        Text_Beetwen_Chars = Left$(Text_Beetwen_Chars, (lToTalLen - 1))
                    End If
                    If bRemoveString = True Then sActualChar = Chr$(32)
                Case sCharEnd
                    If y = 0 Then bFlag = False Else y = y - 1
                    If bRemoveString = True Then sActualChar = Chr$(32)
            End Select
            If bFlag = bRemoveString And (sActualChar <> sCharStart And sActualChar <> sCharEnd) Then
                Text_Beetwen_Chars = Text_Beetwen_Chars & sActualChar
            End If
        Next x
    End If
End Function

Un ejemplos:

Tengo un texto y quiero omitir todo lo que este entre parentesis...

Private Sub Form_Load()
    Debug.Print Text_Beetwen_Chars("Hola amigos (esto solo es una prueba(jejejeje) ), de este modo veis que funciona...", "(", ")", False)
End Sub

Me devuelve:

Y ahora el caso contrario, supongamos que necesito SOLO el texto que se encuentra entre parentesis:

Private Sub Form_Load()
    Debug.Print Text_Beetwen_Chars("Hola amigos (esto solo es una prueba(jejejeje) ), de este modo veis que funciona...", "(", ")") ' Por defecto bRemoveString es True =)
End Sub

Este es el resultado:

Si me animo un dia de estos la mejorare...
Espero que a alguien le sirva!!

Salu2!