VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form App_Upd 
   Caption         =   "Application Upgrade"
   ClientHeight    =   2085
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7605
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   ScaleHeight     =   2085
   ScaleWidth      =   7605
   StartUpPosition =   3  'Windows Default
   Begin MSComctlLib.ProgressBar pg 
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   1080
      Width           =   7335
      _ExtentX        =   12938
      _ExtentY        =   661
      _Version        =   393216
      Appearance      =   1
   End
   Begin VB.Label download_progress 
      Height          =   375
      Left            =   120
      TabIndex        =   2
      Top             =   1560
      Width           =   6735
   End
   Begin VB.Label Label1 
      Caption         =   "A new Version is being downloaded to your PC, Please do not stop this process"
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   480
      Width           =   6735
   End
End
Attribute VB_Name = "App_Upd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim lo_FTP As Object
    
Private Type Inet_address
    Byte4 As String * 1
    Byte3 As String * 1
    Byte2 As String * 1
    Byte1 As String * 1
    End Type

Private Type Hostent
    h_name As Long
    h_aliases As Long
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As Long
End Type

Dim hostname As String * 256
Dim lo_ctrl As Object
Dim ms_hostName As String, ms_ip As String
Dim lo_IPAddr As Inet_address
Dim ms_copyFile As String
Dim ms_FTPRoot As String            ' root directory for opened FTP session

Private Type WSAdata
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To 255) As Byte
    szSystemStatus(0 To 128) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type

Const SOCKET_ERROR = -1

' ***** WSock32 Subroutines and Functions ********
Private Declare Function gethostname Lib "wsock32.dll" (ByVal hostname$, ByVal HostLen As Long) As Long
Private Declare Function gethostbyname& Lib "wsock32.dll" (ByVal hostname$)
Private Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAData As WSAdata) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy&)
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMiliseconds As Long)


Private Sub Form_Activate()
    update_to_new_version
    If fileexist(prg.Application_Dir & "\Sifybupd.exe") Then
        Call Shell(prg.Application_Dir & "\Sifybupd.exe", 1)
    Else
        Screen.MousePointer = 0
        MsgBox "Download of upgrade failed. Call IT support"
    End If
    aDb.Disconnect
    Set aDb = Nothing
    End
End Sub


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


Private Sub GetLocalFTPServer()
On Error GoTo ErrHandler

    Const selServerReq As String = "SELECT IP_Server_Adr, Name, Login, Pswd FROM PWP_Server" & vbCrLf & _
                                   "WHERE IP_Server_Adr like '$IPMASKED$.%'"

    Dim ls_req As String, ls_IPMasked As String
    Dim ll_Cursor As Long
    Dim lsa_IP_parts() As String
    Dim ll_parts As Long
    Dim ll_Index As Long
    Dim lb_serverFound As Boolean
    
    lb_serverFound = False
    lsa_IP_parts = Split(prg.FTP_HostIP, ".")
    ll_parts = UBound(lsa_IP_parts)
    
    Do While ll_parts >= LBound(lsa_IP_parts)
        ls_IPMasked = ""
        For ll_Index = LBound(lsa_IP_parts) To ll_parts
            ls_IPMasked = ls_IPMasked & IIf(ls_IPMasked = "", "", ".") & lsa_IP_parts(ll_Index)
        Next
        
        ls_req = Replace(selServerReq, "$IPMASKED$", ls_IPMasked)
        ll_Cursor = aDb.OpenSQL(ls_req)
            
        If aDb.RowCount(ll_Cursor) <> 0 Then
            prg.FTP_ServerName = aDb.GetFields(ll_Cursor, "Name")
            prg.FTP_ServerIP = aDb.GetFields(ll_Cursor, "IP_Server_Adr")
            prg.FTP_Login = aDb.GetFields(ll_Cursor, "Login")
            prg.FTP_PWD = aDb.GetFields(ll_Cursor, "Pswd")
            lb_serverFound = True
            Exit Do
        End If
        
        aDb.Close (ll_Cursor)
        ll_parts = ll_parts - 1
    Loop
    
    If Not lb_serverFound Then
        'Call LogMessage("Local FTP server not found. IP:" & as_hostIP & " Machine name:" & ms_hostName & ".", "E")
    End If
    
    Exit Sub
ErrHandler:
    If ll_Cursor <> 0 Then aDb.Close (ll_Cursor)
    'Call ErrorHandler("GetLocalFTPServer()")
End Sub
' ************************************************************************************
' ******************************* FTP FUNCTIONS **************************************
' ************************************************************************************

Private Function OpenFTP(ByVal as_IP As String, as_Login As String, as_Password As String) As Boolean
On Error GoTo ErrHandler
    OpenFTP = False
    If Not lo_FTP.LogOnToServer(as_IP, , as_Login, as_Password) Then
        Exit Function
    End If
    Dim ll_i As Long
    ll_i = InStr(1, as_Login, "/")
    If ll_i <> 0 Then
        ms_FTPRoot = right(as_Login, Len(as_Login) - ll_i) & "\"
    Else
        ms_FTPRoot = ""
    End If
    OpenFTP = True
    Exit Function
ErrHandler:
End Function


Private Function update_to_new_version()
    
    If False Then 'Check_FTP_Availability Then  -- Apollo has SQL update only
        Upg_info ("FTP Download selected. Local IP is " & prg.FTP_HostIP & ", FTP Server is " & prg.FTP_ServerIP & "/" & prg.FTP_ServerName)
        If FTP_Download Then
            If fileexist(prg.Application_Dir & "\Sifybupdzip.exe") Then
                If Not aDb.DecompressFile(prg.Application_Dir & "\sifybupdzip.exe", prg.Application_Dir & "\sifybupd.exe", False, False) Then
                    MsgBox "error decompress"
                Else
                    DeleteFile (prg.Application_Dir & "\sifybupdzip.exe")
                End If
            Else
                DeleteFile (prg.Application_Dir & "\sifybupdzip.exe")
                Upg_info ("Downloaded from SQL Server as FTP download failed. Local IP is " & prg.FTP_HostIP)
                SQL_Download
            End If
        Else
            DeleteFile (prg.Application_Dir & "\sifybupdzip.exe")
            Upg_info ("Downloaded from SQL Server as FTP download failed. Local IP is " & prg.FTP_HostIP)
            SQL_Download
        End If
    Else
        Upg_info ("Downloaded from SQL Server. Local IP is " & prg.FTP_HostIP)
        SQL_Download
    End If
    
End Function




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"
   End Select
End Function


Private Function vbGetHostByName(ByVal ls_Host As String, ByRef lo_IPLong As Inet_address) As Boolean
On Error GoTo Err_vbGetHostByName
    Dim ls_TempHost As String
    Dim ls_zString As String
    Dim ll_PointerToPointer As Long
    Dim lo_Hostent As Hostent
    Dim li_ListAddress As Long
    Dim ll_ListAddr As Long
    'Dim ll As Long

    ls_TempHost = Trim(ls_Host)
    
    ls_zString = String(64, &H0)
    ls_TempHost = ls_TempHost + right$(ls_zString, 64 - Len(ls_TempHost))
    ll_PointerToPointer = gethostbyname(ls_TempHost)
'    MsgBox "gethostbyname :(" & CStr(ll_PointerToPointer) & ")"
    If IsNull(ll_PointerToPointer) Or (ll_PointerToPointer = 0) Then            ' If WSock32 error, then tell me about it
        Call Err.Raise(InvalidValue, "vbWSACleanup", "Winsock Error" & Str$(WSAGetLastError()))
    Else
        'll_PointerToPointer = gethostbyname(ls_TempHost)              ' Get the pointer to the address of the winsock hostent structure
        CopyMemory lo_Hostent, ByVal _
        ll_PointerToPointer, Len(lo_Hostent)                      ' Copy Winsock structure to the VisualBasic structure

        li_ListAddress = lo_Hostent.h_addr_list                   ' Get the ListAddress of the Address List
        CopyMemory ll_ListAddr, ByVal li_ListAddress, 4           ' Copy Winsock structure to the VisualBasic structure
        
        Do While ll_ListAddr <> 0
            CopyMemory lo_IPLong, ByVal ll_ListAddr, 4                ' Get the first list entry from the Address List
            
            li_ListAddress = li_ListAddress + LenB(lo_Hostent.h_addr_list)
            CopyMemory ll_ListAddr, ByVal li_ListAddress, 4           ' Copy Winsock structure to the VisualBasic structure
            
        
        Loop
  
        
        vbGetHostByName = True
      
    End If
    Exit Function
    
Err_vbGetHostByName:
    vbGetHostByName = False
   ' Call ErrorHandler("vbGetHostByName()")
End Function
Private Function DownLoadFile(ByVal as_serverName As String, ByVal as_src As String, as_dst As String) As Boolean
On Error GoTo ErrHandler
    Dim ll_BytesTransfered As Long
    Dim ll_BytesTotal As Long
    Dim ll_result As Long
    DownLoadFile = False
   pg.Min = 0
   pg.Max = 1
   pg.value = pg.Min
  DownLoadFile = False
    ' test if destination directory exists
    Dim ls_dir As String
    
    ls_dir = Left(as_dst, InStrRev(Replace(as_dst, "/", "\"), "\"))
    
    If Not lo_FTP.DownloadFileAsynch(as_dst, as_src, True) Then
        ' TODO : LOG ERROR
     '   Call LogMessage("FTP file download failed. File name:\\" & as_serverName & "\" & as_src & ".", "E")
        Exit Function
    Else
        ' set global value
        ms_copyFile = as_dst
        ' this most time cost operation of file download
        While lo_FTP.AsynchOperationProgress(ll_BytesTransfered, ll_BytesTotal, ll_result) 'And Not mb_copyAbort
       
            If ll_BytesTotal <> 0 Then
                pg.value = ll_BytesTransfered / ll_BytesTotal
                'download_progress
                ' pg.Min + (pg.Max - pg.Min) * ll_BytesTransfered / ll_BytesTotal
            End If
            download_progress = ll_BytesTransfered & " downloaded out of  " & ll_BytesTotal
            ll_result = DoEvents()
            Call Sleep(100)
         Debug.Print ll_BytesTransfered & " : " & ll_BytesTotal & " Result: " & ll_result
        Wend
        DoEvents
        If ll_BytesTransfered = ll_BytesTotal And ll_result <> 0 Then 'And Not mb_copyAbort
            ' file transfer successed
            pg.value = 1
            DownLoadFile = True
            ms_copyFile = ""
        Else
        End If
    End If
    
   
    Exit Function
ErrHandler:
MsgBox Err.Description
   ' Call ErrorHandler("DownLoadFile()")
End Function







Private Function Check_FTP_Availability() As Boolean
Check_FTP_Availability = False
    If gethostname(hostname, 256) = SOCKET_ERROR Then
        Dim ll_errnum As Long
        ll_errnum = WSAGetLastError()
     '   Call Err.Raise(CompFncFailed, "InitControls", "gethostname() failed. error:" & ll_errNum)
        Exit Function
    Else
        prg.FTP_HostName = Left(hostname, InStr(1, hostname, String(1, 0), vbBinaryCompare) - 1)
    End If

    If Not vbGetHostByName(FTP_HostName, lo_IPAddr) Then
      '  Call Err.Raise(CompFncFailed, "InitControls", "vbGetHostByName() failed.")
    End If
    
    ' construct string IP
    prg.FTP_HostIP = CStr(Asc(lo_IPAddr.Byte4)) & "." & CStr(Asc(lo_IPAddr.Byte3)) & "." & CStr(Asc(lo_IPAddr.Byte2)) & "." & CStr(Asc(lo_IPAddr.Byte1))
   ' Dim tt As String
   ' tt = prg.FTP_HostIP
   ' prg.FTP_HostIP = "10.68.16.40"
    Call GetLocalFTPServer
   ' prg.FTP_HostIP = tt

If prg.FTP_ServerName <> "" Then Check_FTP_Availability = True
End Function

Private Function FTP_Download() As Boolean
    ' first try local server
   
    Set lo_FTP = CreateObject("ArmSysCOM.ArmFTP")
   FTP_Download = False
    App_Upd.Caption = App_Upd.Caption & "(" & prg.FTP_ServerName & ", " & prg.FTP_ServerIP & ")"
        If OpenFTP(prg.FTP_ServerIP, prg.FTP_Login, prg.FTP_PWD) Then
'
                    FTP_Download = DownLoadFile(prg.FTP_ServerIP, prg.Upgrade_FTP_FullPath, prg.Application_Dir & "\sifybupdzip.exe") 'prg.Upgrade_Download_FullPath)
            Call lo_FTP.LogoffServer
        Else
            'MsgBox ("Cannot connect to local PWP FTP Server " & prg.FTP_ServerName & ".")
        End If
 
    
    Set lo_FTP = Nothing

End Function



Private Function SQL_Download()
    
    SQL_Download = False
    Dim ll_Pos As Long, ll_max As Long
    Dim ll_Cursor As Long

    Screen.MousePointer = 11
    App_Upd.Caption = App_Upd.Caption & " (SQL Download)"
    For ll_try = 1 To 3
        ll_Cursor = aDb.BlobToFileAsynchSQL("select F_Data_file from A_Files where F_File_key ='SIFYB'", prg.Application_Dir & "\sifybupd.exe", True, False)
        If ll_Cursor <= 0 Then Exit Function
        pg.Max = 100
        Do
            If aDb.GetProgressAsynchSQL(ll_Cursor, ll_Pos, ll_max) Then
                If ll_max > 0 Then pg.value = (ll_Pos / ll_max) * 100
                download_progress = ll_Pos & " downloaded out of  " & ll_max
                DoEvents
                Sleep (2500)
            End If
        Loop While aDb.StillExecutingSQL(ll_Cursor)
        If aDb.GetProgressAsynchSQL(ll_Cursor, ll_Pos, ll_max) Then
            If ll_max > 0 Then pg.value = (ll_Pos / ll_max) * 100
        End If
        If IsArray(aDb.SQLAsynchErrorCodes(ll_Cursor)) Then Exit Function
        If IsArray(aDb.SQLAsynchErrorMessages(ll_Cursor)) Then Exit Function
        If Not aDb.Close(ll_Cursor) Then Exit Function
        lb_Result = True
        Exit For
            
    Next ll_try
    If lb_Result Then SQL_Download = True

End Function

Private Sub Upg_info(ByVal info As String)
aDb.ExecuteSQL ("INSERT INTO Temporary_Sifyb_info(Session_key, Session_line_order,login_name,record_type, session_date, session_info) VALUES('" & prg.Session_Key & "'," & prg.session_line_order & ",'" & prg.LoginName & "','1', getdate() ,'" & info & "')")
prg.session_line_order = prg.session_line_order + 1
End Sub
