title image


Smiley Re: Bild, das im Internet ist anzeigen - wie?
Mit dem folgenden Code habe ich ein kleines Programm erstellt, welches in bestimmten Zeitabständen das Bild einer Webcam lokal auf meinen Rechner speichert und mir dieses Bild anzeigt. Zusätzlich zu den normalen Controls sind das Timer-Control sowie das Inet-Control dem Projekt hinzugefügt:



Option Explicit

Public dateDatumJetzt As Date

Public dateDatumSuch As Date





Sub Routine()



Dim b() As Byte

Dim strJahr As String

Dim strMonat As String

Dim strTag As String

Dim strStunde As String

Dim strMinute As String

Dim strNameNeu As String



If Dir("d:\bilder\", vbDirectory) = "" Then

MkDir "d:\bilder"

End If

If Dir("d:\bilder\norddeich", vbDirectory) = "" Then

MkDir "d:\bilder\norddeich"

End If

If Dir("d:\bilder\norddeich\neu", vbDirectory) = "" Then

MkDir "d:\bilder\norddeich\neu"

End If



Inet1.Protocol = icHTTP

Inet1.URL = "http://www.norden.de/webcam/norddeich.jpg"



strJahr = Right(Year(Now), 2)

strMonat = Month(Now)

If Len(strMonat) < 2 Then

strMonat = "0" & strMonat

End If

strTag = Day(Now)

If Len(strTag) < 2 Then

strTag = "0" & strTag

End If

strStunde = Hour(Now)

If Len(strStunde) < 2 Then

strStunde = "0" & strStunde

End If

strMinute = Minute(Now)

If Len(strMinute) < 2 Then

strMinute = "0" & strMinute

End If



strNameNeu = "d:\bilder\norddeich\neu\" & strJahr & strMonat & strTag & strStunde & strMinute & ".jpg"



If Dir(strNameNeu) "" Then

Kill strNameNeu

End If



b() = Inet1.OpenURL(Inet1.URL, icByteArray)



Open strNameNeu For Binary Access Write As #1

Put #1, , b()

Close #1



Image1.Picture = LoadPicture(strNameNeu)



Form1.Label1 = strNameNeu

Form1.Label4 = Now



Schluss:



End Sub



Private Sub Command1_Click()

Timer1.Enabled = True

Call Timer1_Timer

End Sub



Private Sub Command2_Click()

Unload Me

End Sub



Private Sub Form_Load()

dateDatumSuch = Now

dateDatumJetzt = Now

End Sub





Private Sub Timer1_Timer()

If ProgressBar1 = 30 Then

ProgressBar1 = 0

Else

ProgressBar1 = ProgressBar1 + 1

End If



dateDatumJetzt = Now



Form1.Label3 = dateDatumJetzt



If dateDatumJetzt >= dateDatumSuch Then

dateDatumSuch = DateAdd("n", 30, dateDatumJetzt)

Form1.Label2 = dateDatumSuch

Call Routine

End If



End Sub

Gruß aus Ostfriesland. Möge Tux mit Dir sein!

ff


Proggst du schon .net oder quälst du dich noch mit VB6?



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: