Attribute VB_Name = "upgrade"
Option Explicit

Private Const C_ARMSYSCOM_VER As Long = 1830
Private Const C_OLE_CAPTURE_XML As String = "C:\Arm_Apps\APOLLO_Sifyb\Capture.xml"
Private Const C_OLE_SRM_DOT As String = "C:\Arm_Apps\APOLLO_Sifyb\SRM_Task_Template.dot"
Private Const C_OLE_SRM_DOT_ZIP As String = "C:\Arm_Apps\APOLLO_Sifyb\SRM_Task_Template.zip"
Private Const C_DO_CAPTURE_XML As Boolean = False
Private Const C_DO_SRM_DOT As Boolean = False
Private Const C_OLE_ARMLOG As String = "C:\ARM_Apps\APOLLO_Sifyb\Armlog.dll"

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function CreateProcessWithLogon Lib "Advapi32" Alias "CreateProcessWithLogonW" (ByVal lpUsername As Long, ByVal lpDomain As Long, ByVal lpPassword As Long, ByVal dwLogonFlags As Long, ByVal lpApplicationName As Long, ByVal lpCommandLine As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInfo As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long

Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function EnumProcesses Lib "PSAPI.DLL" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long

Private Const SEP1 As String = "®"

Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_READ = 16
Private Const MAX_PATH = 1024
Private Const MAX_MODULES = 8192
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000
'STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Private Const PROCESS_ALL_ACCESS = &H1F0FFF

Private Const LOGON_WITH_PROFILE = &H1&
Private Const LOGON_NETCREDENTIALS_ONLY = &H2&
Private Const CREATE_DEFAULT_ERROR_MODE = &H4000000
Private Const CREATE_NEW_CONSOLE = &H10&
Private Const CREATE_NEW_PROCESS_GROUP = &H200&
Private Const CREATE_SEPARATE_WOW_VDM = &H800&
Private Const CREATE_SUSPENDED = &H4&
Private Const CREATE_UNICODE_ENVIRONMENT = &H400&
Private Const ABOVE_NORMAL_PRIORITY_CLASS = &H8000&
Private Const BELOW_NORMAL_PRIORITY_CLASS = &H4000&
Private Const HIGH_PRIORITY_CLASS = &H80&
Private Const IDLE_PRIORITY_CLASS = &H40&
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const REALTIME_PRIORITY_CLASS = &H100&

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type
Private Type STARTUPINFO
    cb As Long
    lpReserved As Long
    lpDesktop As Long
    lpTitle As Long
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Byte
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Const C_CNF_NAME = "Capture.cnf"
Const C_INI_NAME = "capture.ini"
' database connection parameters: login:jnagy, passw:jnagy
' input commanline arguments are passed to logs
' 1.parameter ... userName
' 2.parameter ... siteID
' 3.parameter ... cnf file fullpath to write success

Public Enum ProgressOperation
  prgping = 0
  prgConnecting = 1
  prgCredentials = 2
  prgwait = 3
  prguploadtrf = 4
  prgtrfprocess = 5
  prgBackup = 6
  prgserverdefine = 7
  prgnewdataset = 8
  prgcomparedataset = 9
  prgDownload = 10
  prgUpdatingDBF = 11
  prgresult = 12
  prgnewversion = 13
  prgDisconnecting = 14
  prg_update_on_line = 15
  prg_create_dir = 16
End Enum

Dim ms_AppPath As String

Private Declare Function Connect Lib "ArmLog.dll" ( _
  ByVal lpServer As String, _
  ByVal lpDatabase As String, _
  ByVal lpUser As String, _
  ByVal lpPassword As String, _
  ByVal lpApplication As String _
  ) As Long

Private Declare Function ExecuteSQL Lib "ArmLog.dll" ( _
  ByVal lpServer As String) As Long

Private Declare Function Disconnect Lib "ArmLog.dll" () As Long

Private Declare Function DecompressFile Lib "ArmLog.dll" ( _
  ByVal lpArchiveName As String, ByVal lpDirectory As String) As Long
Dim cpt_er As Integer


Function DeleteFile(ByVal f As String) As Boolean
On Error GoTo deletefile_er:
   Dim FSO As Object
   DeleteFile = False
Set FSO = CreateObject("Scripting.FileSystemObject")
   FSO.DeleteFile f, True
   DeleteFile = True
   Set FSO = Nothing
   Exit Function
deletefile_er:
   Set FSO = Nothing
   Select Case Err.Number:
   Case 53:
   Case Else: MsgBox "Process was unable to delete file: " & f & " - " & Err.Description
   End Select
End Function
Public Function GetSysDir() As String
    
    Dim ls_Buff As String, ll_Count As Long
    ls_Buff = Space(256)
    ll_Count = GetSystemDirectory(ls_Buff, 256)
    
    GetSysDir = Left(ls_Buff, ll_Count)

End Function

Public Function GetwindowsDir() As String
    Dim ls_Buff As String, ll_Count As Long
    ls_Buff = Space(256)
    ll_Count = GetWindowsDirectory(ls_Buff, 256)
    GetwindowsDir = Left(ls_Buff, ll_Count)
End Function

Private Function GetFileVersion(ByVal as_FilePath As String) As String
On Error GoTo getfileversion_er
GetFileVersion = ""
Dim wrk As String
Dim Pos1, Pos2, pos3, pos4 As Integer
If fileexist(as_FilePath) Then
    Dim lo_Fso As Object
    Set lo_Fso = CreateObject("Scripting.FileSystemObject")
    If lo_Fso.FileExists(as_FilePath) Then
    wrk = lo_Fso.GetFileVersion(as_FilePath)
    Pos1 = InStr(1, wrk, ".")
    Pos2 = InStr(Pos1 + 1, wrk, ".")
    pos3 = InStr(Pos2 + 1, wrk, ".")
    
    GetFileVersion = Left(wrk, Pos2) + Mid(wrk, pos3 + 1, 10)
    Else
    GetFileVersion = ""
    End If
    Set lo_Fso = Nothing
End If
Exit Function
getfileversion_er:
    Set lo_Fso = Nothing
End Function

Function fileexist(ByVal f As String) As Boolean
On Error GoTo fileexist_er:
fileexist = False
   Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
   If FSO.FileExists(f) Then
   fileexist = True
   End If
   Set FSO = Nothing
   
   Exit Function
fileexist_er:
   Select Case Err.Number:
   Case 53:
   Case Else: MsgBox "Error in searching for Capoff"
   End Select
End Function


Function folderexist(ByVal f As String) As Boolean
On Error GoTo folderexist_er:
folderexist = False
   Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
   If FSO.FolderExists(f) Then
   folderexist = True
   End If
   Set FSO = Nothing
   
   Exit Function
folderexist_er:
   Select Case Err.Number:
   Case 53:
   Case Else: MsgBox "Error in searching for folder " & f
   End Select
End Function

Sub Main()
    Dim lb_silentMode As Boolean
    Dim lo_frm As Sifybupdfrm

    lb_silentMode = (Command$ = "SilentMode")
    
    
    
    Set lo_frm = New Sifybupdfrm
    If Not lb_silentMode Then
        Screen.MousePointer = 11
        Call lo_frm.Show(False)
    End If
    
    If go_upgrade(lb_silentMode, lo_frm.oleArmsyscom, lo_frm.ole, lo_frm.oleXML, lo_frm.OleDot, lo_frm.OleArmlog) Then
        Call ShowMessage("SIFYB APPLICATION HAS BEEN UPGRADED SUCCESSFULLY. PLEASE RESTART IT AS NORMAL", lb_silentMode)
    End If
    Screen.MousePointer = 0
    
    If Not lo_frm Is Nothing Then
        Call lo_frm.Hide
    End If
    End
End Sub

Private Function go_upgrade(ByVal ab_silentMode As Boolean, ByRef ao_oleArmSysCom As ole, ByRef ao_ole As ole, ByRef ao_oleXML As ole, ByRef ao_oleDot As ole, ByRef ap_oleArmLog As ole) As Boolean
On Error GoTo getOff
    go_upgrade = False
    

    
    
    Dim nb_wait As Integer
    Dim res As Long
    Dim lcount As Long
    Dim ls_winpath As String
    Dim ls_syspath As String
    Dim do_armsyscom As Boolean
    
    ls_winpath = GetwindowsDir
    ls_syspath = GetSysDir
    do_armsyscom = False
    
   
    If Not CreatePath Then
        Call ShowMessage("problem to create path", ab_silentMode)
        GoTo getOff
    End If
    
    Dim Do_XML As Boolean, Do_SRMDot As Boolean
    
    Do_XML = C_DO_CAPTURE_XML
    Do_SRMDot = C_DO_SRM_DOT
    
    
    If Not folderexist("C:\Arm_Apps\APOLLO_Sifyb") Then
        Call ShowMessage("Folder C:\Arm_Apps\APOLLO_Sifyb where application should be located does not exist", ab_silentMode)
        Exit Function
    End If
    
    If fileexist("C:\Arm_apps\APOLLO_Sifyb\sifyb.exe") Then
        If Val(Replace(GetFileCurrentVersion("c:\arm_apps\dll\a_syscom.dll", False), ".", "")) < C_ARMSYSCOM_VER Then do_armsyscom = True
    
        Dim ls_currentVer As String
        ls_currentVer = Join(Array(App.Major, App.Minor, App.Revision), ".")
        If Not Val(Replace(GetFileVersion("C:\Arm_apps\APOLLO_Sifyb\sifyb.exe"), ".", "")) >= Val(ls_currentVer) Then
            Call ShowMessage("Sifyb Program version (" & GetFileVersion("C:\Arm_apps\APOLLO_Sifyb\sifyb.exe") & ") is greater than or equal to " & ls_currentVer & " This upgrade is not necessary", ab_silentMode)
            Exit Function
        End If
    Else
        Exit Function
    End If
    
    cpt_er = 0
    nb_wait = 0
    DoEvents
    If (ab_silentMode) Then
        ' Don't need to sleep
    Else
        Sleep (15000)
    End If
    
    If GetProcesses("sifyb.exe") Then
        While GetProcesses("sifyb.exe")
            Call ShowMessage("SIFYB APPLICATION MUST BE CLOSED BEFORE RUNNING THE UPGRADE. THIS PROGRAM HAS DETECTED THAT THE APPLICATION IS STILL RUNNING. PLEASE CLOSE AND THEN PRESS OK", ab_silentMode)
            If (ab_silentMode) Then
                Sleep (60000)
            Else
                Sleep (2000)
            End If
        Wend
    End If
        
        
    If Not OLEExport.Load_A_Com() Then
        Call ShowMessage("problem to initialize OLE Class", ab_silentMode)
        GoTo getOff
    End If

    If Not SaveOle(C_OLE_ARMLOG, ap_oleArmLog) Then
        Call ShowMessage("problem to extract Armlog", ab_silentMode)
        GoTo getOff
    End If

    DeleteFile ("C:\Arm_apps\APOLLO_Sifyb\sifyb.exe")

    If Not SaveOle("C:\Arm_apps\APOLLO_Sifyb\sifyb.zip", ao_ole) Then
        Call ShowMessage("problem to install the new version", ab_silentMode)
        GoTo getOff
    End If
    
    
    Call DecompressFile("C:\Arm_apps\APOLLO_Sifyb\sifyb.zip", "C:\Arm_apps\APOLLO_Sifyb\")
    
    Call DeleteFile("C:\Arm_apps\APOLLO_Sifyb\sifyb.zip")
    
    If Do_XML Then
        DeleteFile (C_OLE_CAPTURE_XML)
        If Not SaveOle(C_OLE_CAPTURE_XML, ao_oleXML) Then
            Call ShowMessage("problem to install the new version of " & C_OLE_CAPTURE_XML, ab_silentMode)
            GoTo getOff
        End If
    End If
  
    If Do_SRMDot Then
        DeleteFile (C_OLE_SRM_DOT)
        DeleteFile (C_OLE_SRM_DOT_ZIP)
        If Not SaveOle(C_OLE_SRM_DOT_ZIP, ao_oleDot) Then
            Call ShowMessage("problem to install the new version of " & C_OLE_SRM_DOT, ab_silentMode)
            GoTo getOff
        End If
        
        If DecompressFile(C_OLE_SRM_DOT_ZIP, "C:\ARM_APPS\APOLLO_Sifyb") = 0 Then
            Call ShowMessage("problem to decompress the new version of " & C_OLE_SRM_DOT, ab_silentMode)
            GoTo getOff
        End If
        
        DeleteFile (C_OLE_SRM_DOT_ZIP)
        
    End If
  
  
  
    If do_armsyscom Then
        
        Dim lo_ExeCollection As New Collection
        Dim ll_Idx As Long
        Dim ls_Message As String
        
        If FillProcessListNT("c:\arm_apps\dll\a_syscom.dll", lo_ExeCollection) > 0 Then
            While lo_ExeCollection.Count > 0
            
                ls_Message = "THIS PROGRAM HAS DETECTED THAT FOLLOWING APPLICATIONS ARE STILL RUNNING. PLEASE CLOSE AND THEN PRESS OK"
                For ll_Idx = 1 To lo_ExeCollection.Count
                    ls_Message = ls_Message & vbCrLf & lo_ExeCollection(ll_Idx)
                Next
                Call MsgBox(ls_Message, vbOKOnly, "Sifyb Upgrade")
                Call FillProcessListNT("c:\arm_apps\dll\a_syscom.dll", lo_ExeCollection)
            Wend
        End If
        res = Shell("regsvr32.exe /s /u c:\arm_apps\dll\a_syscom.dll", vbHide)
        
        Sleep (2000)
        
        If fileexist("C:\ARM_APPS\Dll\A_syscom.dll") Then
            Call DeleteFile("C:\Arm_apps\dll\a_syscom.dll")
        End If
        DoEvents
        
        Sleep (5000)
          
        If Not SaveOle("C:\Arm_apps\dll\a_syscom.dll", ao_oleArmSysCom) Then
            Screen.MousePointer = 0
            MsgBox "problem to install the new version", vbOKOnly, "Armsyscom Upgrade"
            GoTo getOff
        End If
        Sleep (2000)
        res = Shell("regsvr32.exe /s c:\arm_apps\dll\a_syscom.dll", vbHide)
        Sleep (2000)
    End If
    OLEExport.Unload_A_Com


    'DeleteFile (C_OLE_ARMLOG)

    go_upgrade = True
Exit Function
  
getOff:
    Screen.MousePointer = 0
    Select Case Err.Number
    Case 70:
        ' if directory is open in filemanager, delete failed but windows will normally automatically close afterwards and then retry should work
        If nb_wait < 3 Then
            nb_wait = nb_wait + 1
            Sleep (5000)
            Resume
        Else
            Screen.MousePointer = 0
            MsgBox "An error occured during the install process." & Err.Description, vbOKOnly, "Sifyb Upgrade"
            OLEExport.Unload_A_Com
        End If
    Case Else
        Screen.MousePointer = 0
        MsgBox "An error occured during the install process." & Err.Description, vbOKOnly, "Sifyb Upgrade"
        OLEExport.Unload_A_Com
    End Select
End Function

Private Sub ShowMessage(ByVal as_text As String, ByVal ab_silentMode As Boolean)
On Error GoTo err_handler
    If Not ab_silentMode Then
        Screen.MousePointer = 0
        Call MsgBox(as_text, vbOKOnly, "Sifyb Upgrade")
        Screen.MousePointer = 11
    End If
    Exit Sub
err_handler:
    If Not ab_silentMode Then Call MsgBox("Unexpected error: " & Err.Number & "  " & Err.Description)
End Sub


Private Function GetFileCurrentVersion(ByVal as_FilePath As String, ByVal type3 As Boolean) As String
On Error GoTo GetFileCurrentVersion_er
GetFileCurrentVersion = ""
Dim wrk As String
Dim Pos1, Pos2, pos3, pos4 As Integer


If fileexist(as_FilePath) Then

    Dim lo_Fs As Object
    Set lo_Fs = CreateObject("Scripting.FileSystemObject")
    wrk = lo_Fs.GetFileVersion(as_FilePath)
    If type3 Then
    Pos1 = InStr(1, wrk, ".")
    Pos2 = InStr(Pos1 + 1, wrk, ".")
    pos3 = InStr(Pos2 + 1, wrk, ".")
    
    GetFileCurrentVersion = Left(wrk, Pos2) + Mid(wrk, pos3 + 1, 10)
    Else
    GetFileCurrentVersion = wrk
    End If
End If
    Set lo_Fs = Nothing
Exit Function
GetFileCurrentVersion_er:
GetFileCurrentVersion = ""
    Set lo_Fs = Nothing
    MsgBox "Unexpected error: " & Err.Number & "  " & Err.Description
End Function


Function CreatePath() As Boolean
On Error GoTo CreatePath_er
   Dim FSO As Object
   Dim MainFolder As Object
   CreatePath = False
   
   Set FSO = CreateObject("Scripting.FileSystemObject")
   If Not FSO.FolderExists("C:\Arm_Apps") Then
 Set MainFolder = FSO.CreateFolder("C:\Arm_Apps")
   End If
   
   
  If Not FSO.FolderExists("C:\Arm_Apps\APOLLO_Sifyb") Then
  Set MainFolder = FSO.CreateFolder("C:\Arm_Apps\APOLLO_Sifyb")
  End If
   

   
  
   Set MainFolder = Nothing
   Set FSO = Nothing
CreatePath = True
Exit Function
CreatePath_er:
Set MainFolder = Nothing
   Set FSO = Nothing
End Function

Public Function FillProcessListNT(ByVal as_DllName As String, ByVal ao_Collecion As Collection) As Long
On Error GoTo ErrHandler
    
    Dim cb                As Long
    Dim cbNeeded          As Long
    Dim NumElements       As Long
    Dim ProcessIDs()      As Long
    Dim cbNeeded2         As Long
    Dim NumElements2      As Long
    Dim Modules(1 To MAX_MODULES) As Long
    Dim lret              As Long
    Dim ModuleName        As String
    Dim nSize             As Long
    Dim hProcess          As Long
    Dim ll_Idx            As Long
    Dim sModName          As String
    Dim sChildModName     As String
    Dim iModDlls          As Long
    Dim iProcesses        As Integer
    
    Call ClearCollection(ao_Collecion)
    If Trim(as_DllName) = "" Then Exit Function
    
    cb = 8
    cbNeeded = 96

    Do While cb <= cbNeeded
        cb = cb * 2
        ReDim ProcessIDs(cb / 4) As Long
        lret = EnumProcesses(ProcessIDs(1), cb, cbNeeded)
    Loop
    
    NumElements = cbNeeded / 4
    
    For ll_Idx = 1 To NumElements
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, ProcessIDs(ll_Idx))
        If hProcess Then
            lret = EnumProcessModules(hProcess, Modules(1), MAX_MODULES, cbNeeded2)
            If lret <> 0 Then
                ModuleName = Space(MAX_PATH)
                nSize = MAX_PATH
                lret = GetModuleFileNameExA(hProcess, Modules(1), ModuleName, nSize)
                sModName = Left$(ModuleName, lret)
                iProcesses = iProcesses + 1
                    
                iModDlls = 1
                Do
                    iModDlls = iModDlls + 1
                    ModuleName = Space(MAX_PATH)
                    nSize = MAX_PATH
                    lret = GetModuleFileNameExA(hProcess, Modules(iModDlls), ModuleName, nSize)
                    sChildModName = Left$(ModuleName, lret)
    
                    If sChildModName = sModName Then Exit Do
                    If StrComp(Trim(sChildModName), Trim(as_DllName), vbTextCompare) = 0 Then
                        If Not IsItemInCollection(ao_Collecion, sModName) Then
                            Call ao_Collecion.Add(sModName)
                        End If
                    End If
                Loop
            End If
        Else
            FillProcessListNT = 0
        End If
        lret = CloseHandle(hProcess)
    Next
    FillProcessListNT = iProcesses
    
    Exit Function
ErrHandler:
    Call ErrorHandler("FillProcessListNT")
End Function

Private Sub ClearCollection(ByVal ao_Collection As Collection)
On Error GoTo ErrHandler

    While ao_Collection.Count > 0
        Call ao_Collection.Remove(1)
    Wend
    Exit Sub
ErrHandler:
    Call ErrorHandler("ClearCollection")
End Sub

Private Function IsItemInCollection(ByVal ao_Collection As Collection, ByVal as_Item As String)
On Error GoTo ErrHandler

    Dim ll_Idx As Long
    
    IsItemInCollection = False
    For ll_Idx = 1 To ao_Collection.Count
        If StrComp(CStr(ao_Collection(ll_Idx)), as_Item, vbTextCompare) = 0 Then
            IsItemInCollection = True
            Exit For
        End If
    Next
    Exit Function
ErrHandler:
    Call ErrorHandler("IsItemInCollection")
End Function

Private Sub ErrorHandler(ByVal as_Fct As String)
    Rem Standard error handler
    Call Err.Raise(Err.Number, as_Fct & SEP1 & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
End Sub



