My listbox highlight moves fast!

[tony007]

Hi all i got a form that i need to process listbox items on by one automatically by sending it to a textbox but when i click command2 i see the highlight moves so fast and reaches last item in my listbox without allowing my textbox to process all listbox items. Could any one tell me how to solve this problem .Thanks

Private Sub Command2_Click()
 
Dim i As Long
For i = 0 To List1.ListCount - 1
   Text2 = List1.List(i)
   List1.Selected(i) = True
 
Next
 
End Sub
 
 
Private Sub Form_Load()
 
  List1.AddItem "item1"
    List1.AddItem "item2"
    List1.AddItem "item3"
    List1.AddItem "item4"
    List1.AddItem "item5"
     List1.AddItem "item6"
  List1.AddItem "item7"
  List1.AddItem "item8"
  List1.AddItem "item9"
 
End Sub

[Andrew G]

For i = 0 To List1.ListCount - 1
   Text2 = List1.List(i)
   List1.Selected(i) = True
   DoEvents
Next

[tony007]

For i = 0 To List1.ListCount - 1
   Text2 = List1.List(i)
   List1.Selected(i) = True
   DoEvents
Next

Thank u for u reply. I tried this now i see the value keep chang in my textbox like in my listbox i got 2000 items!! and i scans them in like 4 seconds.And my program only executes 2 of them !!! I tried the following code where cmdSend_Click is a function that needs to make a post request to php script and output the result in another textbox. I need to do this a large amount of items from listbox and it failes each time . I tried sleep function and nothing got transfred to textbox2. I be happy if i get helping in achiving this task.Thanks

Private Sub Command1_Click()
 
Dim i As Long
For i = 0 To List2.ListCount - 1
 
List2.Selected(i) = True
txtVariableValue(0) = List2.List(i)
 
DoEvents
[B]cmdSend_Click[/B]
Next
 
End Sub

[Andrew G]

Wats in your CmdSend_Click Sub?

[tony007]

Wats in your CmdSend_Click Sub?

Complete code and importent part shown in bold:

Option Explicit
'' this 3 lines to add scroll bar to listbox
Private Declare Function ShowScrollBar Lib "user32" (ByVal hwnd As Long, ByVal wBar As Long, _
ByVal bShow As Long) As Long
'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Private Const SB_HORIZONTAL = 0
' we set this to true whil a connection is established
Private blnConnected As Boolean
 
 
 
' this function sends the HTTP request
[B]Private Sub cmdSend_Click()[/B]
 
    Dim eUrl As URL
    
    Dim strMethod As String
    Dim strData As String
    Dim strPostData As String
    Dim strHeaders As String
    
    Dim strHTTP As String
    Dim X As Integer
    
    strPostData = ""
    strHeaders = ""
    strMethod = cboRequestMethod.List(cboRequestMethod.ListIndex)
    
    If blnConnected Then Exit Sub
    
    ' get the url
    eUrl = ExtractUrl(txtUrl.Text)
    
    If eUrl.Host = vbNullString Then
        MsgBox "Invalid Host", vbCritical, "ERROR"
    
        Exit Sub
    End If
    
    ' configure winsock
    winsock.Protocol = sckTCPProtocol
    winsock.RemoteHost = eUrl.Host
    
    If eUrl.Scheme = "http" Then
        If eUrl.Port > 0 Then
            winsock.RemotePort = eUrl.Port
        Else
            winsock.RemotePort = 80
        End If
    ElseIf eUrl.Scheme = vbNullString Then
        winsock.RemotePort = 80
    Else
        MsgBox "Invalid protocol schema"
    End If
    
    ' build encoded data the data is url encoded in the form
    ' var1=value&var2=value
    strData = ""
    For X = 0 To txtVariableName.Count - 1
        If txtVariableName(X).Text <> vbNullString Then
        
            strData = strData & URLEncode(txtVariableName(X).Text) & "=" & _
                            URLEncode(txtVariableValue(X).Text) & "&"
        End If
    Next X
    
    If eUrl.Query <> vbNullString Then
        eUrl.URI = eUrl.URI & "?" & eUrl.Query
    End If
    
    ' check if any variables were supplied
    If strData <> vbNullString Then
        strData = Left(strData, Len(strData) - 1)
        
        
        If strMethod = "GET" Then
            ' if this is a GET request then the URL encoded data
            ' is appended to the URI with a ?
            If eUrl.Query <> vbNullString Then
                eUrl.URI = eUrl.URI & "&" & strData
            Else
                eUrl.URI = eUrl.URI & "?" & strData
            End If
        Else
            ' if it is a post request, the data is appended to the
            ' body of the HTTP request and the headers Content-Type
            ' and Content-Length added
            strPostData = strData
            strHeaders = "Content-Type: application/x-www-form-urlencoded" & vbCrLf & _
                         "Content-Length: " & Len(strPostData) & vbCrLf
                         
        End If
    End If
            
    ' get any aditional headers and add them
    For X = 0 To txtHeaderName.Count - 1
        If txtHeaderName(X).Text <> vbNullString Then
        
            strHeaders = strHeaders & txtHeaderName(X).Text & ": " & _
                            txtHeaderValue(X).Text & vbCrLf
        End If
    Next X
    
    ' clear the old HTTP response
    'txtResponse.Text = ""
    
    ' build the HTTP request in the form
    '
    ' {REQ METHOD} URI HTTP/1.0
    ' Host: {host}
    ' {headers}
    '
    ' {post data}
    strHTTP = strMethod & " " & eUrl.URI & " HTTP/1.0" & vbCrLf
    strHTTP = strHTTP & "Host: " & eUrl.Host & vbCrLf
    strHTTP = strHTTP & strHeaders
    strHTTP = strHTTP & vbCrLf
    strHTTP = strHTTP & strPostData
 
    txtRequest.Text = strHTTP
    
    winsock.Connect
    
    ' wait for a connection
    While Not blnConnected
        DoEvents
    Wend
    
    ' send the HTTP request
    winsock.SendData strHTTP
 
    Command3_Click
End Sub
 
 
' transfer all urls i loop
[B]Private Sub Command1_Click()
 
Dim i As Long
For i = 0 To List2.ListCount - 1
 
List2.Selected(i) = True
txtVariableValue(0) = List2.List(i)
'MsgBox List2.List(i)
DoEvents
cmdSend_Click
Next
 
End Sub[/B]
 
 
Private Sub txtVariableValue_Change(Index As Integer)
cmdSend_Click
 
End Sub
 
 
 
'transfer url one by one function
Private Sub Command2_Click()
 
txtVariableValue(0) = List2.Text
End Sub
 
'writes the content of text box to a file
' this funcion needs to write to a text file
Private Sub Command3_Click()
'Dim Parser As New clsXMLParser
 ' Dim Node As clsXMLNode
  'Dim Child As clsXMLNode
  Dim fn As Long
  'Dim i As Long
  
 'Dim path As String
  'Dim title As String
  
  fn = FreeFile
  Open "C:\file.txt" For Append As #fn
  'Yes. Use Print #fn instead of Write #fn
    'Write #fn, Text4.Text
    Print #fn, txtResponse.Text
  Close #fn
  
 
 
 
End Sub
 
 
 
 
 
Private Sub winsock_Connect()
    blnConnected = True
End Sub
 
' this event occurs when data is arriving via winsock
Private Sub winsock_DataArrival(ByVal bytesTotal As Long)
    Dim strResponse As String
 
    winsock.GetData strResponse, vbString, bytesTotal
    
    strResponse = FormatLineEndings(strResponse)
    
    ' we append this to the response box becuase data arrives
    ' in multiple packets
    txtResponse.Text = txtResponse.Text & strResponse
    
End Sub
 
Private Sub winsock_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    MsgBox Description, vbExclamation, "ERROR"
    
    winsock.Close
End Sub
 
Private Sub winsock_Close()
    blnConnected = False
    
    winsock.Close
End Sub
 
' this function converts all line endings to Windows CrLf line endings
Private Function FormatLineEndings(ByVal str As String) As String
    Dim prevChar As String
    Dim nextChar As String
    Dim curChar As String
    
    Dim strRet As String
    
    Dim X As Long
    
    prevChar = ""
    nextChar = ""
    curChar = ""
    strRet = ""
    
    For X = 1 To Len(str)
        prevChar = curChar
        curChar = Mid$(str, X, 1)
                
        If nextChar <> vbNullString And curChar <> nextChar Then
            curChar = curChar & nextChar
            nextChar = ""
        ElseIf curChar = vbLf Then
            If prevChar <> vbCr Then
                curChar = vbCrLf
            End If
            
            nextChar = ""
        ElseIf curChar = vbCr Then
            nextChar = vbLf
        End If
        
        strRet = strRet & curChar
    Next X
    
    FormatLineEndings = strRet
End Function
 
Private Sub Form_Load()
    cboRequestMethod.ListIndex = 0
    blnConnected = False
    
    
   [B]List2.AddItem "item1"
    List2.AddItem "item2"
    List2.AddItem "item3"
    List2.AddItem "item4"
    List2.AddItem "item5"
     List2.AddItem "item6"
  List2.AddItem "item7"
  List2.AddItem "item8"
  List2.AddItem "item9"[/B]
 
End Sub
 
' the code below has nothing to do with winsock or HTTP and deals only with the
' display and manipulation of controls
Private Sub cmdMoreHeaders_Click()
    Dim intNext As Integer
    Dim lngTop As Long
    
    ' find the next control
    intNext = txtHeaderName.Count
    
    ' find the next top
    lngTop = txtHeaderName(intNext - 1).Top + txtHeaderName(intNext - 1).Height + 80
    
    ' add new controls
    Load lblHeaderName(intNext)
    Load txtHeaderName(intNext)
    Load lblHeaderValue(intNext)
    Load txtHeaderValue(intNext)
    
                                  
    With lblHeaderName(intNext)
        .Top = lngTop
        .Left = lblHeaderName(intNext - 1).Left
        .Visible = True
    End With
    
    With txtHeaderName(intNext)
        .Top = lngTop
        .Left = txtHeaderName(intNext - 1).Left
        .Visible = True
        .Text = ""
    End With
        
    With lblHeaderValue(intNext)
        .Top = lngTop
        .Left = lblHeaderValue(intNext - 1).Left
        .Visible = True
    End With
    
    With txtHeaderValue(intNext)
        .Top = lngTop
        .Left = txtHeaderValue(intNext - 1).Left
        .Visible = True
        .Text = ""
    End With
    
    ' set the new height of the controls container
    pbxHeaders.Height = txtHeaderName(intNext).Top + txtHeaderName(intNext).Height + 80
    
    ' check if we should activate the scroll bar, ie: the outerbox
    ' is higher than the inner box
    If pbxHeaders.Height > pbxOHeaders.Height Then
        With vsbHeaders
            .Enabled = True
            .SmallChange = txtHeaderName(intNext).Height
            .LargeChange = pbxOHeaders.Height
            .Min = 0
            .Max = pbxHeaders.Height - pbxOHeaders.Height
            .Value = .Max
        End With
    End If
End Sub
 
 
 
Private Sub vsbHeaders_Change()
    pbxHeaders.Top = 0 - vsbHeaders.Value
End Sub
 
Private Sub vsbHeaders_Scroll()
    pbxHeaders.Top = 0 - vsbHeaders.Value
End Sub
 
Private Sub vsbVariables_Change()
    pbxVariables.Top = 0 - vsbVariables.Value
End Sub
 
Private Sub vsbVariables_Scroll()
    pbxVariables.Top = 0 - vsbVariables.Value
End Sub