VERSION 5.00
Begin VB.Form frm_Login 
   BackColor       =   &H00FFFFC0&
   Caption         =   "Login"
   ClientHeight    =   8160
   ClientLeft      =   390
   ClientTop       =   660
   ClientWidth     =   10680
   Icon            =   "LOGIN.frx":0000
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   8160
   ScaleWidth      =   10680
   WindowState     =   2  'Maximized
   Begin VB.PictureBox Pic_Login 
      BackColor       =   &H0080FFFF&
      Height          =   1632
      Left            =   3600
      ScaleHeight     =   1575
      ScaleWidth      =   3015
      TabIndex        =   12
      TabStop         =   0   'False
      Top             =   3240
      Width           =   3072
      Begin VB.ComboBox cbo_language 
         Height          =   288
         Left            =   1320
         Style           =   2  'Dropdown List
         TabIndex        =   1
         Top             =   780
         Width           =   1572
      End
      Begin VB.CommandButton cmd_cancel 
         Caption         =   "Cancel"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   -1  'True
            Strikethrough   =   0   'False
         EndProperty
         Height          =   372
         Left            =   180
         TabIndex        =   3
         Top             =   1200
         Width           =   1152
      End
      Begin VB.CommandButton cmd_connect 
         Caption         =   "Connect"
         Default         =   -1  'True
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   -1  'True
            Strikethrough   =   0   'False
         EndProperty
         Height          =   372
         Left            =   1500
         TabIndex        =   2
         Top             =   1200
         Width           =   1272
      End
      Begin VB.TextBox txt_Pwd 
         Height          =   288
         IMEMode         =   3  'DISABLE
         Left            =   1320
         PasswordChar    =   "*"
         TabIndex        =   0
         Top             =   420
         Width           =   1572
      End
      Begin VB.TextBox txt_User 
         Height          =   288
         Left            =   1320
         MaxLength       =   30
         TabIndex        =   4
         Top             =   60
         Width           =   1572
      End
      Begin VB.Label lbl_Language 
         AutoSize        =   -1  'True
         BackColor       =   &H0080FFFF&
         Caption         =   " Language : "
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Left            =   120
         TabIndex        =   15
         Top             =   780
         Width           =   1308
      End
      Begin VB.Label lbl_Pwd 
         AutoSize        =   -1  'True
         BackColor       =   &H0080FFFF&
         Caption         =   " Password :  "
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Left            =   120
         TabIndex        =   14
         Top             =   420
         Width           =   1344
      End
      Begin VB.Label lbl_User 
         AutoSize        =   -1  'True
         BackColor       =   &H0080FFFF&
         Caption         =   " Username : "
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Left            =   120
         TabIndex        =   13
         Top             =   60
         Width           =   1332
      End
   End
   Begin VB.CommandButton btn_Screen 
      Height          =   192
      Left            =   1440
      TabIndex        =   11
      TabStop         =   0   'False
      Top             =   720
      Width           =   732
   End
   Begin VB.CommandButton btn_Version 
      Height          =   192
      Left            =   1440
      TabIndex        =   10
      TabStop         =   0   'False
      Top             =   480
      Width           =   732
   End
   Begin VB.CommandButton btn_Bits 
      Height          =   192
      Left            =   1440
      TabIndex        =   9
      TabStop         =   0   'False
      Top             =   240
      Width           =   732
   End
   Begin VB.CommandButton btn_Plus 
      Height          =   192
      Left            =   1080
      TabIndex        =   8
      TabStop         =   0   'False
      Top             =   240
      Width           =   252
   End
   Begin VB.CommandButton btn_Server 
      Height          =   192
      Left            =   240
      TabIndex        =   7
      TabStop         =   0   'False
      Top             =   720
      Width           =   732
   End
   Begin VB.CommandButton btn_Language 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Height          =   192
      Left            =   240
      TabIndex        =   6
      TabStop         =   0   'False
      Top             =   480
      Width           =   732
   End
   Begin VB.CommandButton btn_Date 
      Height          =   192
      Left            =   240
      TabIndex        =   5
      TabStop         =   0   'False
      Top             =   240
      Width           =   732
   End
   Begin VB.Timer timer 
      Interval        =   60000
      Left            =   0
      Top             =   4440
   End
   Begin VB.Image Image1 
      Height          =   1755
      Left            =   240
      Stretch         =   -1  'True
      Top             =   120
      Width           =   3255
   End
End
Attribute VB_Name = "frm_Login"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Public Sub GetTraceUser()
Dim ls_req As String
Dim ll_Statement As Long
Dim li_Status As Integer

    On Error GoTo suite
    
    ls_req = "SELECT trace_user FROM Security_Identity WHERE login_name = '" & prg.LoginName & "'"
    If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
        li_Status = SQL_SUCCESS
        Do While li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO
            li_Status = SQLFetch(ll_Statement)
            If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
                gs_TraceUser = ODBCData(ll_Statement, 1)
            End If
        Loop
    End If
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    Exit Sub
    
suite:
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Sub

Private Sub cmd_Cancel_Click()

    MouseOn
    End

End Sub

Private Sub cmd_connect_Click()
Dim ls_Connect As String
Dim ls_Section As String
Dim ls_DSN As String
Dim ls_DataBase As String
Dim li_Status As Integer
Dim ls_language As String
Dim lo_Registry As New Registry
    
    On Error GoTo suite
    
    MouseOff
    
    prg.LoginName = UCase(txt_User.Text)
    prg.U_PWD = txt_Pwd.Text
    
If Not get_login_info Then
    'ADB.Disconnect
    'Set ADB = Nothing
    'End
    Screen.MousePointer = 0
    MsgBox "Cannot connect, please check username and password"
    txt_Pwd = ""
    txt_Pwd.SetFocus
    
    MouseOn
    Exit Sub
End If

aDb.Disconnect
If Not get_armsyscom_connection Then
    If Not aDb Is Nothing Then
    If aDb.IsConnected Then aDb.Disconnect
    Set aDb = Nothing
    End If
    If Not adb_err Is Nothing Then
    If adb_err.IsConnected Then adb_err.Disconnect
    Set adb_err = Nothing
    
    End If
    
    
    End
End If
    
li_Status = ODBCConnection
       
If Not li_Status Then
    If aDb.IsConnected Then aDb.Disconnect
    If adb_err.IsConnected Then adb_err.Disconnect
    Set aDb = Nothing
    Set adb_err = Nothing
    
    End
End If
    
    
    
    Select Case li_Status
        Case OK
            
            If cbo_language.ListIndex = -1 Then
                ls_language = "English"
            Else
                ls_language = cbo_language.Text
            End If

            cmd_connect.Enabled = KO
            cmd_cancel.Enabled = KO
    
            lo_Registry.RootKey = HKEY_CURRENT_USER
            lo_Registry.CreateSubKey REG_APP_NAME & REG_APP_OPTION, OK
            
            lo_Registry.CreateValue REG_PREF_LANGUAGE, cbo_language.Text, REG_SZ
            lo_Registry.CreateValue REG_DEFAULT_LOGIN, UCase(txt_User), REG_SZ
            

            GetLanguage ls_language
            
            'Indicates the connection environment
            GetEnvironment
            
            'We are connected
            gb_Connected = OK
            
            'No more timer
            Timer.Enabled = 0
            
            GetTraceUser
            WriteUserEvent "Login"
            
            aDb.CacheDir = prg.AppCache_Dir & "\capture"
            aDb.CacheCheckProc = "exec cache_procedure_sel3 ?,?"
            aDb.CacheSelectProc = "exec cache_procedure_lst"
            aDb.UseCache = True

            
            FrmMain.show
            Unload Me
        Case KO
            'There was a problem
            txt_Pwd = ""
            txt_Pwd.SetFocus
        
        Case TRY_COUNT
            'Too many try
            Unload Me
    End Select
    
    MouseOn
    
    Exit Sub
    
suite:
   StdError
    cmd_connect.Enabled = OK
    cmd_cancel.Enabled = OK
End Sub


Private Sub Form_Load()

Dim i As Integer
Dim ls_Section As String
Dim ls_Key As String
Dim ls_Result As String

    'We read the background picture
    If Dir(App.Path & "\laby.bmp") = "LABY.BMP" Then
        Image1.Picture = LoadPicture(App.Path & "\laby.bmp")
    End If
    
    'We read in the Ini File the list of available language
    For i = 0 To UBound(gs_Language, 2) - 1
        cbo_language.AddItem gs_Language(1, i), cbo_language.ListCount
    Next
    
    'We affect the prefered language
    If gs_PreferedLanguage <> "" Then
    For i = 0 To cbo_language.ListCount - 1
    cbo_language.ListIndex = i
    If gs_PreferedLanguage = cbo_language Then
    prg.Session_language = gs_PreferedLanguage
    prg.Session_language_Code = gs_Language(0, i)
    Exit For
        'cbo_language = gs_PreferedLanguage
    End If
        Next i
    End If
    If cbo_language.ListIndex = -1 Then
    cbo_language.ListIndex = 0
    prg.Session_language = gs_Language(1, 0)
    prg.Session_language_Code = gs_Language(0, 0)
    End If
    'We affect the default login
    txt_User = gs_DefaultLogin

    MouseOn

End Sub

Private Sub Form_Resize()
    FillButtons
End Sub

Private Sub Timer_Timer()

    btn_Date.Caption = Format(Now, "Short Date") & "    " & Format(Now, "Short Time")

End Sub
Private Sub FillButtons()
Dim li_Width As Integer
Dim li_Height As Integer
Dim li_top As Integer
Dim i As Integer

    'If the form is minimized, we make nothing
    If frm_Login.WindowState = 1 Then Exit Sub
    
    'If the form is too little, we resize it
    If Me.Width < 5000 Then Me.Width = 5000
    If Me.Height < 4000 Then Me.Height = 4000

    'Calcul of the button size
    li_Width = CInt(Me.ScaleWidth / 6.2)
    li_Height = 500
    li_top = Me.ScaleHeight - li_Height
    
    'We center the login panel
    Pic_Login.Left = CInt(Me.Width - Pic_Login.Width) / 2
    Pic_Login.Top = CInt(Me.Height - li_Height - Pic_Login.Height) / 2
    
    
    btn_Date.Width = li_Width
    btn_Date.Height = li_Height
    btn_Date.Left = 0
    btn_Date.Top = li_top
    btn_Date.Caption = Format(Now, "Short Date") & "    " & Format(Now, "Short Time")
    
    btn_Language.Width = li_Width
    btn_Language.Height = li_Height
    btn_Language.Left = li_Width
    btn_Language.Top = li_top
    
    btn_Server.Width = li_Width
    btn_Server.Height = li_Height
    btn_Server.Left = 2 * li_Width - 1
    btn_Server.Top = li_top
    
    btn_Plus.Width = li_Width / 5
    btn_Plus.Height = li_Height
    btn_Plus.Left = 3 * li_Width - 1
    btn_Plus.Top = li_top
    btn_Plus.Caption = "+"
    
    btn_Bits.Width = li_Width
    btn_Bits.Height = li_Height
    btn_Bits.Left = 3.2 * li_Width - 1
    btn_Bits.Top = li_top
    btn_Bits.Caption = Environment
    
    btn_Version.Width = li_Width
    btn_Version.Height = li_Height
    btn_Version.Left = 4.2 * li_Width - 1
    btn_Version.Top = li_top
    btn_Version.Caption = "Version : " & App.Major & "." & App.Minor & "." & App.Revision & IIf(prg.WTS, " - TS", "")
    
    btn_Screen.Width = Me.ScaleWidth - (5.2 * li_Width)
    btn_Screen.Height = li_Height
    btn_Screen.Left = 5.2 * li_Width - 1
    btn_Screen.Top = li_top
    btn_Screen.Caption = App.ProductName
    
    Image1.Top = Me.ScaleTop
    Image1.Left = Me.ScaleLeft
    Image1.Width = Me.ScaleWidth
    Image1.Height = li_top
End Sub

Public Sub GetEnvironment()
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ls_req As String
Dim ls_Field As String
Dim ls_Text As String

    On Error GoTo suite
    
    ls_req = "SELECT DI_code, DI_desc FROM Database_Info WHERE DI_code IN ('SIFYB', 'ENV', 'SERVER', 'DB')"
    If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
        li_Status = SQL_SUCCESS
        Do While li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO
            li_Status = SQLFetch(ll_Statement)
            If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
                ls_Field = ODBCData(ll_Statement, 1)
                ls_Text = ODBCData(ll_Statement, 2)
                Select Case ls_Field
                Case "SIFYB"
                    If App.Major & App.Minor & App.Revision < ls_Text Then
                        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
                        SendMessage 61, "The version of your soft is not compatible with the database any more. Please contact your system administrator.", gut_LangLogin.Code
                        ls_req = "EXEC Error_Log_Insert '" _
                            & App.EXEName & "', '" _
                            & App.Major & "." & App.Minor & "." & App.Revision _
                            & "', 'Login request to a database version " & ls_Text & "', '" _
                            & 9999 & "', '                                                VIRTUAL ERROR : attempt to logon with an obsolete version' "
                        li_Status = SQLSubmitError(gl_Database, ls_req)
                        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
                        ODBCDataClose gl_Environment, gl_Database
                        End
                    End If
                Case "ENV"
                    gl_DataBaseType = ls_Text
                End Select
            End If
        Loop
    End If
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    Select Case gl_DataBaseType
    Case "DEVEL ENV."
'        SendMessage 94, "WARNING : you are working with developpement environment.", gut_LangLogin.Code
    Case "TEMP ENV."
        SendMessage 57, "WARNING : you are working with test environment.", gut_LangLogin.Code
    Case "PROD ENV."
        'We make nothing
    Case Else
        SendMessage 58, "WARNING : you are working with unregistered environment.", gut_LangLogin.Code
    End Select
    
    Exit Sub

suite:
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Sub

Public Sub GetLanguage(ls_language As String)
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ls_req As String

    On Error GoTo suite
    
    ls_req = "EXEC Language_sel2 '" & ls_language & "'"
    If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
        li_Status = SQLFetch(ll_Statement)
        If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
            gut_LangLogin.Code = ODBCData(ll_Statement, 1)
            gut_LangLogin.Desc = ODBCData(ll_Statement, 2)
            gut_LangLogin.Icon = ODBCData(ll_Statement, 3)
            gl_CodePage = Val(ODBCData(ll_Statement, 4))
        End If
    Else
        gut_LangLogin.Code = "E"
        gut_LangLogin.Desc = "English"
        gut_LangLogin.Icon = 15
    End If
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    Exit Sub
    
suite:
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Sub
