Attribute VB_Name = "A_Main"
Option Explicit
' -------------------------------------------------------------------------------------------------------------------------------------
' Software for filtering or renaming certain datasheet files for the Dataforth website. "Encoded" datasheet file names of a certain
' format are renamed, while datasheet file names that are invalid for the website are "filtered" by moving them out of the directory
' that is used for datasheets for the website. An external file is used to store the directory names of the main datasheet directory
' and the "filtered" datasheet files directory. The "filtered" files are moved to the "filtered" directory, rather than simply
' deleted, since they are sometimes used for test system debug or qualification.
' -------------------------------------------------------------------------------------------------------------------------------------
'
' The following constant sets the name of the program version that it printed out in the data (CSV file) test report file.
Public Const PROGRAM_NAME = "DFWDS"
Public Const PROGRAM_DESCRIP = "Dataforth Website Datasheet Program"
Public Const PROGRAM_VERSION = "DFWDS_2014_09_24"

' -------------------------------------------------------------------------------------------------------------------------------------
' AUTHORS:          Paul Reese
' DATE:             2014/09/24
' EXECUTABLE:       DFWDS.exe               = Executable program file.
' CODE PROJECT:     DFWDS.vbp               = Visual Basic project file.
' CODE MODULES:     DFWDS.bas               = this file, main code module.
' VB FORMS:         frmDBselect.frm         = form to select directory and .DAT file for model database.
'                   frmDATAselect.frm       = form to select .DAT file for stored model datasheet data and print
'                                             text file datasheets.
' -------------------------------------------------------------------------------------------------------------------------------------
'
' -------------------------------------------------------------------------------------------------------------------------------------
'       REVISION RECORD
'
'  DATE         APPR    DESCRIPTION
'  ----         ----    -----------
' 2014/09/24    PWR     Initial version.
'
' -------------------------------------------------------------------------------------------------------------------------------------

'----------------------------------------------------------------------------------------------------
' Hard-coded values.
'----------------------------------------------------------------------------------------------------
Public Const PRINTSHEET_SUBDIR = "PRINT"    ' Hardcoded printed datasheet directory (below folder with .DAT files).
Public Const NUMPTS = 5                     ' Hardcoded number of points for accuracy/linearity measurements.
Public Const NUMTESTS = 20                  ' Hardcoded maximum array index (# of stored tests) for STATUS (strTestDATSTRING) and other arrays.

' Global variables.
Public strDBFILEname As String              ' Global variable to hold database (.DAT) file name.
Public strDBFILEfolder As String            ' Global variable to hold database (.DAT) file folder.
Public strDATFILEname As String             ' Global variable to hold stored datasheet data (.DAT) file name.
Public strDATFILEfolder As String           ' Global variable to hold stored datasheet data (.DAT) file folder.
Public iFileCount As Integer                ' Count of number of text datasheet files "printed".
Public iDupCount As Integer                 ' Count of number of text datasheet files "printed" over an existing file.
Public bDisplayMessages As Boolean          ' Flag, "True" to display error messages in various functions and subroutines.
Public bPrintFailingUnits As Boolean        ' Flag, "True" to also print text log files from failing units.

' Global arrays.
Public strTestNAMES(1 To NUMTESTS) As String    ' Global array for the Final Test test names.
Public strTestUNITS(1 To NUMTESTS) As String    ' Global array for the Final Test test units.
Public strTSPEC(1 To NUMTESTS) As String        ' Global array for the Final Test test limits strings for printed datasheet.
Public strMODNAME As String                     ' Global variable for module model name: "SCM5B30-1419", for example.
Public strSerialNumber As String                ' Global variable for work order-serial number (collectively: Serial Number).
Public strDATETESTED As String                  ' Global variable for date tested.
' Global array for the Final Test test status read from the .DAT file (this includes the "PASS" or "FAIL" status,
' test results, and the number of decimal points to display).
Public strTestDATSTRING(1 To NUMTESTS) As String
' Global arrays for the Accuracy/Linearity test data read from the .DAT file.
Public strTSIM(1 To 5) As String              ' Input value during acc/lin test (index is meas. #).
Public strOUTCALC(1 To 5) As String           ' Calculated output value during acc/lin test (index is meas. #).
Public strOUTMEAS(1 To 5) As String           ' Measured output value during acc/lin test (index is meas. #).
Public strERROROUT(1 To 5) As String          ' Calculated output error during acc/lin test (index is meas. #).
Public strACCSTAT(1 To 5) As String           ' PASS or FAILED status string during acc/lin test (index is meas. #).
' Global variable for data read from the datalog (.DAT) file.
Public sLOWV As Single                      ' Obsolete read value from datalog file.
Public sHIGHV As Single                     ' Obsolete read value from datalog file.
Public sTOTLRESPEC As Single                ' Obsolete read value from datalog file.


'================================================================================================================================
Sub Main()
    ' This is the startup (Main) subroutine for the program. Everything starts here.
        
    On Error GoTo ErrorHandler

    ' Initialize Final Test names and units for tests and stored
    ' values for data read from datalog and database files.
        
    '------------------------------------------------------
    ' Display program screen.
    ' NOTE: if screen is shown modal, it will NOT show up
    ' in the taskbar nor be found by clicking alt-tab to
    ' select open programs!
    '------------------------------------------------------
    
    'frmDBselect.Show vbModal   ' Show screen (modal).
    frmDSfiles.Show            ' Show screen (nonmodal).
    
    
    Exit Sub    ' Exit subroutine (before the error handler) if no error.
ErrorHandler:
    
    MsgBox ("Error in ""Main"" subroutine = " & Err.Description)

End Sub

Public Function funcMakePathFromFolder(ByVal strSubfolderName As String) As Boolean
    '-------------------------------------------------------------------------------------
    ' Function to create directories (folders) as needed, based on the passed parameter.
    '
    ' NOTE: The "strSubfolderName" parameter is assumed to be a complete path, including
    '       drive letter. This subroutine does not handle other path forms, such as
    '       those starting with a "\\" (as in "\\fileserver\") and will generate an
    '       error message and return "False" if an invalid folder name is passed.
    '-------------------------------------------------------------------------------------
    Dim arTemp() As String                          ' Dynamic array to store parsed values from "Split" function.
    Dim iArrayIndex As Long                         ' String-array index.
    Dim strFolder As String                           ' (Re)combined folder name string, concatenated piece by piece from original.
    Dim objFSO As New Scripting.FileSystemObject    ' New instance of FileSystemObject.
    
    On Error GoTo ErrorHandler
    
    'strFolder = sFolderRoot & "\"   ' Initialize to root.
    'strFolder = Left$(strSubfolderName, 2) & "\"  ' Initialize to drive letter and backslash.
    strFolder = ""    ' Initialize to drive letter and backslash.
    
    arTemp = Split(strSubfolderName, "\")            ' Split "full" folder name to array of strings at each backslash.
    
    ' For each split string (folder name) check if folder already exists. Lower and upper bounds of array are determined
    ' by the array itself (the number of strings depends on the contents of the "full" folder name (complete path). The
    ' initial string should be the drive name. If the folder does not exist, it is created. The "combined" folder name is
    ' then re-combined by adding a backslash and then the next string in the array (the next folder name).
    For iArrayIndex = LBound(arTemp) To UBound(arTemp)
        strFolder = strFolder & arTemp(iArrayIndex) & "\"
        If Not objFSO.FolderExists(strFolder) Then
            Call objFSO.CreateFolder(strFolder)
        End If
    Next iArrayIndex
    Set objFSO = Nothing
    
    funcMakePathFromFolder = True    ' Set function return before exit.
    
    Exit Function ' Exit subroutine (before the error handler) if no error.
ErrorHandler:
    Set objFSO = Nothing
    funcMakePathFromFolder = False    ' Set function error return.
    MsgBox ("Error in function ""funcMakePathFromFolder"" = " & Err.Description & vbCrLf & _
        "Folder name = " & strFolder & vbCrLf & _
        "Function returning ""False""!")
End Function

Public Sub subInitTestNAMES()
    ' This subroutine initializes the "strTestNAMES" global array with the
    ' names of the tests for the text data file.
    '
    Dim iIndex As Integer
    
    On Error GoTo ErrorHandler
    
    strTestNAMES(1) = "Supply Current"
    strTestNAMES(2) = "Supply Curr. w/ EXC Load"
    strTestNAMES(3) = "Exc. Current @ -f.s."
    strTestNAMES(4) = "Exc. Current @ +f.s."
    strTestNAMES(5) = ""
    strTestNAMES(6) = ""
    strTestNAMES(7) = "Excitation Voltage"
    strTestNAMES(8) = "EXC.Load Regulation"
    strTestNAMES(9) = "Output Reg. w/ EXC Load"
    strTestNAMES(10) = "Excitation Current Limit"
    strTestNAMES(11) = "Linearity"
    strTestNAMES(12) = "Accuracy"
    strTestNAMES(13) = "Lead Resistance Effect"
    strTestNAMES(14) = "Power Supply Sensitivity"
    strTestNAMES(15) = "Input Resistance"
    strTestNAMES(16) = "Open Thermocouple Resp."
    strTestNAMES(17) = "Frequency Response"
    strTestNAMES(18) = "Step Response"
    strTestNAMES(19) = "Output Noise"
    strTestNAMES(20) = "Chg. in Iout w/ Max Load"

    Exit Sub      ' Exit before error handler.
ErrorHandler:
    MsgBox ("Error in ""subInitTestNAMES"" = " & Err.Description), vbCritical
End Sub

Public Function funcIsMatchingString(ByVal strFirst As String, ByVal strSecond As String) As Boolean
    ' This function returns "True" if the "trimmed" values of the two strings that are passed
    ' to it match.
    '
    On Error GoTo ErrorHandler
    
    If (Trim(strFirst) = Trim(strSecond)) Then
        funcIsMatchingString = True     ' Strings   match.
    Else
        funcIsMatchingString = False    ' Strings do not match.
    End If

    Exit Function ' Exit before error handler.

ErrorHandler:
    funcIsMatchingString = False                    ' Error value.
    MsgBox ("Error in ""funcIsMatchingString"" = " & Err.Description & vbCrLf & vbCrLf & _
            "Contact engineering before proceeding!"), vbCritical
End Function

Public Sub subProcessDatasheetFiles(ByVal strFolderName As String)
    '
    '
    'Declare the variables.
    Dim objFSO As FileSystemObject
    Dim objFolder As Folder
    Dim objFile As File
    Dim NextRow As Long
    Dim iCount As Integer
    
    On Error GoTo ErrorHandler
    
    'Create an instance of the FileSystemObject.
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    'Get the folder.
    Set objFolder = objFSO.GetFolder(strFolderName)
    
    'If the folder does not contain files, exit the sub.
    'If (objFolder.Files.Count = 0) Then
    '    MsgBox "No files were found...", vbExclamation
    '    Exit Sub
    'End If
    
    iCount = 0  'Initialize.
    
    'Loop through each file in the folder
    For Each objFile In objFolder.Files
        frmDSfiles.lstInvalidDS.AddItem objFile.Name
        iCount = iCount + 1
        frmDSfiles.txtInvalidCount.Text = iCount
    Next objFile
 
 
    Exit Sub    'Exit before error handler.
ErrorHandler:
    MsgBox ("Error in ""subProcessDatasheetFiles"" = " & Err.Description & vbCrLf & vbCrLf & _
            "Contact engineering before proceeding!"), vbCritical
End Sub

Public Sub subDirList(ByVal strFolderName As String)
    '
    '
    'Declare the variables.
    Dim strFileName As String
    Dim strDirSpec As String
    Dim iCountInvalid As Integer
    Dim iCountRename As Integer
    
    On Error GoTo ErrorHandler
    
    'Initialize.
    iCountInvalid = 0
    iCountRename = 0
    frmDSfiles.lstInvalidDS.Clear
    
    'Set Dir$ function specification (directory path and search criteria).
    strDirSpec = strFolderName & "\*.txt"
    strFileName = Dir$(strDirSpec, vbNormal)
    
    'If the folder does not contain files, exit the sub.
    'If (strFileName = "") Then
    '    MsgBox "No files were found...", vbExclamation
    '    Exit Sub
    'End If
    
    'Loop through each file in the folder
    Do While (strFileName <> "")
        strFileName = Dir$
        If (strFileName <> "") Then
            frmDSfiles.lstInvalidDS.AddItem strFileName
        iCount = iCount + 1
        End If
    Loop
    frmDSfiles.txtInvalidCount.Text = iCountInvalid
    frmDSfiles.txtRenameCount.Text = iCountRename
    frmDSfiles.Refresh
 
    Exit Sub    'Exit before error handler.
ErrorHandler:
    MsgBox ("Error in ""subDirList"" = " & Err.Description & vbCrLf & vbCrLf & _
            "Contact engineering before proceeding!"), vbCritical
End Sub

Private Function funcParseFileName(ByVal strFullFileName) As String
    'This function parses out the file name (only) portion of the full file name (file name plus extension).
    'The file name, in the case of datasheet files, is the module serial number. This is returned in
    'uppercase if the proper file extension is found (".TXT"). If the proper extension is not found,
    'or there is some other problem, a null string is returned.
    '
    'Define the variables.
    Dim strSerial As String     'Serial number portion of the complete file name (file name, without the extension).
    Dim iSTRlength As Integer   'Length of serial number or complete file name string.
    
    On Error GoTo ErrorHandler
    
    If (strFullFileName <> "") Then
        'Get serial number (file name) from complete file name.
        strSerial = UCase$(strFullFileName) 'Set serial number string to full file name in uppercase.
        If (Right$(strFullFileName, 4) = ".TXT") Then
            'Strip off last four characters (.TXT file extension) from full file name
            'to create the file name only (serial number) string.
            iSTRlength = Len(strSerial)                   'Get length of the full file name.
            strSerial = Left$(strSerial, iSTRlength - 4)  'Strip off last four characters (".txt").
            funcParseFileName = strSerial
        Else
            funcParseFileName = ""  'Error value.
        End If
    Else
        'Invalid (null) file name.
        funcParseFileName = ""  'Error value.
    End If

    Exit Function ' Exit before error handler.
ErrorHandler:
    funcParseFileName = ""  'Error value.
    MsgBox ("Error in ""funcParseFileName"" = " & Err.Description & vbCrLf & vbCrLf & _
            "Contact engineering before proceeding!"), vbCritical
End Function

Private Function funcIsDashValid(ByVal strSerial) As String
    'This function checks for a valid dash ("-") in the passed (module) serial string.
    'For the dash to be valid, there must be a dash in the string, there must be only
    'one dash in the string, and the dash must be the second or third character from
    'the end (right side) of the string. The function returns "True" if there is a
    'valid (single, correctly located) dash, and "False" otherwise, including when
    'there is an error in the function.
    '
    '
    'Define the variables.
    Dim iSTRlength As Integer   'Length of serial number string.
    Dim iDashLocL As Integer    'Location of dash, when searched for from the left.
    Dim iDashLocR As Integer    'Location of dash, when searched for from the right.
    
    On Error GoTo ErrorHandler
    
    iSTRlength = Len(strSerial) 'Length of serial string.
    
    'Location of dash (characters from start (left) of string) when searched from the left.
    iDashLocL = InStr(strSerial, "-")
    
    'Location of dash (characters from start (left) of string) when searched from the right.
    iDashLocR = InStrRev(strSerial, "-")
    
    If (iDashLocL = iDashLocR) Then
        'Dash in same location = only one dash in the serial string.
        '
        'Start dash location validation.
        If (((iSTRlength - iDashLocL) > 2) Or ((iSTRlength - iDashLocL) = 0)) Then
            'Too many characters after the dash, or dash at end.
            funcIsDashValid = False     'Error value (invalid dash).
        Else
            funcIsDashValid = True      'Good value (valid dash).
        End If
    Else
        'More than one dash in the serial string.
        funcIsDashValid = False     'Error value (invalid dash).
    End If

    Exit Function ' Exit before error handler.
ErrorHandler:
    funcIsDashValid = False     'Error value (invalid dash).
    MsgBox ("Error in ""funcIsDashValid"" = " & Err.Description & vbCrLf & vbCrLf & _
            "Contact engineering before proceeding!"), vbCritical
End Function

Private Function funcSNparse(ByVal strFullFileName As String, ByRef strWorkOrderNum As String, ByRef strDashNum As String) As Boolean
    'Function that receives the name of the datasheet sheet file and parses out both the work order number and
    'dash number from the complete module serial number contained in the file name, and returns them (by reference)
    'as the "strWorkOrderNum" and "strDashNum" parameters. The function returns "True" if there is no error and
    'work order and dash numbers could be successfully parsed, and "False" if there is any error or problem.
    '
    'Define the variables.
    Dim strSerial As String     'Serial number portion of the complete file name (file name, without the extension).
    Dim iCharLoc As Integer     'Character location in file name string.
    Dim iSTRlength As Integer   'Length of serial number or complete file name string.
    
    On Error GoTo ErrorHandler
    
    'Get serial number (file name) string from full file name.
    strSerial = funcParseFileName(strFullFileName)
    
    'Validate serial number, and parse if valid.
    If (strSerial <> "") Then
        'Valid serial number. Perform further serial number validation.
        If (funcIsDashValid(strSerial) = True) Then
            'Serial number contains a single, valid dash.
            
            'Get length of serial number
            iSTRlength = Len(strSerial)
            
            'Location of dash characters (from start (left) of string) when searched from the left.
            iCharLoc = InStr(strSerial, "-")
            
            'Parse work order# (characters to the left of the dash) from the serial number string.
            strWorkOrderNum = Left$(strSerial, iCharLoc - 1)
            
            'Parse the dash# (characters to the right of the dash) from the serial number string.
            strDashNum = Mid$(strSerial, iCharLoc + 1, iSTRlength - iCharLoc%)
        
        Else
            'Invalid dash number (missing, duplicate, or in wrong location) in serial number.
            funcSNparse = False     ' Error value.
            Exit Function       'Exit function on erroneous file name.
        End If
    Else
        'Not a valid datasheet file name.
        funcSNparse = False     ' Error value.
        Exit Function       'Exit function on erroneous file name.
    End If

    Exit Function ' Exit before error handler.
ErrorHandler:
    funcSNparse = False     ' Error value.
    MsgBox ("Error in ""funcSNparse"" = " & Err.Description & vbCrLf & vbCrLf & _
            "Contact engineering before proceeding!"), vbCritical
End Function






#If 0 Then
Function ISPOSNUMBER%(TESTVALUE$)
    'Function that checks if the passed string is a positive number (entirely numerical)
    'or is a string (at least one non-numerical character). Returns "1" for a positive
    ' number or "0" anything else
    ISPOSNUMBER% = 1 'Initialize to function return for numerical string
    N% = Len(TESTVALUE$)    'Get length of passed string
    Do Until N% = 0
        TVC$ = Mid$(TESTVALUE$, N%, 1)  'Get nth character of passed string
        CHARVALUE% = Asc(TVC$)          'Get decimal ASCII code for nth character
        If ((CHARVALUE% < 48) Or (CHARVALUE% > 57)) Then
            ISPOSNUMBER% = 0    'Character not ASCII code for 0 through 9
        End If
        N% = N% - 1
    Loop

End Function
#End If









Private Function funcIsRenameDSname(ByVal strWorkOrder) As Boolean
    ' This function returns "True" if the "trimmed" values of the two strings that are passed
    ' to it match.
    '
    On Error GoTo ErrorHandler
    
    If (Trim(strFirst) = Trim(strSecond)) Then
        funcIsInvalidDSname = True     ' Strings   match.
    Else
        funcIsInvalidDSname = False    ' Strings do not match.
    End If

    Exit Function ' Exit before error handler.
ErrorHandler:
    funcIsMatchingString = False                    ' Error value.
    MsgBox ("Error in ""funcIsInvalidDSname"" = " & Err.Description & vbCrLf & vbCrLf & _
            "Contact engineering before proceeding!"), vbCritical
End Function










Private Function funcIsInvalidDSname(ByVal strFileName) As Boolean
    ' This function returns "True" if the "trimmed" values of the two strings that are passed
    ' to it match.
    '
    On Error GoTo ErrorHandler
    
    If (Trim(strFirst) = Trim(strSecond)) Then
        funcIsInvalidDSname = True     ' Strings   match.
    Else
        funcIsInvalidDSname = False    ' Strings do not match.
    End If

    Exit Function ' Exit before error handler.
ErrorHandler:
    funcIsMatchingString = False                    ' Error value.
    MsgBox ("Error in ""funcIsInvalidDSname"" = " & Err.Description & vbCrLf & vbCrLf & _
            "Contact engineering before proceeding!"), vbCritical
End Function





