[RESOLVED] Need help improving this code,

Would like it so it will read a textfile, for links and download one line at a time, one afer the other.

Code:

---

If DownloadedBytes = 0 Then
Label2.Caption = "Couldn't connect"
DoEvents
Else
If DownloadedBytes > 0 And DownloadedBytes <> TotalBytes Then
Label2.Caption = "Connection lost"
DoEvents
End If
End If
End If
End Sub

Private Sub DL_Progress(DownloadedBytes As Long, TotalBytes As Long, sId As String)
If DownloadedBytes > 0 Then
Label2.Caption = "Downloading file"
PB.value = (DownloadedBytes * 100) / TotalBytes
Label1.Caption = (DownloadedBytes / 1000) & " KB / " & (TotalBytes / 1000) & " KB"
End If
End Sub

Private Sub Form_Load()
DL.Download "http://rapidshare.com/files/126666391/i386.rar", App.Path + "\file.rar"
Label2.Caption = "Connecting..."
End Sub

---

how about:

Code:

---

If DownloadedBytes = 0 Then
Label2.Caption = "Couldn't connect"
DoEvents
Else
If DownloadedBytes > 0 And DownloadedBytes <> TotalBytes Then
Label2.Caption = "Connection lost"
DoEvents
End If
End If
End If
End Sub

Private Sub DL_Progress(DownloadedBytes As Long, TotalBytes As Long, sId As String)
If DownloadedBytes > 0 Then
Label2.Caption = "Downloading file"
PB.value = (DownloadedBytes * 100) / TotalBytes
Label1.Caption = (DownloadedBytes / 1000) & " KB / " & (TotalBytes / 1000) & " KB"
End If
End Sub

Private Sub Form_Load()
Dim tmp() As String
dim i as integer
Open "links.txt" For Input As #1
    tmp() = Split(Input(LOF(1), 1), vbCrLf)
Close #1
for i = 0 to ubound(tmp)
DL.Download tmp(i) , App.Path + "\file.rar"
Label2.Caption = "Connecting..."
next i
End Sub

---

put the links in links.txt

Hang on, theres more code, seems to keep getting an error, there are user controls set, I've added the downloader in the attachments, could you take a look at it?

User Code,

Code:

---

Option Explicit
Public Event Progress(DownloadedBytes As Long, TotalBytes As Long, sId As String)
Public Event Completed(DownloadedBytes As Long, TotalBytes As Long, sId As String)
Private colDest As New Collection

Public Sub Download(URL As String, sDestination As String, Optional sId As String = "Id")
colDest.Add sDestination, sId
UserControl.AsyncRead URL, vbAsyncTypeFile, sId, vbAsyncReadForceUpdate
End Sub

Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
On Error Resume Next
If AsyncProp.BytesRead > 0 And AsyncProp.BytesRead = AsyncProp.BytesMax Then
Name AsyncProp.value As colDest.Item(AsyncProp.PropertyName)
End If
colDest.Remove AsyncProp.PropertyName
RaiseEvent Completed(AsyncProp.BytesRead, AsyncProp.BytesMax, AsyncProp.PropertyName)
End Sub

Private Sub UserControl_AsyncReadProgress(AsyncProp As AsyncProperty)
RaiseEvent Progress(AsyncProp.BytesRead, AsyncProp.BytesMax, AsyncProp.PropertyName)
End Sub

Private Sub UserControl_Resize()
UserControl.Height = 420
UserControl.Width = 420
End Sub

---

Try this. It's killo's code, but slightly modified. It now saves the files with their original names. You also have to specifiy a new key for each file or you'll get an error saying the key already exists in the collection.

Code:

---

Private Sub Form_Load()
Dim tmp() As String
Dim i As Integer
Open App.Path & "\links.txt" For Input As #1
    tmp() = Split(Input(LOF(1), 1), vbCrLf)
Close #1
For i = 0 To UBound(tmp)
DL.Download tmp(i), App.Path & "\" & ExtractFileName(tmp(i)), "k" & i
Label2.Caption = "Connecting..."
Next i
End Sub

Private Function ExtractFileName(ByVal vStrFullPath As String) As String
  Dim intPos As Integer
  intPos = InStrRev(vStrFullPath, "/")
  ExtractFileName = Mid$(vStrFullPath, intPos + 1)
End Function

---

Thanks it works, the only problem is it does both downloads at once, wonder if you could set it so, it downloads one then waits 2 minutes to download the next,(just so my PC dont crash since its slow)

If your computer crashes from downloading text files, then there's something seriously wrong with the computer. Even a Pentium 1 - 200 Mhtz from 1996 can handle that without any problems.

If you don't want to download all the files at once, then I don't think you should be using that code, because that's exactly what it does.

It would be easier to use URLDownloadToFile as suggested by Joacim Andersson in one of your other threads.

Put a timer and a label on the form.

Code:

---

Option Explicit

Private Declare Function URLDownloadToFile Lib "urlmon" _
  Alias "URLDownloadToFileA" _
  (ByVal pCaller As Long, _
  ByVal szURL As String, _
  ByVal szFileName As String, _
  ByVal dwReserved As Long, _
  ByVal lpfnCB As Long) As Long
 
Private Const BINDF_GETNEWESTVERSION As Long = &H10

Private tmp() As String
Private i As Integer

Private Sub Form_Load()
    Dim FF As Integer

    Timer1.Enabled = False
    Timer1.Interval = 60000
   
    FF = FreeFile
    Open App.Path & "\links.txt" For Input As #FF
        tmp() = Split(Input(LOF(1), 1), vbCrLf)
    Close #FF
   
    Timer1.Enabled = True

End Sub

Private Sub Timer1_Timer()
    Static iCount As Integer

    iCount = iCount + 1
   
    If iCount = 2 Then
        Label1.Caption = Time & ": Downloading -> " & ExtractFileName(tmp(i))
        URLDownloadToFile 0&, tmp(i), App.Path & "\" & ExtractFileName(tmp(i)), BINDF_GETNEWESTVERSION, 0&
        Label1.Caption = Time & ": Finished Downloading -> " & ExtractFileName(tmp(i))
        i = i + 1
        iCount = 0
       
        If i > UBound(tmp) Then i = 0
    End If
End Sub

Private Function ExtractFileName(ByVal vStrFullPath As String) As String
  Dim intPos As Integer
  intPos = InStrRev(vStrFullPath, "/")
  ExtractFileName = Mid$(vStrFullPath, intPos + 1)
End Function

---

getting compile error :S

Did you want me to use that instead of the code used before?,

Yes, that's all the code you need.

this may sound like a stupid question, but did you test it with the attachment, or didu make a new project all to gether?, I tested it and it didnt seem to do anything,

It's an entire new project. You don't need the Downloader and Progressbar controls for that, only the code I gave you. Like I said, put a Timer and a Label on the form. If you don't put a Timer on the form, then you get the error shown in the screenshot.

The reason why it doesn't do anything, is because you said you want to wait 2 minutes between each download. When you start the app it waits 2 minutes and downloads the first file, then waits another 2 minutes and downloads the second file, etc, etc.

Any chance it could do it straight away then wait :)?,

Replace the Form_Load event with this one.

Code:

---

Private Sub Form_Load()
    Dim FF As Integer

    Timer1.Enabled = False
    Timer1.Interval = 6000
   
    FF = FreeFile
    Open App.Path & "\links.txt" For Input As #FF
        tmp() = Split(Input(LOF(1), 1), vbCrLf)
    Close #FF
   
    Me.Show
   
    Label1.Caption = Time & ": Downloading -> " & ExtractFileName(tmp(i))
    URLDownloadToFile 0&, tmp(i), App.Path & "\" & ExtractFileName(tmp(i)), BINDF_GETNEWESTVERSION, 0&
    Label1.Caption = Time & ": Finished Downloading -> " & ExtractFileName(tmp(i))
    i = i + 1
   
    If UBound(tmp) > 0 Then Timer1.Enabled = True
End Sub

---

Thanks man, your the best :D, is, Timer1.Interval = 6000 (2 mins?)

Wait, I made a small mistake.

Use this Form_Load event and Timer event.

The Timer interval should be 60000 (1 minute).

Code:

---

Private Sub Form_Load()
    Dim FF As Integer

    Timer1.Enabled = False
    Timer1.Interval = 60000
   
    FF = FreeFile
    Open App.Path & "\links.txt" For Input As #FF
        tmp() = Split(Input(LOF(1), 1), vbCrLf)
    Close #FF
   
    Me.Show
   
    Label1.Caption = Time & ": Downloading -> " & ExtractFileName(tmp(i))
    URLDownloadToFile 0&, tmp(i), App.Path & "\" & ExtractFileName(tmp(i)), BINDF_GETNEWESTVERSION, 0&
    Label1.Caption = Time & ": Finished Downloading -> " & ExtractFileName(tmp(i))
   
    Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
    Static iCount As Integer

    iCount = iCount + 1
   
    If iCount = 2 Then
        If UBound(tmp) > 0 Then i = i + 1
        Label1.Caption = Time & ": Downloading -> " & ExtractFileName(tmp(i))
        URLDownloadToFile 0&, tmp(i), App.Path & "\" & ExtractFileName(tmp(i)), BINDF_GETNEWESTVERSION, 0&
        Label1.Caption = Time & ": Finished Downloading -> " & ExtractFileName(tmp(i))
        iCount = 0
       
        If i > UBound(tmp) Then i = 0
    End If
End Sub

---

hmm, Find it crashes if trying to download large file,(100mb),

Sorry, but I'm doing other stuff in the meantime, so I hadn't tested it out properly, but this should work fine.

What do you mean with, it crashes when downloading large files?
Do you mean the application hangs? That's what happens when you try to download large files with URLDownloadToFile.

Code:

---

Private Sub Form_Load()
    Dim FF As Integer

    Timer1.Enabled = False
    Timer1.Interval = 60000
   
    FF = FreeFile
    Open App.Path & "\links.txt" For Input As #FF
        tmp() = Split(Input(LOF(1), 1), vbCrLf)
    Close #FF
   
    Me.Show
   
    Label1.Caption = Time & ": Downloading -> " & ExtractFileName(tmp(i))
    URLDownloadToFile 0&, tmp(i), App.Path & "\" & ExtractFileName(tmp(i)), BINDF_GETNEWESTVERSION, 0&
    Label1.Caption = Time & ": Finished Downloading -> " & ExtractFileName(tmp(i))
    i = i + 1
   
    Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
    Static iCount As Integer

    iCount = iCount + 1
   
    If iCount = 2 Then
        If UBound(tmp) = 0 Then i = 0
       
        Label1.Caption = Time & ": Downloading -> " & ExtractFileName(tmp(i))
        URLDownloadToFile 0&, tmp(i), App.Path & "\" & ExtractFileName(tmp(i)), BINDF_GETNEWESTVERSION, 0&
        Label1.Caption = Time & ": Finished Downloading -> " & ExtractFileName(tmp(i))
        i = i + 1
        iCount = 0
       
        If i > UBound(tmp) Then i = 0
    End If
End Sub

---

yeah i tested with 3mb file, funny enough I forgot why I was needing this lol, just remembered 3mb file is all thats needed oops, :)