VERSION 5.00
Begin VB.Form DSW_Mgr 
   Caption         =   "DSW Capture Interface"
   ClientHeight    =   11115
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   17220
   LinkTopic       =   "Form1"
   ScaleHeight     =   11115
   ScaleWidth      =   17220
   StartUpPosition =   3  'Windows Default
   Begin DSWMGR.DSW DSW1 
      Height          =   6450
      Left            =   1140
      TabIndex        =   10
      Top             =   285
      Visible         =   0   'False
      Width           =   12585
      _ExtentX        =   22199
      _ExtentY        =   11377
   End
   Begin VB.Frame Fr_user 
      Caption         =   "Log In "
      Height          =   2055
      Left            =   5160
      TabIndex        =   0
      Top             =   4560
      Width           =   3375
      Begin VB.OptionButton lg 
         Caption         =   "French"
         Height          =   255
         Index           =   2
         Left            =   2355
         TabIndex        =   9
         Tag             =   "F"
         Top             =   1320
         Width           =   930
      End
      Begin VB.OptionButton lg 
         Caption         =   "Dutch"
         Height          =   255
         Index           =   1
         Left            =   1245
         TabIndex        =   8
         Tag             =   "D"
         Top             =   1320
         Width           =   930
      End
      Begin VB.OptionButton lg 
         Caption         =   "English"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   7
         Tag             =   "E"
         Top             =   1320
         Value           =   -1  'True
         Width           =   1095
      End
      Begin VB.CommandButton Bt_exit 
         Caption         =   "Exit"
         Height          =   255
         Left            =   1560
         TabIndex        =   4
         Top             =   1680
         Width           =   735
      End
      Begin VB.CommandButton bt_connect 
         Caption         =   "OK"
         Height          =   255
         Left            =   2400
         TabIndex        =   3
         Top             =   1680
         Width           =   735
      End
      Begin VB.TextBox pwd 
         Height          =   375
         IMEMode         =   3  'DISABLE
         Left            =   1200
         PasswordChar    =   "*"
         TabIndex        =   2
         Top             =   840
         Width           =   1695
      End
      Begin VB.TextBox usr 
         Height          =   375
         IMEMode         =   3  'DISABLE
         Left            =   1200
         TabIndex        =   1
         Top             =   360
         Width           =   1695
      End
      Begin VB.Label Label7 
         Caption         =   "Password"
         Height          =   255
         Left            =   120
         TabIndex        =   6
         Top             =   840
         Width           =   1095
      End
      Begin VB.Label Label6 
         Caption         =   "Username"
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   360
         Width           =   1095
      End
   End
End
Attribute VB_Name = "DSW_Mgr"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DB As New ArmDb
Dim curs As Long
Dim REQ As String

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 Sub bt_connect_Click()
On Error GoTo bt_Connect_click_er
    ' try to locate ini file
    
    If Not DB.Connect(C_SERVER, C_DB, usr.Text, pwd.Text) Then
        MsgBox "Cannot connect to server. Ensure network is available or that you use a valid username and password"
        pwd = ""
        usr = C_USER
        If C_USER = "" Then
            usr.SetFocus
        Else
            pwd.SetFocus
        End If
    ElseIf C_AUTOUPGRADE Then
        If check_version Then
            Fr_user.Visible = False
            DSW_Mgr.WindowState = 2
            DSW1.Top = 0
            DSW1.Left = 0
            DSW1.Height = 11000
            DSW1.Width = 19500
            Set DSW1.DB = DB
            Dim lo_Control As OptionButton
            For Each lo_Control In lg
                If lo_Control.value Then
                    DSW1.Language = lo_Control.Tag
                    Exit For
                End If
            Next
        
            DSW1.Use_by_DSW = True
            DSW1.user_info = usr.Text
            Me.Caption = "DSW Capture Interface ver. " & App.Major & "." & App.Minor & "." & App.Revision & " (" & C_SERVER & "." & C_DB & ") [" & UCase(usr) & "]"
            usr = ""
            pwd = ""
            Call DSW1.Load_A_COM
            If UCase(usr) <> DSW1.DSW_NANME Then
                Me.Caption = "DSW Capture Interface ver. " & App.Major & "." & App.Minor & "." & App.Revision & " (" & C_SERVER & "." & C_DB & ") [" & UCase(DSW1.user_info) & "]" & " as " & DSW1.DSW_NANME
            End If
            DSW1.Visible = True
        Else
            End
        End If
    End If
Exit Sub
bt_Connect_click_er:
    DB.Disconnect
    End
End Sub

Private Function check_version() As Boolean
Dim ll_try As Integer, lb_Result As Boolean
Dim ls_req As String
Dim lJobResult As Long
 
check_version = False
ls_req = "select cfg_value from a_config where cfg_key='DSWVER' and cfg_value > '" & App.Major & "." & App.Minor & "." & App.Revision & "'"
curs = DB.OpenSQL(ls_req)
    If curs = 0 Then
        Screen.MousePointer = 0
        MsgBox "Error executing " & ls_req
        Exit Function
    End If
   If DB.RowCount(curs) > 0 Then
        Call DB.Close(curs)
        Screen.MousePointer = 0
        MsgBox "Your program will now be automatically updated with a newer version"
        Screen.MousePointer = 11
        For ll_try = 1 To 3
            If DB.BlobToFileSQL("select F_Data_file from A_Files where F_File_key ='DSW'", "C:\ARM_APPS\APOLLO_DSW\dsw_upd.exe", True) Then
                lb_Result = True
                Exit For
            End If
        Next ll_try
        If lb_Result Then
            lJobResult = RunApplication("C:\ARM_APPS\APOLLO_DSW\dsw_upd.exe")
            Screen.MousePointer = 0
            End
        Else
            Screen.MousePointer = 0
            MsgBox "This programm version C:\ARM_APPS\APOLLO_DSW\" & App.EXEName & ".exe is out of date. Please contact IT"
        End If
    Else
        Call DB.Close(curs)
        Screen.MousePointer = 0
        check_version = True
    End If
End Function

Private Function RunApplication(as_Application As String) As Long
' Specifying 1 as the second argument opens the application in
' normal size and gives it the focus.
Dim RetVal
RetVal = Shell(as_Application, 1)
End Function


Private Sub Bt_exit_Click()
DB.Disconnect
End
End Sub

Private Sub DSW1_quit()
    DB.Disconnect
    End
End Sub


Private Sub Form_Load()
#If LIVE = 1 Then
    C_SERVER = "UKDC-CAPDPRD1.apollo.local"
    C_DB = "sifyb2"
    C_USER = ""
    C_AUTOUPGRADE = True
#Else
    C_SERVER = "UKDC-CAPDEV1.apollo.local\APOLLOT"
    C_DB = "sifyb2"
    C_USER = ""
    C_AUTOUPGRADE = True
#End If
    
    ' try to locate ini
    Dim lo_IniFile As New IniFiles
    lo_IniFile.FileName = App.Path & "\config.ini"
    If lo_IniFile.OpenFile Then
        Dim ls_Data As String
        ls_Data = lo_IniFile.GetValue("CONNECTION", "SERVER")
        If ls_Data <> "" Then C_SERVER = ls_Data
        
        ls_Data = lo_IniFile.GetValue("CONNECTION", "DB")
        If ls_Data <> "" Then C_DB = ls_Data
    
        ls_Data = lo_IniFile.GetValue("CONNECTION", "USER")
        If ls_Data <> "" Then C_USER = ls_Data
    
        ls_Data = lo_IniFile.GetValue("SETTINGS", "AUTOUPGRADE")
        If ls_Data <> "" Then C_AUTOUPGRADE = (ls_Data = "TRUE")
        
        lo_IniFile.CloseFile
    End If
    
    ' parse also commandline
    Dim lv_params As Variant
    lv_params = GetValueLine(Command)
    
    If IsArray(lv_params) Then
        ls_Data = GetValue(lv_params, "DB")
        If ls_Data <> "" Then
            Dim lsa_xx() As String
            
            lsa_xx = Split(ls_Data, ":", , vbTextCompare)
            C_SERVER = lsa_xx(LBound(lsa_xx))
            If LBound(lsa_xx) <> UBound(lsa_xx) Then C_DB = lsa_xx(UBound(lsa_xx))
        End If
    End If
    

  DeleteFile ("C:\ARM_APPS\APOLLO_DSW\dsw_upd.exe")
#If LIVE = 1 Then
    If UCase(App.Path) <> "C:\ARM_APPS\APOLLO_DSW" Then
        MsgBox "Application cannot start if not running from C:\ARM_APPS\APOLLO_DSW"
        End
    End If
    
#End If
    Me.Caption = "DSW Capture Interface ver. " & App.Major & "." & App.Minor & "." & App.Revision & " (" & C_SERVER & "." & C_DB & ")"
    usr.SelText = C_USER
    pwd.Text = ""
End Sub

Private Sub Form_Unload(Cancel As Integer)
    DB.Disconnect
End Sub

Private Sub pwd_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        bt_connect_Click
    End If
End Sub

Private Function GetValue(ByRef av_params As Variant, ByVal as_Key As String) As String
    Dim ll_i As Long
    GetValue = ""
    
    For ll_i = LBound(av_params) To UBound(av_params)
        If Not IsEmpty(av_params(ll_i)) Then
            Dim lsa_row() As String
            
            lsa_row = Split(av_params(ll_i), "=", 2, vbTextCompare)
            
            If lsa_row(LBound(lsa_row)) = as_Key Then
                GetValue = lsa_row(UBound(lsa_row))
                Exit Function
            End If
        End If
    Next
End Function
