Mediante la macro Excel sotto riportata è possibile automatizzare lo scaricamento a intervalli regolari di immagini provenienti da webcam su internet.
Mettendo in sequenza le immagini tramite un programma tipo GifAnimator e intervallandole di pochi centesimi di secondo, si ottiene in riproduzione un filmato accelerato, che condensa in pochi secondi ore e ore di riprese effettive.
Questo filmato è composto da vari spezzoni, ognuno composto da circa 200 immagini scattate a intervalli di 5 minuti, per un totale di 1000 minuti (17 ore), condensati in 26 secondi, e si riferisce alla nevicata a roma del 10-11 febbraio 2012:
' Macro per la creazione di filmati timelapse.
' La macro scarica immagini da webcam pubbliche a intervalli
' regolari; è necessario successivamente utilizzare un programma
' per creazione di gif animate, per unire tutti i frame in un filmato.
'
' I file hanno nome "webcam_N_F.jpg":
' N = numero della webcam
' F = numero del frame relativo a quella webcam
'
' PROBLEMI NOTI:
' I file vengono salvati con suffisso .JPG qualunque sia il formato effettivo
' dell'immagine scaricata.
'
' Freeware - Jumpjack 2012
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
' ************** Richiede MICROSOFT HTML OBJECT LIBRARY (menu STRUMENTI-->RIFERIMENTI nell'editor VBA):
Public 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
Dim WEBCAMS_NUMBER As Integer
Dim NUM_FRAMES As Integer
Dim WebcamURL(10) As String
Dim counter As Integer
Const MAXFILES = 10
Dim INTERVAL As Integer
Const MAX_Tentativi = 6
Dim path, strurl, nomefolder, nomefile(MAXFILES) As String
Sub InitVars()
'********************************************
NUM_FRAMES = 500
INTERVAL = 300 ' secondi
'********************************************
WEBCAMS_NUMBER = 8 ' <<==== MODIFICARE IL NUMERO DI TELECAMERE SE SE NE AGGIUNGONO ALTRE!
' *********** INDICARE QUI GLI INDIRIZZI DELLE IMMAGINI DA SCARICARE *************************
WebcamURL(1) = "http://93.67.98.178/record/current.jpg" ' Piazza Montecitorio
WebcamURL(2) = "http://www.vaticanstate.va/images/webcam/radiovaticana.jpg" ' Vaticano 1
WebcamURL(3) = "http://www2.alfa.it/italiawebcam/crop4.php?id=1552&w=800" ' Ostia
WebcamURL(4) = "http://www.meteoaltatuscia.it/sanlorenzo/webcam.php"
WebcamURL(5) = "http://www.vaticanstate.va/images/webcam/bracciocarlo.jpg" ' Vaticano 2
WebcamURL(6) = "http://www.meteoaltatuscia.it/marta/webcam.php" ' Bolsena
WebcamURL(7) = "http://www.meteoroccapriora.it/webcam/webcam.jpg" ' RoccaPriora
WebcamURL(8) = "http://www.frosinonemeteo.it/webcam/webcam.php" ' Frosinone
WebcamURL(9) = ""
' *********** CARTELLA IN CUI VENGONO MEMORIZZATI I FILE *************
nomefolder = "C:\temp\"
End Sub
Sub ScaricaFile()
Call InitVars
counter = 218 ' 1
While counter <= NUM_FRAMES
Tentativi = 0
For x = 1 To WEBCAMS_NUMBER
Scarica (x)
Debug.Print "Scaricata cam " & Str(x) & "(" & strurl & " per " & Str(counter) & " volte."
DoEvents
Next
counter = counter + 1
SleepVBA (INTERVAL)
Wend
DoEvents
End Sub
Private Sub Scarica(x As Integer)
strurl = WebcamURL(x) & "?dummy" & LTrim(Str$(counter))
nomefile(x) = nomefolder & "\webcam_" & LTrim(Str(x)) & "_" & Str(counter) & ".jpg"
Cells(10, 10) = "Scarico foglio " & Str(x) & "..."
DoEvents
retry3:
Tentativi = Tentativi + 1
errcode = URLDownloadToFile(0, strurl, nomefile(x), 0, 0)
If errcode = 0 Then
'Debug.Print "OK"
Else
If Tentativi < MAX_Tentativi Then
GoTo retry3:
Else
Debug.Print "############ Errore Scaricamento file '" + nomefile(x) + " " + strurl
errcode = 0
End If
End If
End Sub
Private Function zero(I As Integer) As String
If I < 10 Then temp = "0" + LTrim(Str(I)) Else temp = LTrim(Str(I))
zero = temp
End Function
Sub SleepVBA(secs As Integer)
Dim s As Integer
For s = 1 To secs: Sleep 1000: DoEvents: Next
End Sub
La macro salva per ogni webcam una serie di file con nome webcam_X_Y, con X che identifica la webcam e Y il fotogramma.
