На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! Правила раздела Visual Basic: Общие вопросы
Здесь обсуждаются вопросы по языку Visual Basic 1-6 (а так же по схожим языкам, как, например, PowerBASIC).
Вопросы по Visual Basic .NET (это который входит в состав Visual Studio 2002/2003/2005/2008+, для тех, кто не в курсе) обсуждаются в разделе .NET.

Обратите внимание:
1. Прежде чем начать новую тему или отправить сообщение, убедитесь, что Вы не нарушаете правил форума!
2. Обязательно воспользуйтесь поиском. Возможно, Ваш вопрос уже обсуждали. Полезные ссылки приведены ниже.
3. Темы с просьбой выполнить какую-либо работу за автора в этом разделе не обсуждаются. Студенты, вам сюда: ПОМОЩЬ СТУДЕНТАМ!
4. Используйте теги [ code=vba ] ...текст программы... [ /code ] для выделения текста программы подсветкой.
5. Помните, здесь телепатов нет. Формулируйте свой вопрос максимально грамотно и чётко: Как правильно задавать вопросы
6. Запрещено отвечать в темы месячной (и более) давности, без веских на то причин.

Полезные ссылки:
user posted image FAQ Сайта user posted image FAQ Раздела user posted image Кладовка user posted image Наши Исходники user posted image API-Guide user posted image Поиск по Разделу user posted image MSDN Library Online user posted image Google

Ваше мнение о модераторах: user posted image SCINER, user posted image B.V.
Модераторы: SCINER, B.V.
  
> Загрузка картинок из инета в PictureBox
    Код:
    ExpandedWrap disabled
      Option Explicit
       
      'Created by SCINER: lenar2003@mail.ru
       
      Private Const INTERNET_OPEN_TYPE_PRECONFIG  As Long = 0
      Private Const INTERNET_OPEN_TYPE_DIRECT     As Long = 1
      Private Const INTERNET_OPEN_TYPE_PROXY      As Long = 3
      Private Const HTTP_QUERY_CONTENT_LENGTH     As Long = 5
      Private Const INTERNET_FLAG_RELOAD          As Long = &H80000000
       
      Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
      (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
      Private Declare Function InternetOpen Lib "wininet.dll" Alias _
      "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, _
      ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
      Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" _
      (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, _
      ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer
      Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias _
      "InternetOpenUrlA" (ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, _
      ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
      Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias _
      "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, _
      ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, _
      ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
      Private Declare Function HttpSendRequest Lib "wininet.dll" Alias _
      "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, _
      ByVal lHeadersLength As Long, sOptional As Any, ByVal lOptionalLength As Long) As Integer
      Private Declare Function InternetReadFile Lib "wininet.dll" _
      (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _
      lNumberOfBytesRead As Long) As Integer
      Private Declare Function InternetCloseHandle Lib "wininet.dll" _
      (ByVal hInet As Long) As Integer
      Private Declare Function InternetQueryDataAvailable Lib "wininet.dll" _
      (ByVal hFile As Long, lpdwNumberOfBytesAvailable As Long, ByVal dwFlags As Long, _
      ByVal dwContext As Long) As Long
       
      Private Function HttpReadPage(ByVal Url As String) As String
          Dim vBuff  As String
          Dim vhOpen As Long
          Dim vhUrl  As Long
          Dim vSize  As Long
          Dim vRet   As Long
          vhOpen = InternetOpen("Mozilla/4.0", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
          If vhOpen Then
              vhUrl = InternetOpenUrl(vhOpen, Url, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
              If vhUrl Then
                  If InternetQueryDataAvailable(vhUrl, vSize, 0, 0) Then
                      If (vSize = 0) Then vSize = 4096
                      vBuff = String(vSize, 0)
                      Do
                        InternetReadFile vhUrl, vBuff, vSize, vRet
                        If (vRet = 0) Then Exit Do
                        HttpReadPage = HttpReadPage & VBA.Left$(vBuff, vRet)
                      Loop
                  End If
                  InternetCloseHandle vhUrl
              End If
              InternetCloseHandle vhOpen
          End If
      End Function
       
      Function URLPicture(ByVal strURL As String) As StdPicture
       
        On Error GoTo 1
        Dim B() As Byte
       
        Dim FF As Long
        Dim lRet As Long
        Dim strTempPath As String
        
        B = StrConv(HttpReadPage(strURL), vbFromUnicode)
       
        strTempPath = VBA.Space$(260)
        GetTempPath 260, strTempPath
        If InStr(strTempPath, vbNullChar) > 0 Then strTempPath = VBA.Left$(strTempPath, _
                                                   InStr(strTempPath, vbNullChar) - 1)
        strTempPath = strTempPath & "img_temp.bmp"
        
        FF = FreeFile
        Open strTempPath For Binary As #FF
          Put #FF, , B
        Close #FF
       
        Set URLPicture = LoadPicture(strTempPath)
        Exit Function
      1:
        Set URLPicture = LoadPicture()
        End Function
       
      Private Sub Form_Load()
        Image1 = URLPicture("http://img.yandex.ru/i/logo76x44.gif")
      End Sub
      Это вопрос или ответ? 8)
      А имхо от временного файла можно как-нить отпрыгнуть. Типа например найти место картинки в памяти и скопировать её туда напрямую.
      Сложно, но можно.
      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
      0 пользователей:


      Рейтинг@Mail.ru
      [ Script execution time: 0,0220 ]   [ 16 queries used ]   [ Generated: 26.12.24, 12:24 GMT ]