VB-Tec.de Visual Basic - Technik, FAQ, Tricks, BeispieleHome / Allgemein / Entwicklung / Update Automatisches Programm-Update |
Private Sub AutoUpdate(ByRef OrgPath As String)
Dim AppPath As String
Dim Versuch As Long
Dim DateLocal As Double
Dim DateNet As Double
On Error Resume Next
If LCase$(Right$(App.EXEName, 4)) <> ".upd" Then
'Normale EXE wurde gestartet:
AppPath = App.Path & "\" & App.EXEName
If Len(Dir$(AppPath & ".upd.exe")) Then
'Aufräumen, ggf. altes Update löschen: *5*
For Versuch = 1 To 10
Err.Clear
Kill AppPath & ".upd.exe"
If Err.Number = 0 Then Exit For
Pause 1
Next Versuch
End If
'Zeitstempel vergleichen: *1*
DateLocal = FileDateTime(AppPath & ".exe")
DateNet = FileDateTime(OrgPath)
If DateNet > DateLocal Then
Beep
'Neue Version lokal kopieren:
For Versuch = 1 To 10
Err.Clear
FileCopy OrgPath, AppPath & ".upd.exe"
If Err.Number = 0 Then Exit For
Pause 1
Next Versuch
If Err.Number Then
'Wiederholter Fehler:
Beep
MsgBox _
App.EXEName & " konnte nicht aktualisiert werden!", _
vbInformation
Else
'Neue Version erstmals starten: *2*
Pause 0.1
Shell AppPath & ".upd.exe " & Command$, vbNormalFocus
End
End If
End If
Else
'Neue Version erstmals gestartet:
AppPath = App.Path & "\" & _
Left$(App.EXEName, Len(App.EXEName) - 4) & ".exe"
'*.upd.exe nach *.exe kopieren: *3*
For Versuch = 1 To 10
Err.Clear
FileCopy App.Path & "\" & App.EXEName & ".exe", AppPath
If Err.Number = 0 Then Exit For
Pause 1
Next Versuch
If Err.Number Then
'Wiederholter Fehler:
Beep
MsgBox _
App.EXEName & " konnte nicht aktualisiert werden!", _
vbInformation
Else
'Endlich die neue Version "richtig" starten: *4*
Pause 0.1
Shell AppPath & " " & Command$, vbNormalFocus
End
End If
End If
End Sub
Typischerweise würde man diese Routine z.B. in der Main-Prozedur verwenden, etwa so:Sub Main() 'Auf neue Version testen: AutoUpdate "\\SV-Daten\Abt3\Prog\Test\Test.exe" 'Ansonsten Hauptformular anzeigen: frmMDI.Show End SubDie hier verwendete Pause-Prozedur kann übrigens unter http://www.schwider.de/timestmp.htm gefunden werden.
© Jost Schwider, 03.08.2000-03.08.2000 - http://vb-tec.de/autoupd.htm