Kontakt
DSVGO
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 SubTypischerweise 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