Updatefunktion

Um zu prüfen, ob ein Update für ein Skript möglch ist, muss im Skript selbst die Version abgelegt sein und der Ort im Internet, wo die aktuelle Version abgelegt ist.

Das kann beispielsweise im Skriptkopf wie folgt eingetragen und dann beim Update ausgelesen werden

'FFSkriptVersion=3.03
'FFSkriptURL=http://www.ffsf.de/local_links.php?catid=235&linkid=914

oder direkt in Konstanten definiert werden, was das Auslesen einspart

const SkriptVersion = "3.03"
const SkriptUrl = http://www.ffsf.de/local_links.php?catid=235&linkid=914

Für FF-Skripte bietet sich an, die aktuelle Versionsnummer auf der Downloadseite im Zubehörbereich einzutragen. Das erlaubt dann auch den Aufruf dieser Webseite, wenn ein Update
gewünscht wird. Hier ein Beispiel dafür, wie das aussehen kann: Downloadseite für das Skript Webschatten

Sind Skriptversion und aktuelle Version bekannt, kann aus einem Vergleich abgeleitet werden, ob ein Update möglich ist. Im folgenden Beispiel wird dann angeboten, direkt die Downloadseite aufzurufen.

Option Explicit
const SkriptVersion = "3.02"
const SkriptUrl = "http://www.ffsf.de/local_links.php?catid=235&linkid=914"
'************************************************************************
'Suchen der Versionsangabe auf der SkriptURL und diese
'vergleichen mit der SkriptVersion

Dim objFS,WshShell
Set objFS = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")

Dim UrlVersion,UrlV_Zahl,SkriptV_Zahl
Dim Abbruch : Abbruch = false
'************************************************************************

call Update

'------------------------------------------------------------------------
Sub Update
Dim Antwort

call Versionsermittlung_url

if not Abbruch then
   SkriptV_Zahl = Replace(SkriptVersion,".","") *1

   if UrlV_Zahl = SkriptV_Zahl then
      msgbox "Die Version " & SkriptVersion & " ist aktuell!",vbInformation,"Versionsmeldung"
   elseif SkriptV_Zahl < UrlV_Zahl then
      Antwort = msgbox("Die Skriptversion " & SkriptVersion & " ist nicht mehr aktuell!" & vbNewLine &_
            "Es steht die Version " & UrlVersion & " zum Download bereit." & vbNewLine & vbNewLine & _
            "Soll die Downloadseite aufgerufen werden?",vbQuestion + vbYesNo,"Versionsmeldung")
      if Antwort = vbYes then
         on error resume next
         WshShell.Run SkriptUrl,1,false
         if err <> 0 then
            msgbox "Die Downloadseite wurde nicht gefunden!",vbExclamation,"Hinweis"
            err.clear
         end if
         on error goto 0
      end if
   else
      msgbox "Es liegt ein Fehler in den Versionsangaben vor." & vbNewLine &_
             "Die Skriptversion " & SkriptVersion & " ist größer als die auf" & vbNewLine &_
             "der Downloadseite angegebene Version " & UrlVersion & ".",vbInformation,"Fehlermeldung"
   end if
end if

End Sub
'------------------------------------------------------------------------
Sub Versionsermittlung_url

Dim Inhalt,Start,Zeit,pos1,pos2,n
Dim Browser

on error resume next
    Set Browser = CreateObject("InternetExplorer.Application")
    Browser.Navigate SkriptUrl   'Zugriff auf die Internetseite
    if err.number > 0 then
        msgbox  "Der Internetexplorer kann nicht aufgerufen werden." & vbNewLine & _
                "Damit steht die Updatefunktion nicht zur Verfügung!",vbCritical,"Hinweis"
        Abbruch = true
        exit sub
    end if

    'max. 6 sec. prüfen, ob die Seite geladen wurde
    Start = Timer
    do
       Inhalt = Browser.Document.Body.InnerHtml
       if instr(Inhalt,"Version") > 0 then exit do

       FF_Sleep(200)         'Zeit für die Arbeit des IE (wichtig!)

       Zeit = Timer - Start
       if Zeit < 0 then Start = Timer

    loop until Zeit > 6
on error goto 0

' Ressourcen freigeben
Browser.Quit
Set Browser = Nothing

if len(Inhalt) = 0 then
    msgbox  "Die Versionsangabe im Internet wurde nicht gefunden!" & vbNewLine &_
            "Möglicherweise funktioniert der Internetaufruf nicht." & vbNewLine & vbNewLine & _
            "Am besten nochmal probieren!",vbExclamation,"SkriptVersion " & SkriptVersion
    exit sub
end if

'Version ermitteln
pos1 = instr(Inhalt,"Version")
if pos1 > 0 then
   pos2 = instr(pos1,Inhalt,".")
   if pos2 > pos1 then
       UrlVersion = trim(mid(Inhalt,pos1,pos2-pos1 +3))
   else
       msgbox "Auf diesem Rechner funktioniert die Updatefunktion leider nicht!",vbCritical,"Updateinfo B"
       Abbruch = true
       exit sub
   end if
else
   msgbox "Auf diesem Rechner funktioniert die Updatefunktion leider nicht!",vbCritical,"Updateinfo A"
   Abbruch = true
   exit sub
end if

'Version als Zahl
pos1 = instr(UrlVersion," ")
if pos1 = 0 then pos1 = 7
UrlVersion = trim(mid(UrlVersion,pos1+1))
UrlV_Zahl = Replace(UrlVersion,".","") *1

End Sub
'------------------------------------------------------------------------

Der Zugriff auf die Webseite zur Versionsermittlung kann auch über das Objekt XMLHTTP erfolgen wie es im Beitrag URL auslesen beschrieben ist. Der ist nach den letzten Erfahrungen schneller und zuverlässiger und wird daher empfohlen.

Die oben gezeigte Unterroutine Versionsermitllung_url kann dann beispielsweise wie folgt aussehen:

Sub Versionsermittlung_url

Dim objXML,Inhalt,Start,Zeit,pos1,pos2,n
Dim Fehler : Fehler = false

on error resume next
Set objXML = CreateObject("Microsoft.XMLHTTP")
objXML.Open "Get",SkriptUrl,false
objXML.Send

Inhalt = objXML.responseText

if err > 0 then
   Fehler = true
else
   'Version suchen und anzeigen
   pos1 = instr(Inhalt,"Version")
   if pos1 > 0 then

      pos2 = instr(pos1,Inhalt,"<br")
      if pos2 > 0 then
         UrlVersion = trim(mid(Inhalt,pos1,pos2-pos1))
      else
         Fehler = true
      end if
   else
      Fehler = true
   end if
end if

Set objXML = nothing

if Fehler then
   msgbox  "Die Versionsangabe wurde nicht gefunden!" & vbNewLine &_
         "Möglicherweise funktioniert der Internetaufruf nicht." & vbNewLine & vbNewLine & _
         "Am besten nochmal probieren!",vbExclamation,"Fehlermeldung"
   Abbruch = true
   exit sub
end if

'Version als Zahl
pos1 = instr(UrlVersion," ")
if pos1 = 0 then pos1 = 7
UrlVersion = trim(mid(UrlVersion,pos1+1))
UrlV_Zahl = Replace(UrlVersion,".","") *1

End Sub
 

Das Ganze setzt natürlich eine sorgfältige Pflege der Versionsangaben, sowohl im Skript als auch auf der Downloadseite voraus.

Der Aufruf des Updatetest könnte bei jedem Skriptstart erfolgen oder/und auf einen Befehl hin, der vom Benutzer ausgelöst wird.

'max. 3 sec. prüfen, ob die die Seite geladen ist
Start = Timer
do
on error resume next
Inhalt = Browser.Document.Body.InnerHtml
on error goto 0