INTELLIGENT WORK FORUMS
FOR COMPUTER
PROFESSIONALS
Come Join Us!
- Talk With Other Members
- Be Notified Of Responses
To Your Posts
- Keyword Search
- Turn Off Ad Banners
- One-Click Access To Your
Favorite Forums
- Automated Signatures
On Your Posts
- Best Of All, It's Free!
*Tek-Tips's functionality
depends on members receiving e-mail. By joining you are opting in to
receive e-mail.
Partner With Us!
"Best Of Breed" Forums Add Stickiness To Your
Site (Download This Button Today!)
Member Feedback
"...What a great service! This is the best site I've ever
seen!!! It totally restores my faith in humanity when people take time out
to help other people..."
Geography
Where in the world do Tek-Tips members come from?
|
Pulling an image from the web
|
| Niphyr
(Programmer) |
18 Nov
03 0:13 |
|
| vbSun
(Programmer) |
18 Nov
03 0:34 |
|
Here's code I posted a couple of years
ago: Thread222-93819
I
also have a version that uses some API calls to avoid
the necessity of creating the temp file that the above
code requires | |
| vbSun
(Programmer) |
18 Nov
03 10:06 |
|
| If I can dig it out,
sure. | |
And here you go. The example requires a
form with a picturebox and a command button.
Note
that there's an even easier way of doing this if you are
happy to use an OLE type library (I use Edanmo's OLE
Interfaces for Implements type library, available here:
http://www.mvps.org/emorcillo/type. I'll
post that solution next)
Option Explicit
Public Enum
CBoolean
CFalse = 0
CTrue
= 1
End Enum
Private Type
GUID
dwData1 As
Long
wData2 As
Integer
wData3 As
Integer
abData4(7) As Byte
End
Type
Private Const S_OK = 0
Private
Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz
As Any, pclsid As GUID) As Long
Private Const
sIID_IPicture =
"{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Private
Declare Function GetTempPath Lib "kernel32"
_
Alias
"GetTempPathA" (ByVal nBufferLength As Long,
_
ByVal
lpBuffer As String) As
Long
Private
Declare Function GetTempFileName Lib "kernel32"
_
Alias
"GetTempFileNameA" (ByVal lpszPath As String,
_
ByVal
lpPrefixString As String, ByVal wUnique As Long,
_
ByVal
lpTempFileName As String) As Long
Private
Declare Function CreateStreamOnHGlobal Lib "ole32"
_
(ByVal
hGlobal As Long,
_
ByVal
fDeleteOnRelease As CBoolean,
_
ppstm
As Any) As
Long
Private
Declare Function OleLoadPicture Lib "olepro32"
_
(pStream
As Any,
_
ByVal
lSize As Long,
_
ByVal
fRunmode As CBoolean,
_
riid
As GUID,
_
ppvObj
As Any) As
Long
Private
Const GMEM_MOVEABLE = &H2
Private Declare
Function GlobalAlloc Lib "kernel32" (ByVal uFlags As
Long, ByVal dwBytes As Long) As Long
Private Declare
Function GlobalLock Lib "kernel32" (ByVal hMem As Long)
As Long
Private Declare Function GlobalUnlock Lib
"kernel32" (ByVal hMem As Long) As Long
Private
Declare Function GlobalFree Lib "kernel32" (ByVal hMem
As Long) As Long
Private Declare Sub MoveMemory
Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any,
pSource As Any, ByVal dwLength As
Long)
Private Sub
Command1_Click()
Picture1.Picture
= GetPicFromHTTP("http://msdn.microsoft.com/library/shared/toolbar/graphics/banners/MSDN_banner.gif";)
'("http://www.wandtv.com/rdrimg.jpg";)
End
Sub
Private Function GetPicFromHTTP(strURL As
String) As StdPicture
Dim
bytearray() As
Byte
bytearray()
= Inet1.OpenURL(strURL,
icByteArray)
Set
GetPicFromHTTP = PictureFromBits(bytearray)
End
Function
' Adapted from some code from Brad
Martinez at MVPS
Public Function
PictureFromBits(abPic() As Byte) As
IPicture
Dim nLow As
Long
Dim cbMem As
Long
Dim hMem As
Long
Dim lpMem As
Long
Dim IID_IPicture As
GUID
Dim istm As
stdOLE.IUnknown ' lazy way to get
IStream
Dim ipic As
IPicture
On
Error GoTo Out ' Set up cheap and cheerful error
handling
'
Get the size of the picture's
bits
'nLow =
LBound(abPic)
cbMem =
(UBound(abPic) - nLow) + 1
'
Allocate a global memory
object
hMem =
GlobalAlloc(GMEM_MOVEABLE,
cbMem)
If hMem
Then
'
Lock the memory object and get a pointer to
it.
lpMem
=
GlobalLock(hMem)
If
lpMem
Then
'
Copy the picture bits to the memory pointer and unlock
the
handle.
MoveMemory
ByVal lpMem, abPic(nLow),
cbMem
Call
GlobalUnlock(hMem)
'
Create an ISteam from the pictures
bits
If
(CreateStreamOnHGlobal(hMem, CTrue, istm) = S_OK)
Then
If
(CLSIDFromString(StrPtr(sIID_IPicture), IID_IPicture) =
S_OK)
Then
'
Create IPicture from
IStream
OleLoadPicture
ByVal ObjPtr(istm), cbMem, CFalse, IID_IPicture,
PictureFromBits
End
If
End
If
End
If
Call
GlobalFree(hMem)
End
If
Out: '
cheap and cheerful error
handling...
On Error GoTo
0
End
Function | |
The following example assumes that you
have a reference set to Edanmo's OLE Interfaces and
Functions library. As with the previous example, you
need a form with a picturebox and a command
button:
Option Explicit
Private Sub
Command1_Click()
Picture1.Picture
= GetPicFromHTTP("http://msdn.microsoft.com/library/shared/toolbar/graphics/banners/MSDN_banner.gif";)
'("http://www.wandtv.com/rdrimg.jpg";)
End
Sub
Private Function GetPicFromHTTP(strURL As
String) As StdPicture
Dim
bytearray() As
Byte
bytearray()
= Inet1.OpenURL(strURL,
icByteArray)
Set
GetPicFromHTTP = LoadImage(bytearray)
End
Function
Public Function LoadImage(
_
ImageBytes() As Byte) As
StdPicture
Dim oPersist As IPersistStream
Dim
oStream As IStream
Dim lSize As
Long
' Calculate the array
size
lSize = UBound(ImageBytes) -
LBound(ImageBytes) + 1
' Create
a stream object
' in global
memory
Set oStream =
CreateStreamOnHGlobal(0,
True)
' Write the header to the
stream
oStream.Write
&H746C&, 4&
' Write
the array size
oStream.Write lSize,
4&
' Write the image
data
oStream.Write
ImageBytes(LBound(ImageBytes)),
lSize
' Move the stream
position to
' the start of the
stream
oStream.Seek 0,
STREAM_SEEK_SET
' Create a new
empty picture object
Set LoadImage
= New StdPicture
' Get the
IPersistStream interface
' of the
picture object
Set oPersist =
LoadImage
' Load the picture
from the stream
oPersist.Load
oStream
' Release the
streamobject
Set oStream =
Nothing
End
Function
| |
| vbSun
(Programmer) |
18 Nov
03 14:26 |
Thanks strongm, take a star.
I
couldnt check it yet, as i just formatted my machine,
and VB is yet to be
installed.. | |
| Niphyr
(Programmer) |
18 Nov
03 22:13 |
|
| Niphyr
(Programmer) |
18 Nov
03 22:47 |
| I found another way, use the microsoft
internet control, and simply navigate the browser
control to the picture, and its done!, served my
purposes anyway. Still, thanks all
http://niphyr.topcities.com/ | |
While browsing the past posts, I found
this thread for loading pictures from
internet.
Below is an extremely handy method to
do this, without using a temp file/inet control or type
library. Only a single API call does the magic and I
thought I should post this here (although it is probably
too late).
___
Option
Explicit
Private Declare Function CLSIDFromString Lib
"ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As
Long
Private Declare Function OleLoadPicturePath Lib
"oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller
As Long, ByVal dwReserved As Long, ByVal clrReserved As
OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As
Long
Public Function LoadPictureFromURL(ByVal url
As String) As Picture
Dim
IPic(15) As Byte 'holds the IPicture
interface
CLSIDFromString
StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"),
IPic(0)
OleLoadPicturePath
StrPtr(url), 0&, 0&, 0&, IPic(0),
LoadPictureFromURL
End Function
Private Sub
Form_Load()
Me.Picture =
LoadPictureFromURL("http://niphyr.topcities.com/program.gif")
End
Sub
___
Besides that, the code provided
by strongm in his first post is also very
smart! | |
| Coo! Can't believe that I got as far as
building an OleLoadPicture, and yet totally missed
OleLoadPicturePath. Nice catch, Hypetia. Have a star for
finding it. | |
| TheTuna
(Programmer) |
16 Feb
04 20:50 |
Yes Hypetia, that does deserve a star...
thank you for that. StrongM, your code does
as well...
 No Dolphins were harmed in the
posting of this message... Dolphin Friendly
Tuna!
Ever feel like you're banging
your head against a tree? I did, so I cut
down the
tree.
| |
| Hi guys, Thanks for an
excellent thread. You both deserve a bunch of
stars for your solutions here.
Editor and Publisher of Crystal Clear
www.chelseatech.co.nz/pubs.htm | |
Hi Hypetia,
Would your example
still work if the web site requires
authentication?
Thanks.
Johnnie
| |
| Why not try both the examples presented
here and see which one works best for
you? | |
Hi,
I tried all the
examples. The problem is with
Inet. If you create an activex control using
the inet, you will get something weird.
For example,
you enter the following values for the accessing the
picture.
Inet1.UserName =
"demouser"
Inet1.Password =
"password123"
Inet1.URL = "http://www.abc.com/somepic.jpg"
You
will get the following.
Inet1.UserName =
"demouser"
Inet1.Password =
"password123"
Inet1.URL = "http://demouser:<A%20HREF=//somepic.jpg"
target="_blank">http://demouser:password123@www.abc.com/somepic.jpg"
The
program added the username and password to the
URL. When I try to download the picture, I
will get malformed URL or someting to that
effect.
Johnnie
| |
>The problem is with Inet
And I
should point out that there is no problem with Inet
accessing password protected resources. You just have to
understand how it works (the help files show you).
Essentially, you just have to modify the GetPicFromHTTP
routine to something like:
CODE
Private
Function GetPicFromHTTP(strURL As String, Optional
Username As String, Optional Password As String) As
StdPicture
Dim bytearray() As
Byte
Inet1.URL
= strURL
Inet1.Username =
Username
Inet1.Password =
Password
bytearray() =
Inet1.OpenURL(,
icByteArray)
Set
GetPicFromHTTP = LoadImage(bytearray)
End
Function
Be warned that this only
works with sites using a websote's built-in
authentication methods(e.g. it won't work against sites
using script-based security solutions) and that the
example here makes no allowance for a persistant session
(try and login to a site with which you have already
established a session and the code as given will
fail). | | |
|
|
| |
