Attribute VB_Name = "Main"
Option Explicit

Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

'------------------
'promenne modulu Main
Public Cesta As String
Public CestaSoubory As String
Public MaskaN As String
Public a As Integer
Public OdpovedUzivateleNaUlozeni As Integer
Public RdsPole(1439, 2) As String
Public SouborDenniText As File
Public SouborPromo As File
Public StartOk As Boolean
Public TestEnablePocitadlo As Integer
Public IP As String
Public User As String

'------------------
'promenne modulu COM
Public OutString As String
Public OutStringStary As String
Public OutTyp As String
Public ks1 As String
Public ks2 As String
Public Cekam As Integer
Public StatusCom As String
Public Retezec As String
Public HlavickaTextu As String

'------------------
'promenne modulu Ini
Public Maska As String
Public Bafr As String
Public Delka As Integer
Public HesloSpravce As String
Public kam As String
Public ComPortIndex As Integer
Public ComRychlostIndex As Integer
Public TAPortIndex As Integer
Public TAVstupIndex As Integer
Public TAOrientace As Integer
Public TAProvoz As Integer
Public ComRychlostIndexZAL As Integer
Public ComPortIndexZAL As Integer
Public TAPortIndexZAL As Integer
Public TAOrientaceZAL As Integer
Public TAVstupIndexZAL As Integer
Public TAProvozZAL As Integer

'------------------
'promenne modulu Setup
Public ZmenaCesty As Boolean
Public ZmenaComu As Boolean
Public ZmenaTA(3) As Boolean
Public ZmenaMasky As Boolean
Public ZmenaEmailu(7) As Boolean
Public MaskaZal As String
Public CestaSouboryZal As String
Public Priorita(2) As String
Public ZmenaTestu As Boolean
Public TestZAL As Integer

'------------------
'promenne modulu Status
Public Indik As String
Public PomRetez As String
Public CisloRadku As Long
Public VysPlan(1446) As String
Public VysPromo(1447) As String
Public SouborDenniTextCasModifikace As Date
Public SouborPromoCasModifikace(5) As Date
Public SouborTextNaDnyCasModifikace As Date
Public Kpom As String
Public PocitadloZmenyModified As Integer
Public fso As New FileSystemObject

'------------------
'promenne modulu Vysilani
Public TestEnable As Boolean

'------------------
'promenne modulu Zadavani hesla
Public Anno As Boolean

'------------------
'promenne modulu TA
Public TAMaska As Integer
Public TAVstup As Integer
Public TAStav As Boolean
Public TASledovani As Boolean
Public TAZap As String
Public TAVyp As String

'------------------
'promenne modulu Email
Public EmailUsr(9, 4) As String
Public EmailServer As String
Public EmailMailFrom As String
Public EmailPredmet As String
Public EmailLogin As String
Public EmailHeslo As String
Public EmailAut As Integer
Public EmailZap As Integer


'----------------------------------------------------------
'po Load formu se hned skace tady
'----------------------------------------------------------

Public Sub Start()

    Dim i As Integer

    Cesta = App.Path
    CteniIni
    
    TestEnable = False
    ZmenaCesty = False
    ZmenaComu = False
    ZmenaMasky = False
    
    For i = 0 To 3
        ZmenaTA(i) = False
    Next i
    
    For i = 0 To 7
        ZmenaEmailu(i) = False
    Next i
    
    PocitadloZmenyModified = 0
    TestEnablePocitadlo = 0
    OutStringStary = ""
    StatusCom = ""
    TASledovani = False
    TAZap = (Chr(254) + Chr(0) + Chr(0) + Chr(0) + Chr(4) + Chr(3) + Chr(0) + Chr(0) + Chr(3) + Chr(236) + Chr(120) + Chr(255))
    TAVyp = Chr(254) + Chr(0) + Chr(0) + Chr(0) + Chr(4) + Chr(3) + Chr(0) + Chr(0) + Chr(2) + Chr(252) + Chr(89) + Chr(255)
    HlavickaTextu = Chr$(254) + Chr$(0) + Chr$(0) + Chr$(0) + Chr$(69) + Chr$(10) + Chr$(0) + Chr$(0) + Chr$(65) + Chr$(1)
    'Set Frm1.OSMTP = New OSSMTP.SMTPSession
    
    Frm1.SSTabNabidka.Width = Frm1.FraStatus.Width + 250
    Frm1.Width = Frm1.SSTabNabidka.Width + 320
 
    Frm1.SSTabNabidka.Tab = 0
    Frm1.FraForm2.Visible = False
    Frm1.FraUlozZmeny.Visible = False
    Frm1.FraERRORAdr.Visible = False
    Frm1.FraHeslo.Visible = False
    Frm1.CmdStTestOdeslat.Enabled = False
    Frm1.TxtStFlas.Enabled = False
    Frm1.ChckTestEnable.Value = 0
    
    DoEvents
    
    Pokracovani
    
End Sub


'----------------------------------------------------------
'pokud v procedure START vsechno dopadlo OK okracuje se zde
'(pokud kontrola adresarove struktury OK)
'tady
'----------------------------------------------------------

Public Sub Pokracovani()

    Dim i As Integer
    
    If (KontrolaAdresaru = True) Then
        StartOk = True
    Else
        StartOk = False
        Frm1.FraERRORAdr.Visible = True
    End If
    
    If (StartOk = True) Then
        
        ZapisSystemLog "START", ""
        
        ZapisSystemLog "Kontrola adresaru", "Kontrola adresaru probehla uspesne"
        
        If (TAProvoz = 1) Then
            ZapisSystemLog "TA Report", "TA provoz povolen"
        Else:
            ZapisSystemLog "TA Report", "TA provoz nepovolen"
        End If
        
        If (EmailZap = 1) Then
            ZapisSystemLog "EMAIL", "Odesilani emailu povoleno."
        Else
            ZapisSystemLog "EMAIL", "Odesilani emailu nepovoleno."
        End If
        
        '------------------
        'vyplneni setupu
        Frm1.TxtSetMaska = Maska
        Frm1.TxtSetCesta = CestaSoubory


        '------------------
        'inicializace COM s
        'vybranymi parametry
        InicializaceCOM
        

        '------------------
        'datum a cas do labelu
        Frm1.LblStCas.Caption = Time
        Frm1.LblStDat.Caption = Date
        Frm1.PrgBar1.Value = Second(Time)
        Frm1.LabelStBar.Caption = 60 - Second(Time) & "s"


        '------------------
        'pokud existuje soubor s dennim textem
        'zapamatujeme si cas jeho zmeny
        If (Dir(CestaSoubory & "/RDS-Texty/" & GenerujNazevSouboru(Date) + ".rds") <> "") Then
            
            Set SouborDenniText = fso.GetFile(CestaSoubory & "/RDS-Texty/" & GenerujNazevSouboru(Date) + ".rds")
            SouborDenniTextCasModifikace = SouborDenniText.DateLastModified
            
        End If
        
        
        '------------------
        'pokud existuji soubory PROMO
        'zapamatujeme si cas jejich zmen
        For i = 0 To 5
        
            If (Dir(CestaSoubory & "/RDS-Promo/RDS-Promo" & CStr(i) & "/" & GenerujNazevSouboru(Date) & "Promo" & CStr(i) & ".rds") <> "") Then
                Set SouborPromo = fso.GetFile(CestaSoubory & "/RDS-Promo/RDS-Promo" & CStr(i) & "/" & GenerujNazevSouboru(Date) & "Promo" & CStr(i) & ".rds")
                SouborPromoCasModifikace(i) = SouborPromo.DateLastModified
            End If
        
        Next i
    
        DoEvents
    
        '------------------
        'do pole nacte pres sebe - podle priorit
        'denni text a promo, tak ze vznikne jeden
        'denni spolecny seznam z ktereho se pak
        'odesilaji texty
        DataDoPole Date


        '------------------
        'naplni si pole
        'pro zobrazeni v DENNIM TEXTU
        DenniProgram Date
        
        
        '------------------
        'zobrazeni spravneho radku
        'v DENNIM TEXTU
        CisloRadku = Hour(Time) * 60 + Minute(Time)
        VysilaciPlanZobr

        DoEvents
        
        '------------------
        'pokud uz je 52vterina je uz po kompletaci
        'a radek by se neodeslal
        'timto ho jeste rychle odesleme
        If (Second(Time) > 52) Then
            DoVysilaniFlash
        End If

        
        '------------------
        'spusti se hlavni timer
        'ktery v nastavenych casech
        'kontroluje nove soubory, pripravuje
        'text a organizuje odeslani
        Frm1.Timer1.Enabled = True
        
        If (TAProvoz = 1) Then
            Frm1.Timer6.Enabled = True
        End If
        
        DoEvents
        
    End If
    

End Sub


'----------------------------------------------------------
'prevod masky
'----------------------------------------------------------

Public Function GenerujNazevSouboru(ByVal mDatum As Date)

    MaskaN = Maska

    a = InStr(MaskaN, "%d")
    If a <> 0 Then
        Mid(MaskaN, a, 2) = Prevod(Day(mDatum))
    End If

    a = InStr(MaskaN, "%m")
    If a <> 0 Then
        Mid(MaskaN, a, 2) = Prevod(Month(mDatum))
    End If

    a = InStr(MaskaN, "%yyy")
    If a <> 0 Then
        Mid(MaskaN, a, 4) = Year(mDatum)
    ElseIf (InStr(MaskaN, "%y") <> 0) Then
        Mid(MaskaN, a, 2) = Right(Year(mDatum), 2)
    End If

    GenerujNazevSouboru = MaskaN

End Function


'----------------------------------------------------------
'uprava nazvu na dvojmistny 9 -> 09 ...
'----------------------------------------------------------

Public Function Prevod(ByVal CastDat As Integer) As String

    If (CastDat < 10) Then
    
        Prevod = "0" + CStr(CastDat)
        
    Else: Prevod = CastDat
    
    End If
    
End Function


'----------------------------------------------------------
'vyber cesty
'----------------------------------------------------------

Public Sub UkazCesta()

        Frm1.FraForm2.Visible = True

    On Error GoTo chyba

        Frm1.DirCesta.Path = CestaSoubory
        Frm1.DrvDisk.Drive = Frm1.DirCesta.Path
        Frm1.TxtForm2Cesta.Text = CestaSoubory
        
    Exit Sub

chyba:
    
    Frm1.DirCesta.Path = "C:\"
    Frm1.DrvDisk.Drive = "C:\"
    Frm1.TxtForm2Cesta.Text = "C:\"
    
    Resume Next

End Sub


'----------------------------------------------------------
'ridi nacteni dat do pole
'podle zvolene priority nacte pozpatku do jednoho pole
'denni text a proma, tak ze vznikne vlastne jeden seznam dat
'----------------------------------------------------------

Public Sub DataDoPole(Dat As Date)
    
    Dim i As Integer
    
    For i = 0 To 1439
    
        RdsPole(i, 1) = ""
        RdsPole(i, 2) = ""
        
    Next i
 
    If (Priorita(0) < Priorita(1)) Then
        SpojeniProm Dat
        NactiSouborDennihoTextu Dat
        DoEvents
        
    Else
        NactiSouborDennihoTextu Dat
        SpojeniProm Dat
        DoEvents
    End If

End Sub


'----------------------------------------------------------
'nacte do pole soubor s dennim textem
'pokud neexistuje tak s nahradnim textem "NahradniText.rds"
'----------------------------------------------------------

Public Sub NactiSouborDennihoTextu(Dat As Date)
    
    Dim i As Integer
    Dim nazev As String
    Dim typ As String

    If (Dir(CestaSoubory & "/RDS-Texty/" & GenerujNazevSouboru(Dat) & ".rds") <> "") Then
        
        Open CestaSoubory & "/RDS-Texty/" & GenerujNazevSouboru(Dat) & ".rds" For Input As #12
  
            For i = 0 To 1439
                Line Input #12, RdsPole(i, 1)
                RdsPole(i, 2) = "T"
            Next i

        Close #12
    
    Else
        
        KontrolaNahradnihoTextu
        
    Select Case Weekday(Date, vbMonday)
    
        Case 1: nazev = "PondelniText"
                If (Dir(CestaSoubory & "/RDS-Texty/" & nazev & ".rds") <> "") Then
                    typ = "Po"
                Else
                    nazev = "NahradniText"
                    typ = "N"
                End If
        Case 2: nazev = "UterniText"
                If (Dir(CestaSoubory & "/RDS-Texty/" & nazev & ".rds") <> "") Then
                    typ = "Ut"
                Else
                    nazev = "NahradniText"
                    typ = "N"
                End If
        Case 3: nazev = "StredecniText"
                If (Dir(CestaSoubory & "/RDS-Texty/" & nazev & ".rds") <> "") Then
                    typ = "St"
                Else
                    nazev = "NahradniText"
                    typ = "N"
                End If
        Case 4: nazev = "CtvrtecniText"
                If (Dir(CestaSoubory & "/RDS-Texty/" & nazev & ".rds") <> "") Then
                    typ = "Ct"
                Else
                    nazev = "NahradniText"
                    typ = "N"
                End If
        Case 5: nazev = "PatecniText"
                If (Dir(CestaSoubory & "/RDS-Texty/" & nazev & ".rds") <> "") Then
                    typ = "Pa"
                Else
                    nazev = "NahradniText"
                    typ = "N"
                End If
        Case 6: nazev = "SobotniText"
                If (Dir(CestaSoubory & "/RDS-Texty/" & nazev & ".rds") <> "") Then
                    typ = "So"
                Else
                    nazev = "NahradniText"
                    typ = "N"
                End If
        Case 7: nazev = "NedelniText"
                If (Dir(CestaSoubory & "/RDS-Texty/" & nazev & ".rds") <> "") Then
                    typ = "Ne"
                Else
                    nazev = "NahradniText"
                    typ = "N"
                End If
           
    End Select
        
        Open CestaSoubory & "\RDS-Texty\" & nazev & ".rds" For Input As #12
  
            For i = 0 To 1439
                Line Input #12, RdsPole(i, 1)
                RdsPole(i, 2) = typ
            Next i

        Close #12

    End If

End Sub


'----------------------------------------------------------
'nacte do pole soubory PROMO
'v produkci uz je osetreno ze by na stejny cas nemelo existovat
'vice dat
'----------------------------------------------------------

Public Sub SpojeniProm(Dat As Date)

    Dim j As Integer
    Dim i As Integer
    Dim Ppom As String

    For j = 1 To 5
    
        If (Dir(CestaSoubory & "/RDS-Promo/RDS-Promo" & CStr(j) & "/" & GenerujNazevSouboru(Dat) & "Promo" & CStr(j) & ".rds") <> "") Then

            Open CestaSoubory & "/RDS-Promo/RDS-Promo" & CStr(j) & "/" & GenerujNazevSouboru(Dat) & "Promo" & CStr(j) & ".rds" For Input As #13
   
                For i = 1 To 1440
  
                    Line Input #13, Ppom
                    
                    If (Ppom <> "") Then
                        RdsPole(i, 1) = Ppom
                        RdsPole(i, 2) = "P"
                    End If
                    
                Next i

            Close #13

        End If
    
        DoEvents
    
    Next j
    
    
End Sub


'----------------------------------------------------------
'pri startu se tady kontroluje jestli je uplna pozadovana
'adresarova struktura
'----------------------------------------------------------

Public Function KontrolaAdresaru() As Boolean

On Error GoTo chybaAdr

    If (Dir(CestaSoubory & "\RDS-Promo\RDS-Promo1", vbDirectory) = "") Then GoTo chyba
    If (Dir(CestaSoubory & "\RDS-Promo\RDS-Promo2", vbDirectory) = "") Then GoTo chyba
    If (Dir(CestaSoubory & "\RDS-Promo\RDS-Promo3", vbDirectory) = "") Then GoTo chyba
    If (Dir(CestaSoubory & "\RDS-Promo\RDS-Promo4", vbDirectory) = "") Then GoTo chyba
    If (Dir(CestaSoubory & "\RDS-Promo\RDS-Promo5", vbDirectory) = "") Then GoTo chyba
    If (Dir(CestaSoubory & "\RDS-Logy", vbDirectory) = "") Then GoTo chyba
    If (Dir(CestaSoubory & "\RDS-Texty", vbDirectory) = "") Then GoTo chyba
    If (Dir(CestaSoubory & "\RDS-Logy\Odvysilano\TA", vbDirectory) = "") Then GoTo chyba
    If (Dir(CestaSoubory & "\RDS-Logy\Odvysilano\Texty", vbDirectory) = "") Then GoTo chyba
    If (Dir(CestaSoubory & "\RDS-Logy\Odvysilano\Promo", vbDirectory) = "") Then GoTo chyba
    If (Dir(CestaSoubory & "\RDS-Logy\Upravovano\Texty", vbDirectory) = "") Then GoTo chyba
    If (Dir(CestaSoubory & "\RDS-Logy\Upravovano\Promo", vbDirectory) = "") Then GoTo chyba
    If (Dir(CestaSoubory & "\RDS-Logy\SystemLog", vbDirectory) = "") Then GoTo chyba
    If (Dir(CestaSoubory & "\RDSEdit.Ini") = "") Then GoTo chyba

    KontrolaNahradnihoTextu
    
    KontrolaAdresaru = True

    Exit Function
    
chyba:
    
    If (Dir(CestaSoubory & "\RDS-Logy\SystemLog\" & GenerujNazevSouboru(Date) & "_Sys.rds") <> "") Then
        ZapisSystemLog "Kontrola adresaru", "ERROR - Chyba v adresarove strukture!!!"
    End If
    
    KontrolaAdresaru = False
    OdesliEmail "RDSManager Error", 1, "Chyba v adresarove strukture!!"
    
chybaAdr:

    KontrolaAdresaru = False
    OdesliEmail "RDSManager Error", 1, "Chyba v adresarove strukture!!"

End Function


'----------------------------------------------------------
'priprava a zapis do systemoveho LOGu
'(tady se skoci pri kteremkoliv zapisu do system LOGu)
'----------------------------------------------------------

Public Sub ZapisSystemLog(typ As String, Problem As String)
    
    Dim sTmp1$

    'zjistime prihlaseneho uzivatele
    sTmp1 = Space$(512)
    GetUserName sTmp1, Len(sTmp1)
    User = Trim$(sTmp1)
        
    'zjistime IPadresu
    IP = Frm1.IPSensor.LocalIP


    'podle toho z jakym parametrem - pri jake udalosti
    'tuto proceduru volame, takovy typ zapisu se zvoli
    
    Open CestaSoubory & "\RDS-Logy\SystemLog\" & GenerujNazevSouboru(Date) & "_Sys.rds" For Append As #17
    
        If (typ = "START") Then
    
            Print #17, "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
            Print #17,
            Print #17, "DATUM A CAS: " & Format(Date, "yyyy-mm-dd ") & Format(Time, "hh:mm:ss ")
            Print #17, "IP ADRESA: " & IP
            Print #17, "Windows USER: " & User
            Print #17,
            Print #17, "PROGRAM " & typ
            Print #17,
        
        Else

            Print #17, vbTab & vbTab & "-----------------------------------------------"
            Print #17, vbTab & vbTab & "DATUM A CAS: " & Format(Date, "yyyy-mm-dd ") & Format(Time, "hh:mm:ss ")
            Print #17, vbTab & vbTab & typ
            Print #17, vbTab & vbTab & Problem
            
            Print #17, vbTab & vbTab & "-----------------------------------------------"
            Print #17,
    
        End If
        
    Close #17
    
    DoEvents

End Sub


'----------------------------------------------------------
'kontrola existence a vyber novejsiho nahradniho textu
'----------------------------------------------------------

Public Sub KontrolaNahradnihoTextu()

    Dim fl As File
    Dim fil As File
    
    If (Dir(CestaSoubory & "/RDS-Texty/" & "NahradniText.rds") = "") Then
        FileCopy Cesta & "/NahradniText.rds", CestaSoubory & "/RDS-Texty/NahradniText.rds"
    End If
    
    Set fil = fso.GetFile(CestaSoubory & "/RDS-Texty/" & "NahradniText.rds")
    Set fl = fso.GetFile(Cesta & "/NahradniText.rds")
    
    If (fil.DateLastModified > fl.DateLastModified) Then
        FileCopy CestaSoubory & "/RDS-Texty/NahradniText.rds", Cesta & "/NahradniText.rds"
    End If

End Sub
