Mensajes

[Mid(), Split()]

Quizá ya un poco tarde...

Aqui dejo mi 2ª forma, a diferencia de todas las demas sin depender de Mid(), Split()...

Código (vb) [Seleccionar] Expandir

Option Explicit
Option Base 0

Private Declare Function ArrayPtr Lib "msvbvm60" Alias "VarPtr" (ByRef Ptr() As Any) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)

Private Function MrFrogInstrII(ByVal lngStart As Long, ByRef strString1 As String, ByRef strString2 As String) As Long
Dim lngLenS2 As Long, lngLenS1 As Long, lngLimit As Long
Dim lngAscHeader1(5) As Long, lngAscHeader2(5) As Long
Dim intAscS1() As Integer, intAscS2() As Integer
Dim Q As Long, C As Long

   If lngStart > 0 Then
       lngLenS2 = LenB(strString2) \ 2
       If lngLenS2 > 0 Then
           lngLenS1 = LenB(strString1) \ 2
           lngLimit = lngLenS1 - lngLenS2 - 1
           If lngLimit > 1 Then
               lngAscHeader1(0) = &H1
               lngAscHeader1(1) = &H2
               lngAscHeader1(3) = StrPtr(strString1)
               lngAscHeader1(4) = lngLenS1
               PutMem4 ArrayPtr(intAscS1), VarPtr(lngAscHeader1(0))
               
               lngAscHeader2(0) = &H1
               lngAscHeader2(1) = &H2
               lngAscHeader2(3) = StrPtr(strString2)
               lngAscHeader2(4) = lngLenS2 + 1
               PutMem4 ArrayPtr(intAscS2), VarPtr(lngAscHeader2(0))
               
               Q = lngStart - 1
               Do While Q < lngLimit
                   Do While intAscS1(Q + C) = intAscS2(C)
                       C = C + 1
                       If C = lngLenS2 Then
                           MrFrogInstrII = Q + 1
                           GoTo NullifyArr
                       End If
                   Loop
                   Q = Q + C + 1
                   C = 0
               Loop
NullifyArr:
               PutMem4 ArrayPtr(intAscS1), &H0
               PutMem4 ArrayPtr(intAscS2), &H0
           End If
       End If
   End If
End Function

Recordar quitar comprobación en los límites de arrays al compilar!
Debería haber tambien tests con cadenas laaaargas!

DoEvents!

Que le paso al server?

Se refiere a él mismo:

yo opino que sí

=

un servidor opina que sí

DoEvents!

[CStr()]

No tengo tiempo ahora mismo de mirar todo pero:

Código (vb) [Seleccionar] Expandir

' me da un error en              dato = Nombre & "=cstr('"List2.List(i)"')"


Sería así:

Código (vb) [Seleccionar] Expandir

dato = Nombre & List2.List(i)
Las comillas están mal puestas y no es necesaria la conversión a String por medio de CStr() porque el listbox ya te devueve un String.

DoEvents!

Hola Black!
Parece que te estás pasando ya a Cpp eh?

Me gusta tu función Instr(), me recuerda a la que hice yo hace días en vb6 :

Código (c) [Seleccionar] Expandir

unsigned long instr(unsigned long start,char* string1,char* string2)
/*
   [Start] indica la posicion inicial donde se empesara a buscar en [string1]
   Retorna la posicion de [*string2] en [*string1].
   By BlackZeroX ( http://Infrangelux.sytes.net/ )
*/
{
   unsigned long  q,c,limit;
   q=c=limit=0;
   long ls2len=0;

   ls2len = strlen(string2) - 1;

   if ( ls2len >= 0 )
   {
       limit = strlen(string1)-ls2len;

       if ( limit > 1 )
       {
           q = start-1;
           while ( q < limit )
           {
               while ( string1[q+c] == string2[c] )
                   if ( (c++) == (unsigned long)ls2len )
                       return q+1;
               q+=c+1;
               c=0;
           }
       }
   } else if (*string1 > '\0') {
       return 1;
   }
   return 0;
}

Código (vb) [Seleccionar] Expandir

Option Explicit
Option Base 0

Private Function myInstr&(ByVal Start&, ByVal String1$, ByVal String2$)
Dim bvString1() As Byte, bvString2() As Byte
Dim ls2Len&, lLimit&
Dim Q&, C&
   ls2Len& = ((Len(String2$)) - &H1)
   If ls2Len& > -1 Then
       lLimit& = ((Len(String1$)) - ls2Len&)
       If lLimit& > 1 Then
           bvString1 = (VBA.StrConv(String1$, vbFromUnicode))
           bvString2 = (VBA.StrConv(String2$, vbFromUnicode))
           Q& = (Start& - &H1)
           Do While (Q& < lLimit&)
               Do While (bvString1(Q& + C&) = bvString2(C&))
                   'Debug.Print ChrW$(bvString1(Q& + C&)); ChrW$(bvString2(C&))
                   C& = C& + &H1
                   If ((C& - &H1) = ls2Len&) Then
                       myInstr& = Q& + &H1
                       Exit Function
                   End If
               Loop
               Q& = (Q& + C&) + &H1
               C& = &H0
           Loop
       End If
   End If
End Function
http://goo.gl/Pv2Be


Un día de estos que no estés ocupado te tengo que preguntar dudas por msn...

DoEvents!

Exacto, puedes usar el control de raul, esta muy bien!
O también podrías usar un Hook.

DoEvents!

Mirate esto:
http://goo.gl/EYFcd

DoEvents!

[GetTextExtentPoint32()]

Hice una clase hace poco donde tenía que hacer algo similar con api GetTextExtentPoint32() y GetClientRect():
http://foro.elhacker.net/programacion_visual_basic/src_clistboxmultialign_by_mr_frog_copy-t314001.0.html

Tambien mira esto:

Código (vb) [Seleccionar] Expandir

Option Explicit
'=========================================================
' º Function : AlignCenterLBItem
' º Author   : Mr.Frog ©
' º Mail     : vbpsyke1@mixmail.com
' º Greets   : LeandroA
' º Recommended Websites :
'       http://visual-coders.com.ar
'       http://InfrAngeluX.Sytes.Net
'       http://twitter.com/#!/PsYkE1
'=========================================================

Public Function AlignCenterLBItem(myListbox As ListBox, ByVal sItem As String) As String
Dim lItemLen                                           As Long
   If Not (myListbox Is Nothing) Then
       lItemLen = myListbox.Parent.TextWidth(sItem)
       If lItemLen < myListbox.Width Then
           AlignCenterLBItem = Space$(Abs(Int((Int(myListbox.Width - lItemLen) / 2) / myListbox.Parent.TextWidth(Space$(1)) - 1.5))) & sItem
       End If
   End If
End Function
Puedes relaccionar el tamaño del ListBox, con lo que ocupa un espacio...

DoEvents!

Tengo aún más examenes...
Ya lo haré cuando pueda.

DoEvents!

O otra opción para hacerlo sin RegExp sería algo similar a esto:

Código (vb) [Seleccionar] Expandir


'Añade un TextBox, con el texto
Option Explicit

Private Sub Form_Load()
Dim sArr()          As String
Dim lLimit          As Long
Dim Q               As Long

   sArr = Split(Text1.Text, "<td>")
   lLimit = UBound(sArr)
   Q = 5
   
   Do While Q < lLimit
       MsgBox ParseString(sArr(Q)) _
              & vbNewLine _
              & ParseString(sArr(Q + 1))
       Q = Q + 8
   Loop
End Sub

Private Function ParseString(ByVal sText As String) As String
   ParseString = Split(sText, "</td>", 2)(0)
End Function

DoEvents!

[¡Bienvenido al foro!]

¡Bienvenido al foro!

Usa RegExp para sacar todo lo que hay entre <td> y </td>. (usa el buscador, hay códigos míos por el foro)
El texto siempre seguirá esta serie?

Fijate:

Código (vb,6,7,16,17,26,27) [Seleccionar] Expandir


'<tr style="background-color:#222222">
'   <td>3COM</td>
'   <td>CoreBuilder</td>
'   <td>7000/6000/3500/2500</td>
'   <td>Telnet</td>
'   <td>debug</td>
'   <td>synnet</td>
'   <td></td>
'   <td></td>
'  </tr>
'  <tr style="background-color:#000000">
'   <td>3COM</td>
'   <td>CoreBuilder</td>
'   <td>7000/6000/3500/2500</td>
'   <td>Telnet</td>
'   <td>tech</td>
'   <td>tech</td>
'   <td></td>
'   <td></td>
'  </tr>
'  <tr style="background-color:#222222">
'   <td>3COM</td>
'   <td>HiPerARC</td>
'   <td>v4.1.x</td>
'   <td>Telnet</td>
'   <td>adm</td>
'   <td>(none)</td>
'   <td></td>
'   <td></td>
'  </tr>


A las 6 lineas te encontrarás con el usuario y la línea sig. es la contraseña; cada 8 lineas te los volverás a encontrar.

DoEvents!