Imports System.IO
Imports OSSMTP
Imports VBA

Module Module1
    Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal HINet As Integer) As Integer
    Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Integer, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Integer) As Integer
    Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Integer, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Integer, ByVal lFlags As Integer, ByVal lContext As Integer) As Integer
    Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hFtpSession As Integer, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Integer, ByVal dwFlags As Integer, ByVal dwContext As Integer) As Boolean
    Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hFtpSession As Integer, ByVal lpszLocalFile As String, ByVal lpszRemoteFile As String, ByVal dwFlags As Integer, ByVal dwContext As Integer) As Boolean

    Public strError As String

    Sub Main()
        Dim FTPIP As String
        Dim FTPUSERNAME As String
        Dim FTPPASSWORD As String
        Dim FTPDIRECTORY As String
        Dim SMTPIP As String
        Dim SMTPUSERNAME As String
        Dim SMTPPASSWORD As String
        Dim SMTPFROM As String
        Dim SMTPTO As String
        Dim SMTPCC As String
        Dim DAILYDIRECTORY As String
        Dim ARCHIVEDIRECTORY As String
        Dim BACKUPDIRECTORY As String
        Dim LFUSER As String
        Dim LOGFILE As String = "logs/" & Date.Now.ToString("yyyy") & "/" & Date.Now.ToString("MM") & "/" & Date.Now.ToString("yyyyMMdd") & ".txt"
        Dim errors As Integer

        Dim finfo As New System.IO.FileInfo(LOGFILE)
        Dim dir As System.IO.DirectoryInfo = finfo.Directory
        If Not dir.Exists Then
            dir.Create()
        End If

        If File.Exists(LOGFILE) Then
            File.Delete(LOGFILE)
        End If
        Try
            strError = "Start time:" & vbCrLf & vbCrLf & Now & vbCrLf

            FTPIP = "10.20.35.5"
            FTPUSERNAME = "webftp"
            FTPPASSWORD = "webftp"
            FTPDIRECTORY = "/documents/D83/tiffs/"
            SMTPIP = "some@user.com"
            SMTPUSERNAME = "username"
            SMTPPASSWORD = "password"
            LFUSER = "No"
            SMTPFROM = "user@user.com"
            SMTPTO = "someone@somewhere.com"
            DAILYDIRECTORY = "C:\DCDocs\Daily\"
            ARCHIVEDIRECTORY = "C:\DCDocs\Archive\"
            BACKUPDIRECTORY = "F:\Backup\"

            If File.Exists("dcendofday.ini") Then
                Dim delimStr As String = "="
                Dim delimiter As Char() = delimStr.ToCharArray()
                Dim sr As System.io.StreamReader = New System.io.StreamReader("dcendofday.ini")
                Do While sr.Peek() >= 0
                    Dim a() As String
                    a = sr.ReadLine.Split(delimiter)
                    'Console.WriteLine("+" & a(0) & "+" & a(1) & "+")
                    If a(0).ToUpper = "FTPIP" And a(1) <> "" Then
                        FTPIP = a(1)
                    ElseIf a(0).ToUpper = "FTPUSERNAME" And a(1) <> "" Then
                        FTPUSERNAME = a(1)
                    ElseIf a(0).ToUpper = "FTPPASSWORD" And a(1) <> "" Then
                        FTPPASSWORD = a(1)
                    ElseIf a(0).ToUpper = "FTPDIRECTORY" And a(1) <> "" Then
                        If a(1).Substring(a(1).Length - 1, 1) <> "/" Then
                            a(1) = a(1) & "/"
                        End If
                        If a(1).Substring(0, 1) <> "/" Then
                            a(1) = "/" & a(1)
                        End If
                        FTPDIRECTORY = a(1)
                    ElseIf a(0).ToUpper = "SMTPFROM" And a(1) <> "" Then
                        SMTPFROM = a(1)
                    ElseIf a(0).ToUpper = "SMTPTO" And a(1) <> "" Then
                        SMTPTO = a(1)
                    ElseIf a(0).ToUpper = "SMTPCC" And a(1) <> "" Then
                        SMTPCC = a(1)
                    ElseIf a(0).ToUpper = "DAILYDIRECTORY" And a(1) <> "" Then
                        If a(1).Substring(a(1).Length - 1, 1) = "\" Then
                            DAILYDIRECTORY = a(1)
                        Else
                            DAILYDIRECTORY = a(1) & "\"
                        End If
                    ElseIf a(0).ToUpper = "ARCHIVEDIRECTORY" And a(1) <> "" Then
                        If a(1).Substring(a(1).Length - 1, 1) = "\" Then
                            ARCHIVEDIRECTORY = a(1)
                        Else
                            ARCHIVEDIRECTORY = a(1) & "\"
                        End If
                    ElseIf a(0).ToUpper = "BACKUPDIRECTORY" And a(1) <> "" Then
                        If a(1).Substring(a(1).Length - 1, 1) = "\" Then
                            BACKUPDIRECTORY = a(1)
                        Else
                            BACKUPDIRECTORY = a(1) & "\"
                        End If
                    ElseIf a(0).ToUpper = "LFUSER" And a(1) <> "" Then
                        LFUSER = a(1)
                    End If
                Loop
                sr.Close()
            End If

            strError = strError & vbCrLf & "Parameters:" & vbCrLf & vbCrLf & "FTPIP = " & FTPIP & vbCrLf & "FTPUSERNAME = " & FTPUSERNAME & vbCrLf & "FTPPASSWORD = " & FTPPASSWORD & vbCrLf & "FTPDIRECTORY = " & FTPDIRECTORY & vbCrLf & "LFUSER = " & LFUSER & vbCrLf & "SMTPFROM = " & SMTPFROM & vbCrLf & "SMTPTO = " & SMTPTO & vbCrLf & "SMTPCC = " & SMTPCC & vbCrLf & "DAILYDIRECTORY = " & DAILYDIRECTORY & vbCrLf & "ARCHIVEDIRECTORY = " & ARCHIVEDIRECTORY & vbCrLf & "BACKUPDIRECTORY = " & BACKUPDIRECTORY & vbCrLf & vbCrLf & "File copy/FTP process:" & vbCrLf

            Dim INet, INetConn As Integer
            Dim RC As Boolean
            Dim resFile As String = ""
            INet = InternetOpen("FTP Connection", 1, vbNullString, vbNullString, 0)
            INetConn = InternetConnect(INet, FTPIP, 21, FTPUSERNAME, FTPPASSWORD, 1, 0, 0)

            Dim x As Integer
            Dim y As Integer
            Dim z As Integer

            Dim Directory As New System.IO.DirectoryInfo(DAILYDIRECTORY)
            Dim file1 As System.IO.FileInfo
            For Each file1 In Directory.GetFiles
                If file1.Extension.ToLower.ToString = ".tiff" Or file1.Extension.ToLower.ToString = ".tif" Then
                    x = x + 1
                End If
            Next
            If x = 0 Then
                strError = strError & vbCrLf & "Warning: No TIFF files were found in " & DAILYDIRECTORY & vbCrLf
            Else
                strError = strError & vbCrLf & "Found " & x & " files in " & DAILYDIRECTORY & vbCrLf
            End If

            For Each file1 In Directory.GetFiles
                If file1.Extension.ToLower.ToString = ".tiff" Or file1.Extension.ToLower.ToString = ".tif" Then
                    strError = strError & vbCrLf & "Trying FTP: " & DAILYDIRECTORY + file1.Name & " to " & FTPDIRECTORY
                    RC = FtpPutFile(INetConn, DAILYDIRECTORY + file1.Name, FTPDIRECTORY + file1.Name, False, 0)
                    If RC = True Then
                        y = y + 1
                        strError = strError & " - success." & vbCrLf
                        If LFUSER.ToLower <> "yes" Then
                            strError = strError & "Trying copy: " & DAILYDIRECTORY + file1.Name & " to " & ARCHIVEDIRECTORY

                            file1.CopyTo(ARCHIVEDIRECTORY + file1.Name, True)

                            If File.Exists(ARCHIVEDIRECTORY + file1.Name) Then
                                strError = strError & " - success." & vbCrLf
                            Else
                                strError = strError & " - failure." & vbCrLf
                                errors = 1
                            End If

                            strError = strError & "Trying move: " & DAILYDIRECTORY + file1.Name & " to " & BACKUPDIRECTORY

                            If File.Exists(BACKUPDIRECTORY + file1.Name) Then
                                File.Delete(BACKUPDIRECTORY + file1.Name)
                            End If

                            file1.MoveTo(BACKUPDIRECTORY + file1.Name)

                            If File.Exists(BACKUPDIRECTORY + file1.Name) Then
                                strError = strError & " - success." & vbCrLf
                            Else
                                strError = strError & " - failure." & vbCrLf
                                errors = 1
                            End If
                        Else
                            strError = strError & "Trying delete: " & DAILYDIRECTORY + file1.Name

                            If File.Exists(DAILYDIRECTORY + file1.Name) Then
                                File.Delete(DAILYDIRECTORY + file1.Name)
                            End If
                            If File.Exists(DAILYDIRECTORY + file1.Name) Then
                                strError = strError & " - failure." & vbCrLf
                            Else
                                strError = strError & " - success." & vbCrLf
                            End If
                        End If
                    Else
                        strError = strError & " - failure." & vbCrLf
                        errors = 1
                    End If
                End If
            Next

            InternetCloseHandle(INetConn)
            InternetCloseHandle(INet)

            If x > y Then
                strError = strError & vbCrLf & "Error: " & x - y & " files failed to be sent." & vbCrLf
            ElseIf x > 0 Then
                strError = strError & vbCrLf & "Success: All files sent successfully." & vbCrLf
            End If

            strError = strError & vbCrLf & "End time:" & vbCrLf & vbCrLf & Now & vbCrLf

            If errors > 0 Then
                Dim oSMTP As OSSMTP.SMTPSession
                oSMTP = New OSSMTP.SMTPSession
                Dim objAttachment As New OSSMTP.Attachment
                objAttachment.AttachmentName = "dc.ini"
                objAttachment.ContentTransferEncoding = encoding_type.enc7Bit
                objAttachment.FilePath = "dc.ini"
                oSMTP.Attachments.Add(objAttachment)
                With oSMTP
                    .Server = SMTPIP
                    .AuthenticationType = authentication_type.AuthLogin
                    .Username = SMTPUSERNAME
                    .Password = SMTPPASSWORD
                    .MailFrom = SMTPFROM
                    .SendTo = SMTPTO
                    If SMTPCC <> "" Then
                        .CC = SMTPFROM & "," & SMTPCC
                    Else
                        .CC = SMTPFROM
                    End If
                    .MessageSubject = "DC End Of Day Error report for " & Date.Now.ToString("MM/dd/yyyy")
                    .MessageText = strError
                    .SendEmail()
                End With
                oSMTP = Nothing
            Else
                If x > 0 Then
                    Dim oSMTP As OSSMTP.SMTPSession
                    oSMTP = New OSSMTP.SMTPSession
                    With oSMTP
                        .Server = SMTPIP
                        .AuthenticationType = authentication_type.AuthLogin
                        .Username = SMTPUSERNAME
                        .Password = SMTPPASSWORD
                        .MailFrom = SMTPFROM
                        .SendTo = SMTPFROM
                        If SMTPCC <> "" Then
                            .CC = SMTPCC
                        End If
                        .MessageSubject = "DC End Of Day Success report for " & Date.Now.ToString("MM/dd/yyyy")
                        .MessageText = strError
                        .SendEmail()
                    End With
                    oSMTP = Nothing
                Else
                    Dim oSMTP As OSSMTP.SMTPSession
                    oSMTP = New OSSMTP.SMTPSession
                    With oSMTP
                        .Server = SMTPIP
                        .AuthenticationType = authentication_type.AuthLogin
                        .Username = SMTPUSERNAME
                        .Password = SMTPPASSWORD
                        .MailFrom = SMTPFROM
                        .SendTo = SMTPFROM
                        If SMTPCC <> "" Then
                            .CC = SMTPCC
                        End If
                        .MessageSubject = "DC End Of Day Warning report for " & Date.Now.ToString("MM/dd/yyyy")
                        .MessageText = strError
                        .SendEmail()
                    End With
                    oSMTP = Nothing
                End If
            End If

            Dim sr1 As New StreamWriter(LOGFILE)
            sr1.Write(strError)
            sr1.Close()

        Catch ex As Exception
            If ex.InnerException Is Nothing Then
                strError = strError & vbCrLf & "Exception: " & ex.Message.ToString & vbCrLf
            Else
                strError = strError & vbCrLf & "Exception: " & ex.Message.ToString & vbCrLf & "Inner Exception: " & ex.InnerException.ToString & vbCrLf
            End If
            strError = strError & vbCrLf & "End time:" & vbCrLf & vbCrLf & Now & vbCrLf
            Dim sr3 As New StreamWriter(LOGFILE)
            sr3.Write(strError)
            sr3.Close()
            Dim oSMTP As OSSMTP.SMTPSession
            oSMTP = New OSSMTP.SMTPSession
            Dim objAttachment As New OSSMTP.Attachment
            objAttachment.AttachmentName = "dcendofday.ini"
            objAttachment.ContentTransferEncoding = encoding_type.enc7Bit
            objAttachment.FilePath = "dcendofday.ini"
            oSMTP.Attachments.Add(objAttachment)
            With oSMTP
                .Server = SMTPIP
                .AuthenticationType = authentication_type.AuthLogin
                .Username = SMTPUSERNAME
                .Password = SMTPPASSWORD
                .MailFrom = SMTPFROM
                .SendTo = SMTPTO
                If SMTPCC <> "" Then
                    .CC = SMTPFROM & "," & SMTPCC
                Else
                    .CC = SMTPFROM
                End If
                .MessageSubject = "DC End Of Day Error report for " & Date.Now.ToString("MM/dd/yyyy")
                .MessageText = strError
                .SendEmail()
            End With
            oSMTP = Nothing
        End Try
    End Sub
End Module