Talk:File System + File I/O in VB6

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