Trucos Varios II
Download (HTTP) de un JPG en VB
Private Sub cmdStart_Click()
Dim FileData() As Byte
Dim GetURL As String
Dim PutFile As String
Dim Connection As String
Dim Msg As String
Dim flag As Boolean
Dim temp As Integer
Dim FileCount As Integer
For Track = 0 To lstFiles.ListCount - 1
If lstFiles.Selected(Track) Then
flag = True
Exit For
End If
Next Track
If Not flag Then
Msg = "You've got to tell me what files to grab."
Msg = Msg + vbCrLf + "Do that be selecting files from the list."
temp = MsgBox(Msg, vbQuestion, "Help Me! Help Me! I don't know what to do")
Exit Sub
End If
lblStatus.Caption = "Gettin Ready to Grab Files"
MousePointer = vbHourglass
FileCount = 0
For Track = 0 To lstFiles.ListCount - 1
If lstFiles.Selected(Track) Then
PutFile = dirOut.Path & "\" & lstFiles.List(Track)
If Dir(PutFile) <> "" Then
Kill (PutFile)
End If
GetURL = txtURL.Text & txtDir.Text & "/" & lstFiles.List(Track)
lblStatus.Caption = "Retrieving " & GetURL
FileData() = ""
FileData() = Inet1.OpenURL(GetURL, icByteArray)
Open PutFile For Binary Access Write As #1
Put #1, , FileData()
Close #1
FileCount = FileCount + 1
lstFiles.Selected(Track) = False
DoEvents
End If ' item selected
Next Track
MousePointer = vbArrow
lblStatus.Caption = "Micah's Web File Grabber"
lblInet.Caption = FileCount & " Files retrieved and stored in " & dirOut.Path
If Err Then GoTo Problem
Exit Sub
Problem:
lblStatus.Caption = "Micah's Web File Grabber from http://tolands.com"
Close #1
MsgBox (Error(Err))
End Sub
|
