Работа с интернетом на VB

[mark+]

Я бы хотел научиться засовывать в текстовый файл на каком-нибудь интернет сайте, стринговую строку. И вытаскивать весь текст из текстового удалённого файла в стринг строку. Если не трудно, киньте примерчик....

[Ducis]

Ну, засовывать непосредственно в файл это, ИМХО, невозможно. Можно загрузить, изменить и передать обратно по ftp протоколу.
Передача по ftp протоколу - это отдельный гемморой
С изменением, думаю, проблем не возникнет.
А вот загрузка:

Расположите на форме элемент Inet (меню Project|Components - Microsoft Internet Transfer Control 6.0).
'Вариант 1
'Расположите на форме элемент Inet (меню Project|Components - Microsoft Internet Transfer Control 6.0).
Private Sub Form_Load()
Dim b() As Byte
'установить протокол HTTP
Inet1.Protocol = icHTTP
'установить скачиваемый адрес
Inet1.URL = "http://www.microsoft.com"
'загрузить данные HTML-страницы в массив
b() = Inet1.OpenURL(Inet1.URL, icByteArray)
'создать файл на диске и записать в него информацию
Open "c:\test.htm" For Binary Access Write As #1
Put #1, , b()
Close #1
End Sub

'Вариант 2
'Расположите на форме элемент CommandButton.
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
Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
End Function
Private Sub Command1_Click()
DownloadFile "http://sharig.webzone.ru", "c:\sharig_webzone_ru.htm"
End Sub

'Вариант 3
'Расположите на форме элемент CommandButton. Данный пример только загрузить данные со страницы в элемент TextBox.
Private Sub Command1_Click()
On Error GoTo handle
Text1.Text = Inet1.OpenURL(Text2.Text, icString)
Exit Sub
handle: MsgBox "Error " & Err.Description
End Sub

Если необходимо загрузить файл из интернета, то вот еще:
Private Declare Function DoFileDownload Lib "shdocvw.dll" (ByVal lpszFile As String) As Long

Private Sub Command1_Click()
DownLoadFile "http://demin.narod.ru/2001/wall/", "wall3.jpg"
End Sub

Public Sub DownLoadFile(sUrl As String, sFile As String)
Dim DL As Long
On Error GoTo errHandler
If sUrl$ = "" Then sUrl$ = strUrl$
If strUrl$ = "" Then strUrl$ = sUrl$
If Left(strUrl$, 4) <> "http" Then strUrl$ = "http://" & strUrl$
If Right$(strUrl$, 1) <> "/" Then strUrl$ = strUrl$ & "/"
If Left$(sFile$, 1) = "/" Then sFile = Mid$(sFile$, 2)
DL& = DoFileDownload(StrConv(strUrl$ & sFile$, vbUnicode))
Exit Sub
errHandler:
Debug.Print "Error Source:", Err.Source
Debug.Print "Error Description:", Err.Description
Debug.Print "Error Number:", Err.Number
MsgBox "An error has occured attempting to start download to " & sUrl & sFile$ & ".", vbApplicationModal + vbCritical + vbDefaultButton1, "Error"
End Sub

[Santa]

'Вариант 2
'Расположите на форме элемент CommandButton.
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
Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
End Function
Private Sub Command1_Click()
DownloadFile "http://sharig.webzone.ru", "c:\sharig_webzone_ru.htm"
End Sub

Если необходимо загрузить файл из интернета, то вот еще:
Private Declare Function DoFileDownload Lib "shdocvw.dll" (ByVal lpszFile As String) As Long

Private Sub Command1_Click()
DownLoadFile "http://demin.narod.ru/2001/wall/", "wall3.jpg"
End Sub

Public Sub DownLoadFile(sUrl As String, sFile As String)
Dim DL As Long
On Error GoTo errHandler
If sUrl$ = "" Then sUrl$ = strUrl$
If strUrl$ = "" Then strUrl$ = sUrl$
If Left(strUrl$, 4) <> "http" Then strUrl$ = "http://" & strUrl$
If Right$(strUrl$, 1) <> "/" Then strUrl$ = strUrl$ & "/"
If Left$(sFile$, 1) = "/" Then sFile = Mid$(sFile$, 2)
DL& = DoFileDownload(StrConv(strUrl$ & sFile$, vbUnicode))
Exit Sub
errHandler:
Debug.Print "Error Source:", Err.Source
Debug.Print "Error Description:", Err.Description
Debug.Print "Error Number:", Err.Number
MsgBox "An error has occured attempting to start download to " & sUrl & sFile$ & ".", vbApplicationModal + vbCritical + vbDefaultButton1, "Error"
End Sub

Может кто знает как по этим функциям узнать что файл закачался.

[tyomitch]

mark+, Santa - ведь только что выкладывал качалку в Кирпичах!
http://bbs.vbstreets.ru/viewtopic.php?t=19857
Там в примере показано, как узнать, что файл скачался. И контролов левых не надо.

[Santa]

mark+, Santa - ведь только что выкладывал качалку в Кирпичах! ... И контролов левых не надо.

Контролов может и не надо, но там tlb, а вот без неё было бы легче, а то половина в ней (не понятная для меня) и половина в классе. Если можно без tlb был ба рад.

[tyomitch]

TLB нужна только для компиляции, к готовой проге её не надо.

Версия без TLB: http://bbs.vbstreets.ru/viewtopic.php?p=57727#57727
Но едва ли она понятнее.

[Бяка]

Расположите на форме элемент Inet (меню Project|Components - Microsoft Internet Transfer Control 6.0).
'Вариант 1
'Расположите на форме элемент Inet (меню Project|Components - Microsoft Internet Transfer Control 6.0).
Private Sub Form_Load()
Dim b() As Byte
'установить протокол HTTP
Inet1.Protocol = icHTTP
'установить скачиваемый адрес
Inet1.URL = "http://www.microsoft.com"
'загрузить данные HTML-страницы в массив
b() = Inet1.OpenURL(Inet1.URL, icByteArray)
'создать файл на диске и записать в него информацию
Open "c:\test.htm" For Binary Access Write As #1
Put #1, , b()
Close #1
End Sub

По Етому Inet малость непонятно:
вот к примеру моя прога обновляется из нета
типа начал:
Inet1.Execute мойДАУНлоад, "GET"
.....
типа продолжил:
MD = Inet1.GetChunk(1024, icByteArray)
.....
А как прервать закачку?
Inet1.Cancel - вроде прерывает, НО насамомделе закачка файла продолжается в папку ...\Local Settings\Temporary Internet Files
КАК , нафиг, прервать закачку ?

[tyomitch]

Бяка, к моему Кирпичу приложена демка с возможностью отмены закачки. Можешь посмотреть там.

[VAngel]

А можно для первого варианта узнать на сколько скачался файл? получить скажем процент закачки

[tyomitch]

VAngel, а чем мой кирпич-то вас всех не устроил?
Там в примере и отмена есть, и процент закачки.

[Santa]

... а чем мой кирпич-то вас всех не устроил?
Там в примере и отмена есть, и процент закачки.

кирпич то хорош, но лично мне не понятен из-за tlb, к тому же тот пример (ссылку) который вы указали выше не отражает той полноты корой бы хотелось. К примеру там 1 фукция у Вас 3 (Urlmon) с возможностью закачки не посредственно в текстовое окно, но и выше указанные возможности тоже не моло важны. Если не сложно перепишите Ваш пример без tlb. Вам как знающему человеку это не сложно, а нам просто необходимо (по крайней мере лично мне). Надеюсь убедил.

[Бяка]

А можно для первого варианта узнать на сколько скачался файл? получить скажем процент закачки

Код: Выделить всё

....
Picture1.ScaleMode=3
Open "с:" & GetFileName(Text1.Text) For Binary As #intFile
....
Private Sub Inet1_StateChanged(ByVal State As Integer)
        If State = 12 Then
    Dim R, dblIncreas

        Dim varData As Variant
        Dim byteTempArray() As Byte
        Dim lngFileSize As Long     
        Dim dblIncrease, bit, bit1 As Double
bolDone = False
        bit1 = 0
        cmb = cmb + 1
         dblIncreas = 0
        lngFileSize = Inet1.GetHeader("Content-length")
        bit = lngFileSize / 1024
        Text5.Text = Mid(bit, 1, 4) & "Kb"
         dblIncrease = FormatNumber((1024 / lngFileSize) * 300, 4)
        varData = Inet1.GetChunk(1024, icByteArray)
        DoEvents

        Do While Not bolDone
      byteTempArray = varData
         
            Put #intFile, , byteTempArray
               bit1 = bit1 + (Len(varData) * 2) / 1024
            Text4.Text = Mid(bit1, 1, 4) & "Kb"
'Мой прогресс бар
'Ну захотелось мозги попарить
           If dblIncrease < Picture1.ScaleWidth Then
           
         
R = Bar(dblIncreas, dblIncrease, False)
dblIncreas = dblIncreas + Int(dblIncrease)
Else
R = Bar(dblIncreas, 1, True)
End If

       
            varData = Inet1.GetChunk(1024, icByteArray)
            DoEvents
           
           шf Len(varData) = 0 Then
                bolDone = True
            End If
        Loop
         Close #intFile
    End If
'определение имени фыйла   
Private Function GetFileName(strUrl As String) As String
    GetFileName = Mid(strUrl, InStrRev(strUrl, "/") + 1)
    If InStr(GetFileName, "?") Then GetFileName = (Left(GetFileName, InStr(GetFileName, "?") - 1))
    nam = GetFileName
    Text3.Text = GetFileName 'Mid(GetFileName, InStrB(GetFileName, "?") - 1)
End Function
 
Private Function Bar(ByVal value As Integer, ByVal val As Integer, ByVal refresh As Boolean)
Dim x
x = Picture1.ScaleHeight

Picture1.DrawWidth = val
Picture1.Line (value, 1)-(value, x - 1), &HC000&
If value > Picture1.ScaleWidth Then value = 0

Label2.Caption = Int(value / (Picture1.ScaleWidth / 100)) & "%"

If refresh = True Then
value = 0
End If
End Function

Бяка, к моему Кирпичу приложена демка с возможностью отмены закачки. Можешь посмотреть там.

А как его под Inet зыделать?

а чем мой кирпич-то вас всех не устроил?
Там в примере и отмена есть, и процент закачки.

а хочется всё попробовать и выбрать найлучший вариант!

[VAngel]

2 Бяка:
Ух, спасибо, обязательно вечером посмотрю.
2 tyomitch:
Мнебы с примером Бяки разобраться, а у тебя там, в примере, уж очень сильное колдунство не подвластное мне

[tyomitch]

... а чем мой кирпич-то вас всех не устроил?
Там в примере и отмена есть, и процент закачки.

кирпич то хорош, но лично мне не понятен из-за tlb, к тому же тот пример (ссылку) который вы указали выше не отражает той полноты корой бы хотелось. К примеру там 1 фукция у Вас 3 (Urlmon) с возможностью закачки не посредственно в текстовое окно, но и выше указанные возможности тоже не моло важны. Если не сложно перепишите Ваш пример без tlb. Вам как знающему человеку это не сложно, а нам просто необходимо (по крайней мере лично мне). Надеюсь убедил.

Переделывать его без TLB я не буду. А чем мешает TLB? Ну, непонятная - так ведь не непонятнее, чем msinet.ocx, как у вас.

А какой полноты нехватает в примерах?

Бяка, к моему Кирпичу приложена демка с возможностью отмены закачки. Можешь посмотреть там.

А как его под Inet зыделать?

А зачем вообще нужен Inet?

у тебя там, в примере, уж очень сильное колдунство не подвластное мне

В clsKackalka? Так не смотри внутрь неё
Просто пользуй.

[Бяка]

В clsKackalka? Так не смотри внутрь неё
Просто пользуй.

просто использовать мона и reget

2 VAngel: для полноты ачучений замени
dblIncrease = FormatNumber((1024 / lngFileSize) * 300, 4)
на
dblIncrease = FormatNumber((1024 / lngFileSize) * Picture1.ScaleWidth , 4)

[tyomitch]

В clsKackalka? Так не смотри внутрь неё
Просто пользуй.

просто использовать мона и reget

Ты умеешь встроить reget в свою прогу? Если нет, то твоё замечание не в тему

[Santa]

А какой полноты нехватает в примерах?

В примере 1 фукция закачки у Вас 3 (Urlmon) с возможностью закачки не посредственно в текстовое окно, а как остальные, ну как их дикларировать, че полсылать.

[tyomitch]

Santa, ты про который пример говоришь, тот который без TLB?
Я его больше не поддерживаю. Юзай TLB, она рулит.

[Santa]

Блин, ясный перец, мне интересен с tlb, мне не интересна сама tlb.
Описание функций скачки в поток и бокс, с файлом я разабрался.

[tyomitch]

Функция скачки в строку: DownloadToString. Качает файл целиком и возвращает его в виде строки.
Функция скачки по кускам: DownloadPush. Качает файл и, по мере прихода его кусков, передаёт их в Kachalka_DataAvailable в виде параметра Data.
Что ещё пояснить?

[VAngel]

Отвлеку вас на минутку

Код: Выделить всё

Dim at As Variant
Inet1.Execute "http://creep.ru/index.html", "HEAD"
Do
    If Inet1.StillExecuting = False Then Exit Do
    DoEvents
Loop
at = Inet1.GetHeader("Content-length")
MsgBox at


Почему не работает? выдает:
Вот-вот ничего не выдает. at = ""
ps: Рекламой сайта не считать

[tyomitch]

Вот все заголовки, которые отдаёт твой сервер:

Код: Выделить всё

HTTP/1.1 200 OK
Date: Fri, 14 Oct 2005 21:23:37 GMT
Server: Apache/1.3.33 (Debian GNU/Linux) PHP/4.3.10-15
X-Powered-By: PHP/4.3.10-15
Content-Type: text/html; charset=utf-8


Других, в т.ч. Content-length, он не отдаёт. Пинай админа.

[Santa]

Что ещё пояснить?

Пример по этим фунциям, ну как там всё делается,(без tlb).

[tyomitch]

Santa, ты мне совсем голову заморочил. В прошлом посте ты говорил, что тебе интересно с TLB, теперь уже интересно без?

[Santa]

Чесно говоря мне интересно малое, классы и модуля и конечно ctl'ы.
Я не приверженец ocx'ов, dll'ов и tlb. Я пытаюсь прогу для себе написать по этой теме. Даже написал. Работает(только с tlb). А теперь мне необходим примерчик по этим функциям, со всеми возможностями примера с tlb только без её самой, басом там классом не имеет значения, это второй вопрос, только без tlb, но всё тоже как с ней.

[VAngel]

Таки дело в серваке, ясно, чето я попробывал на 10 сервках только 4 ответили

[tyomitch]

Таки дело в серваке, ясно, чето я попробывал на 10 сервках только 4 ответили

Пинай админов остальных 6 серваков.
msinet.ocx не сможет сделать это за тебя

Чесно говоря мне интересно малое, классы и модуля и конечно ctl'ы.
Я не приверженец ocx'ов, dll'ов и tlb. Я пытаюсь прогу для себе написать по этой теме. Даже написал. Работает(только с tlb). А теперь мне необходим примерчик по этим функциям, со всеми возможностями примера с tlb только без её самой, басом там классом не имеет значения, это второй вопрос, только без tlb, но всё тоже как с ней.

Так чем всё-таки тебе не понравились TLB?
Я в очередной раз подчёркиваю их основное отличие от OCX и DLL, с которыми ты их поставил в одну кучу: они нужны только для компиляции. В этом смысле они такие же, как модули, классы и контролы.

Т.ч. "работать (только с tlb)" прога не может. Она может компилироваться (только с tlb), а потом просто работать.

[Santa]

... А теперь мне необходим примерчик по этим функциям, со всеми возможностями примера с tlb только без её самой...

Да функции мне нужны, только и всего.

[tyomitch]

Ну ё-моё. Все функции у тебя перед глазами
В TLB только объявления интерфейсов и API. Никаких тайн.