Stig Johansen skrev:
> Leif Neland wrote:
>
>> Stig Johansen skrev:
>>> Lidt afhængig af hvad du har til rådighed af komponenter (w3 socket
>>> skulle vist være udbredt), kan du hente billedet, og gemmer det lokalt,
>>> og derefter servicere det fra filen.
>> Ja, det var ligesom det, jeg søgte assistance til...
>
> Det var lige så meget et spørgsmål om har eksempelvis w3 sokets.
> Hvis du har det, han du tage udgangspunkt i dette eksempel på HTTP:
> <
http://www.dimac.net/products/freeproducts/w3sockets/examples/Get.htm>
>
> Den returnerede buffer vil indeholde en stribe headers adskilt af vbCrLf, en
> ekstra vbCrLf, og derefter selve billedet.
>
> De første 3 tegn i bufferen er statuskoden, som skal være "200".
>
> Jeg vil tro man bare kan lave en søgning (instr) efter vbCrLf+vbCrLf, og
> gemme resten i en fil.
>
> Husk det er binære data.
>
Her er de væsentlige sider af 404-handleren for /images/-mappen
De externe billeder hedder
www.voressite.dom/images/leverandor/.jpg
Hvis de ikke findes lokalt, hentes de fra den externe leverandør, og
gemmes lokalt.
Hvis de heller ikke findes externt, markeres det i databasen, så den
externe leverandor ikke plages hele tiden, og der redirectes til
intetbillede.jpg
Jeg fandt funktionerne BinaryGetURL og SaveBinaryData, der tog sig
SomeDir = Request.ServerVariables("Query_String")
SomeDir = Mid(SomeDir, InStrRev(SomeDir, "/images/") + 1, Len(SomeDir))
p = InStr(SomeDir,"/leverandor/")
if p>0 then
img=Mid(SomeDir, p + 7, Len(SomeDir))
Location = "
http://www.leverandor.com/image/item/"& img
destdir ="E:\websites\vores\www\images\produkter\leverandor\"
destimg = destdir & img
binimg= BinaryGetURL(Location)
if lenb(binimg)>lenb("") then
Response.status = "200 OK"
response.BinaryWrite binimg
SaveBinaryData destimg,binimg
response.end
else
Set Record = Server.CreateObject("ADODB.Connection")
DbConnect Record, database, SqlDateSep
billede1="leverandor/" & img
sql = "update produkter set billede1='intetbillede.jpg?" & img &"'
where billede1='"&billede1&"'"
record.execute(sql)
end if
end if
'Hvis det ikke er et externt billede, eller det ikke findes, så vis
"intetbillede.jpg"
newLocation = "
http://www.voressite.dk/images/produkter/intetbillede.jpg"
Response.Status = "302 Moved temporarily"
Response.AddHeader "Location", newLocation
Response.End
Function BinaryGetURL(URL)
Dim Http
Set Http = CreateObject("WinHttp.WinHttpRequest.5.1")
Http.Open "GET", URL, False
Http.Send
if Http.status = 200 then
BinaryGetURL = Http.ResponseBody
else
BinaryGetURL = ""
end if
End Function
Function SaveBinaryData(FileName, ByteArray)
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Type = adTypeBinary
BinaryStream.Open
BinaryStream.Write ByteArray
BinaryStream.SaveToFile FileName, adSaveCreateOverWrite
End Function