Return to "File System + File I/O in VB6" page.SLX LaunchAssistant
Option Explicit
Public intbarProg As Integer
Public blnUpdate As Boolean
Public intTimer As Integer
Public strResponse%
Public xmlfilepath As String
Public exefilepath As String
Public dirfilepath As String
Public localfspath As String
Private Sub Form_Load()
tmr.Enabled = True
xmlfilepath = "\\Iulnksaleslogic\util\SLXAssistant\autoupdate.xml"
exefilepath = "\\Iulnksaleslogic\util\SLXAssistant\SLXAssist.exe"
dirfilepath = "\\Iulnksaleslogic\util\SLXAssistant\"
localfspath = "C:\Program Files\SalesLogixAsst\"
End Sub
Private Sub tmr_Timer()
' This loops until the timer is stopped
intTimer = intTimer + 1
' Debug.Print intTimer
intbarProg = intTimer: barProg.Value = intbarProg
Select Case intTimer
Case 90
' [step 4]: launch SLXAssist.exe
launchSLXAssist
Case 70
' [step 3]: if an update is available perform the update action
checkFile03
Case 60
' [step 2]: open xml for read, compare to local xml, see if update is available
checkFile02
Case 50
' [step 1]: check to see if the network path and autoupdate.xml are available
checkFile01
End Select
If intTimer > 99 Then
tmr.Enabled = False
Unload Me
End If
End Sub
Private Sub checkFile01()
' [step 1]: check to see if the network path and autoupdate.xml are available
Dim fLen As Integer
Dim strResponse%
tmr.Enabled = False
intbarProg = 0: barProg.Value = intbarProg
On Error Resume Next
fLen = Len(Dir$(xmlfilepath))
strResponse% = vbRetry
While strResponse% = vbRetry
If Err Or fLen = 0 Then
' file dosent exist
strResponse% = MsgBox("Error: XML inaccessible for auto-update!", vbAbortRetryIgnore, "SALESLOGIX ASSISTANT")
Else
' file exists
strResponse% = 0
End If
Wend
On Error GoTo 0
tmr.Enabled = True
End Sub
Private Sub checkFile02()
' [step 2]: open xml for read, compare to local xml, see if update is available
' blnUpdate (True) or (false) for step 3 to perform an update
tmr.Enabled = False
Select Case strResponse%
Case vbIgnore
' user ignored XML access error. will assume an update is available
blnUpdate = True
Case vbAbort
' MsgBox "Warning! ", vbCritical, "title"
blnUpdate = False
Case Else
blnUpdate = ReferenceAutoUpdateFile
End Select
tmr.Enabled = True
End Sub
Private Sub checkFile03()
' [step 3]: if an update is available perform the update action
tmr.Enabled = False
If blnUpdate = True Then
If UpdateSLXAssist = True Then
Debug.Print "an update has been performed"
Else
MsgBox "Critical Error! update failed ", vbCritical
End If
End If
tmr.Enabled = True
End Sub
Private Sub launchSLXAssist()
Dim intExecute%
If InStr(LCase(Command), "/interpreter") > 0 Then
MsgBox "Shell SLXAssist.exe"
Else
intExecute% = Shell("SLXAssist.exe /verified", 1)
End If
End Sub
Private Function ReferenceAutoUpdateFile() As Boolean
' check the xml file to see if an update is available
Dim fso As New FileSystemObject, xmlfile As File, fsoStream As TextStream
Dim cnt As Integer, strLine As String, strLocalVersion As String, strRemoteVersion As String
Dim blnRemoteFileValid As Boolean, blnLocalFileValid As Boolean
ReferenceAutoUpdateFile = True ' default is to perform the update
CheckRemoteFile:
On Error GoTo ErrHandler1
Set xmlfile = fso.GetFile(xmlfilepath)
Set fsoStream = xmlfile.OpenAsTextStream(ForReading)
blnRemoteFileValid = True: cnt = 0
Do While Not fsoStream.AtEndOfStream
cnt = cnt + 1
strLine = fsoStream.ReadLine
Select Case cnt
Case 3
If strLine <> " <application>" Then blnRemoteFileValid = False
Case 4
If strLine <> " <name>" Then blnRemoteFileValid = False
Case 5
If strLine <> " SLXAssistant" Then blnRemoteFileValid = False
Case 7
If strLine <> " <currentversion>" Then blnRemoteFileValid = False
Case 8
strRemoteVersion = strLine
End Select
If blnRemoteFileValid = False Then
fsoStream.Close
MsgBox "remote xml parse error", vbCritical
ReferenceAutoUpdateFile = True
Exit Function
End If
Loop
fsoStream.Close
' MsgBox strRemoteVersion
CheckLocalFile:
On Error GoTo ErrHandler2
Set xmlfile = fso.GetFile(localfspath & "autoupdate.xml")
Set fsoStream = xmlfile.OpenAsTextStream(ForReading)
blnLocalFileValid = True: cnt = 0
Do While Not fsoStream.AtEndOfStream
cnt = cnt + 1
strLine = fsoStream.ReadLine
Select Case cnt
Case 3
If strLine <> " <application>" Then blnLocalFileValid = False
Case 4
If strLine <> " <name>" Then blnLocalFileValid = False
Case 5
If strLine <> " SLXAssistant" Then blnLocalFileValid = False
Case 7
If strLine <> " <currentversion>" Then blnLocalFileValid = False
Case 8
strLocalVersion = strLine
End Select
If blnLocalFileValid = False Then
fsoStream.Close
MsgBox "local xml parse error", vbCritical
ReferenceAutoUpdateFile = True
Exit Function
End If
Loop
fsoStream.Close
' MsgBox strLocalVersion
CompareXMLVersion:
' MsgBox ("strRemoteVersion=" & strRemoteVersion & " strLocalVersion=" & strLocalVersion)
If strRemoteVersion = strLocalVersion Then
ReferenceAutoUpdateFile = False
Else
ReferenceAutoUpdateFile = True
End If
Exit Function
ErrHandler1:
Debug.Print "ReferenceAutoUpdateFile: ErrHandler1"
MsgBox "remote xml read error", vbCritical
ReferenceAutoUpdateFile = True
Exit Function
ErrHandler2:
Debug.Print "ReferenceAutoUpdateFile: ErrHandler1"
MsgBox "local xml read error", vbCritical
ReferenceAutoUpdateFile = True
Exit Function
End Function
Private Function UpdateSLXAssist() As Boolean
Dim fso As New FileSystemObject
Dim localexefilepath As String
UpdateSLXAssist = False
On Error GoTo ErrHandler
localexefilepath = localfspath
fso.CopyFile (xmlfilepath), (localexefilepath)
fso.CopyFile (exefilepath), (localexefilepath)
On Error Resume Next
fso.CopyFile (dirfilepath & "*.ocx"), (localexefilepath)
fso.CopyFile (dirfilepath & "*.dll"), (localexefilepath)
fso.CopyFile (dirfilepath & "SLXAO*.exe"), (localexefilepath)
fso.CopyFile (dirfilepath & "*.txt"), (localexefilepath)
On Error GoTo ErrHandler
Set fso = Nothing
UpdateSLXAssist = True
Exit Function
ErrHandler:
UpdateSLXAssist = False
End Function
Last modified on 2 February 2008, at 12:17