Attribute VB_Name = "modADO"
Option Explicit

Global cb As Long          'Used to store CODE4 pointer
Global db As Long          'Used to store DATA4 pointer
Global db2 As Long          'Used to store DATA4 pointer
Global rc As Integer       'Used as general return code
Global rc2 As Integer       'Used as general return code
Global ind As Integer

Global lf As String        'Line Feed
Global fPath As String     'Full path name to data files
Global configCode As Long  'What type of DLL being used?

'loop counters
Global i As Integer, j As Integer

Public goConn As New Connection
Public goConn2 As New ADODB.Connection
Public gstrCOMPANY As String
Public gstrARCODE As String
Public gstrBEGDATE As String, gstrENDDATE As String
Public gintDEST As Integer, gintCOPY As Integer
Public gintLOTID As Integer, gintPERCENT As Integer
Public gintPROJID As Integer, glngORDERID As Long
Public gintOPTID As Integer, gboolMAS90 As Boolean
Public gintREPAIRID As Integer, gintORDER As Integer
Public gintESTID As Integer, gstrPO As String
Public gstrLOGIN As String, gbytSECURITY As Byte
Public gintCREWID As Integer, gstrCREW As String
Public gstrFLAG As String, gstrPONUM As String, gstrTYPE As String
Public gboolPRINT As Boolean, gboolLOGIN As Boolean, gstrMODULE As String
Public gboolTYPE As Boolean

Public gconACTION As Byte ' 1 = Add, 2 = Change, 3 = Delete, 5 = Copy

Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Const LB_SETTABSTOPS = &H192

Public Sub Main()
Dim boolPerform As Boolean
Dim boolPerform2 As Boolean
   
   On Error GoTo Error_EH
   
'   Screen.MousePointer = vbHourglass
   
'   boolPerform = DataOpen(goConn)
   
'   If boolPerform Then
   
   cb = code4init()                 'Initialize CodeBasic
   If cb = 0 Then
      MsgBox "CMS Database Open Failure - Closing Program", vbCritical + vbOKOnly, "File Open Error"
      Exit Sub
   Else
   '         configCode = u4switch() 'Determine what type of DLL being used
      frmMain.Show
   '   '      Form1.Show (1)          'Show Form1 modally
   End If
   
'      rc = code4initUndo(cb)     'Close everything and free resources
   
'   End If
   
'    Set goConn2 = New ADODB.Connection

    'Assuming default provider name
  '  goConn2.ConnectionString = "Provider=CodeBase;Location="

    'Open connection
  '  goConn2.Open

  ' If goConn2.Errors.count = 0 Then
  '    frmMain.Show
  ' Else
  '    MsgBox "CMS Files Were Not Opened", vbInformation, "File Error"
  '    Exit Sub
  ' End If

    'Data manipulation code...

    'Cleanup
'    cnn.Close
'    Set cnn = Nothing
'   boolPerform2 = DataOpen2(goConn2)
   
'   If boolPerform2 Then
   
'      cb = code4init()                 'Initialize CodeBasic
'      If cb = 0 Then
'      configCode = u4switch() 'Determine what type of DLL being used
'      frmMain.Show
'      Form1.Show (1)          'Show Form1 modally
'   Else
'      MsgBox "CMS Database Open Failed"
'      Set goConn2 = Nothing
'      Exit Sub
'      End If
   
'   goConn2.Close
'   Set goConn2 = Nothing
   
'   End If
'   Screen.MousePointer = vbDefault
   Exit Sub
   
Error_EH:
   gstrMODULE = "Module ADO2.BAS - Sub Main"
   Call ErrorHandler2
   gstrMODULE = ""
   Exit Sub
End Sub

'Public Function DataOpen(oConn As Connection) As Boolean
'   On Error GoTo Open_EH
'
'   oConn.CursorLocation = adUseClient
   
   ' Set the connection string by calling
   ' a function.
'   oConn.ConnectionString = ConnectString()
      
   ' Set the mode of the connection
'   oConn.Mode = adModeReadWrite
      
   ' Open the Connection
'   oConn.Open
   
'   DataOpen = True
   
'   Exit Function
   
'Open_EH:
'   Call ErrorHandler(goConn)
'   DataOpen = False
'   Exit Function
'End Function

'Public Function DataOpen2(oConn2 As ADODB.Connection) As Boolean
'Public Function DataOpen2(oConn2 As Connection) As Boolean
'   On Error GoTo Open_EH
   
'   oConn2.CursorLocation = adUseClient
   
   ' Set the connection string by calling
   ' a function.
'   oConn2.ConnectionString = ConnectString2()
'   oConn2.ConnectionString = "Provider=CODEBASE;Location="
      
   ' Set the mode of the connection
'   oConn2.Mode = adModeRead ' = adModeReadWrite
      
   ' Open the Connection
'   oConn2.Open
   
'   If oConn2.Errors.Count = 0 Then
'      DataOpen2 = True
'   End If

    'Data manipulation code...

    'Cleanup
   
'   Exit Function
   
'Open_EH:
'   Call ErrorHandler(goConn2)
'   DataOpen2 = False
'   Exit Function
'End Function

Public Function ConnectString() As String
Dim strDB As String
   ' SQL Server using an ODBC Data Source
   'Provider=MSDASQL.1;Password="";Persist Security Info=True;User ID=DWW;Data Source=SOTAMAS90
'   ConnectString = "DSN=VWPMAS90"
   
   '                "UID=DWW;PWD=;" & _
   '                "DATABASE=Employees"
   
'   ConnectString = "DSN=SOTAMAS90;" & _
'                   "UID=DWW;PWD=;" ' & _
                    '"DATABASE="
   
   
   ' SQL Server using OLE DB Provider
   'ConnectString = "Provider        = sqloledb;" & _
   '                "Data Source     = (local);" & _
   '                "Initial Catalog = Employees;" & _
   '                "User Id         = sa;" & _
   '                "Password        = ; "
   
   ' Jet MDB
   strDB = App.Path & "\History.mdb"
   ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0" & _
                   ";Data Source=" & strDB
'                   ";Data Source=vwp\vwp.mdb"
'  "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=vwp\vwp.mdb"
'                   ";Data Source=vwp\vwp.mdb"
End Function

Public Function ConnectString2() As String
Dim strDB As String
   ' SQL Server using an ODBC Data Source
   
   
   'Provider=MSDASQL.1;Persist Security Info=False;User ID=Admin;Data Source=CMS2;Initial Catalog=c:\PROGRAM FILES\MICROSOFT VISUAL STUDIO\VB98\JIMMY

'   ConnectString2 = "Provider=MSDASQL.1;Persist Security Info=False;User ID=Admin;Data Source=CMS2;Initial Catalog=c:\PROGRAM FILES\MICROSOFT VISUAL STUDIO\VB98\JIMMY"
                    '";User ID=Admin" & _
                    '";Data Source=CMS2" _
                    '";Initial Catalog=c:\PROGRAM FILES\MICROSOFT VISUAL STUDIO\VB98\JIMMY"
   
'                    ";User ID=SUP" & _

'   strDB = App.Path
   ConnectString2 = "Provider=CODEBASE;Location="
   '& _
   '                 ";Data Source=CMS2" & _
   '                 ";Persist Security Info=False" & _
   '                 ";Initial Catalog= " & strDB 'c:\PROGRAM FILES\MICROSOFT VISUAL STUDIO\VB98\JIMMY"

End Function

'Public Sub ErrorHandler(oConn As Connection)
'   Dim oErr As Error
'   Dim strMSG As String
   
'   For Each oErr In oConn.Errors
'      strMSG = strMSG & _
'               "Error #: " & _
'               oErr.Number & vbCrLf
'      strMSG = strMSG & _
'               "Description: " & _
'               oErr.Description & vbCrLf
'      strMSG = strMSG & _
'               "Source: " & _
'               oErr.source & vbCrLf
'      strMSG = strMSG & _
'               "SQL State: " & _
'               oErr.SQLState & vbCrLf
'      strMSG = strMSG & _
'               "Native Error: " & _
'               oErr.NativeError & vbCrLf
'      strMSG = strMSG & vbCrLf
'   Next
'
'   MsgBox strMSG
'End Sub

Public Sub ErrorHandler3(oConn2 As Connection)
   Dim oErr As Error
   Dim strMSG As String
   
   For Each oErr In oConn2.Errors
      strMSG = strMSG & _
               "Error #: " & _
               oErr.Number & vbCrLf
      strMSG = strMSG & _
               "Description: " & _
               oErr.Description & vbCrLf
      strMSG = strMSG & _
               "Source: " & _
               oErr.source & vbCrLf
      strMSG = strMSG & _
               "SQL State: " & _
               oErr.SQLState & vbCrLf
      strMSG = strMSG & _
               "Native Error: " & _
               oErr.NativeError & vbCrLf
      strMSG = strMSG & vbCrLf
   Next
   
   MsgBox strMSG
End Sub

Public Sub AppQuit()
   On Error Resume Next

   If goConn.State = adStateOpen Then
      goConn.Close
      Set goConn = Nothing
   End If
   If goConn2.State = adStateOpen Then
      goConn2.Close
      Set goConn2 = Nothing
   End If
   
   
   End
End Sub

Public Function Str2Field(strValue As String) As Variant
   If IsNull(strValue) Then
      strValue = ""
      If Trim$(strValue) = "" Then
         Str2Field = Null
      Else
         Str2Field = strValue
      End If
   Else
      If Trim$(strValue) = "" Then
         Str2Field = Null
      Else
         Str2Field = strValue
      End If
   End If
End Function
Public Function Integer2Field(strValue As Variant) As Integer
'   If strValue = "" Or strValue = " " Then
'   If Trim$(strValue) = "" Then
'      Integer2Field = 0
'   Else
      If IsNull(strValue) Then
         Integer2Field = 0
      ElseIf Trim$(strValue) = "" Then
         Integer2Field = 0
      Else
         Integer2Field = CInt(strValue)
      End If
'   End If

End Function

Public Function Long2Field(strValue As Variant) As Integer
'   If Trim$(strValue) = "" Then
'      Long2Field = 0
'   Else
      If IsNull(strValue) Then
         Long2Field = 0
      ElseIf Trim$(strValue) = "" Then
         Long2Field = 0
      Else
         Long2Field = CLng(strValue)
      End If
'   End If

End Function

Public Function Single2Field(strValue As Variant) As Single
'   If Trim$(strValue) = "" Then
'      Single2Field = 0
'   Else
      If IsNull(strValue) Then
         Single2Field = 0
      ElseIf Trim$(strValue) = "" Then
         Single2Field = 0
      Else
         Single2Field = CSng(strValue)
      End If
'   End If

End Function

Public Function Date2Field(strValue As String) As Variant
   If strValue = "" Then
      Date2Field = Null
   Else
      If IsDate(strValue) Then
         Date2Field = CDate(strValue)
      Else
         Date2Field = Null
      End If
   End If
End Function

Public Function Double2Field(strValue As String) As Variant
   If IsNull(strValue) Then
      Double2Field = 0
   ElseIf Trim$(strValue) = "" Then
      Double2Field = 0
   Else
      Double2Field = CDbl(strValue)
   End If
'   If strValue = "" Then
'      Double2Field = Null
'   Else
'      If IsNumeric(strValue) Then
'         Double2Field = CDbl(strValue)
'      Else
'         Double2Field = Null
'      End If
'   End If
End Function

Public Function Field2Str(vntField As Variant) As String
   If IsNull(vntField) Then
      Field2Str = ""
   Else
      Field2Str = Trim$(CStr(vntField))
   End If
End Function
Public Function Field2Str2(vntField As Variant) As String
'   If vntField = "" Then
'      Field2Str2 = 0
'   Else
      If IsNull(vntField) Then
         Field2Str2 = 0
      ElseIf Trim$(vntField) = "" Then
         Field2Str2 = 0
      Else
         Field2Str2 = Trim$(CStr(vntField))
      End If
'   End If
End Function

Public Function Field2Long(vntField As Variant) As Long
   If IsNull(vntField) Then
      Field2Long = -1
   Else
      Field2Long = CLng(vntField)
   End If
End Function

Public Function Field2Double(vntField As Variant) As Long
'   If Trim$(vntField) = "" Then
'      Field2Double = 0
'   Else
      If IsNull(vntField) Then
         Field2Double = 0
      ElseIf Trim$(vntField) = "" Then
         Field2Double = 0
      Else
         Field2Double = CDbl(vntField)
      End If
'   End If
End Function

Public Function Field2Decimal(vntField As Variant) As Long
'   If Trim$(vntField) = "" Then
'      Field2Decimal = 0
'   Else
      If IsNull(vntField) Then
         Field2Decimal = 0
      ElseIf Trim$(vntField) = "" Then
         Field2Decimal = 0
      Else
         Field2Decimal = CDec(vntField)
      End If
'   End If
End Function

Public Function Field2Integer(vntField As Variant) As Long
'   If Trim$(vntField) = "" Then
      
'   Else
      If IsNull(vntField) Then
         Field2Integer = 0
      ElseIf Trim$(vntField) = "" Then
         Field2Integer = 0
      Else
         Field2Integer = CInt(vntField)
      End If
'   End If
End Function

Public Function Field2CheckBox(vntField As Variant) As Integer
   If IsNull(vntField) Then
      Field2CheckBox = vbUnchecked
   Else
      Field2CheckBox = IIf(vntField, vbChecked, vbUnchecked)
   End If
End Function

Public Sub ListFindItem(ctlAny As Control, lngValue As Long)
   Dim intLoop As Integer
   Dim boolFound As Boolean
   
   For intLoop = 0 To ctlAny.ListCount - 1
      If ctlAny.ItemData(intLoop) = lngValue Then
         ctlAny.ListIndex = intLoop
         boolFound = True
         intLoop = ctlAny.ListCount
      End If
   Next
   
   If Not boolFound Then
      ctlAny.ListIndex = -1
   End If
End Sub

Public Sub ListFindItem3(ctlAny As Control, lngValue As Long)
   Dim intLoop As Integer
   Dim boolFound As Boolean
   
   For intLoop = 0 To ctlAny.ListCount - 1
      If Field2Long(Left(ctlAny.ItemData(intLoop), 3)) = lngValue Then
         ctlAny.ListIndex = intLoop
         boolFound = True
         intLoop = ctlAny.ListCount
      End If
   Next
   
   If Not boolFound Then
      ctlAny.ListIndex = -1
   End If
End Sub

Public Sub ListFindItem2(ctlAny As Control, lngValue As Long)
   Dim intLoop As Integer
   Dim boolFound As Boolean
   
   For intLoop = 0 To ctlAny.ListCount - 1
      If ctlAny.ItemData(intLoop) > lngValue Then
         ctlAny.ListIndex = intLoop - 1
         boolFound = True
         intLoop = ctlAny.ListCount
      End If
   Next
   
   If Not boolFound Then
      ctlAny.ListIndex = -1
   End If
End Sub

Public Function ListReposition(lstCtrl As Control, _
                               intINDEX As Integer) As Integer
   If lstCtrl.ListCount = 0 Then
      ListReposition = -1
   Else
      intINDEX = intINDEX + 1
      
      If intINDEX >= lstCtrl.ListCount - 1 Then
         ListReposition = lstCtrl.ListCount - 1
      Else
         intINDEX = intINDEX - 1
         If intINDEX <= 0 Then
            ListReposition = 0
         Else
            ListReposition = intINDEX
         End If
      End If
   End If
End Function
Public Sub CBFindString(ctrControlName As Control, strFindStr As String)

Dim intLoop As Integer, strStr As String

For intLoop = 0 To ctrControlName.ListCount - 1
'   strStr = ctrControlName.ItemData(intLoop)
   strStr = ctrControlName.List(intLoop)
   If Trim$(UCase$(strStr)) = Trim(UCase$(strFindStr)) Then
      ctrControlName.ListIndex = intLoop
      intLoop = ctrControlName.ListCount
'      ctrControlName.SetFocus
   Else
      ctrControlName.ListIndex = -1
   End If
Next intLoop

End Sub

Public Sub CBFindString3(ctrControlName As Control, strFindStr As String)

Dim intLoop As Integer, strStr As String

For intLoop = 0 To ctrControlName.ListCount - 1
'   strStr = ctrControlName.ItemData(intLoop)
   strStr = ctrControlName.List(intLoop)
   If Left$(UCase$(strStr), 2) = Trim(UCase$(strFindStr)) Then
      ctrControlName.ListIndex = intLoop
      intLoop = ctrControlName.ListCount
'      ctrControlName.SetFocus
   Else
      ctrControlName.ListIndex = -1
   End If
Next intLoop

End Sub

Public Sub CBFindString1(ctrControlName As Control, strFindStr As String)

Dim intLoop As Integer, strStr As String

For intLoop = 0 To ctrControlName.ListCount - 1
'   strStr = ctrControlName.ItemData(intLoop)
   strStr = ctrControlName.List(intLoop)
   If Left$(UCase$(strStr), 1) = Trim(UCase$(strFindStr)) Then
      ctrControlName.ListIndex = intLoop
      intLoop = ctrControlName.ListCount
'      ctrControlName.SetFocus
   Else
      ctrControlName.ListIndex = -1
   End If
Next intLoop

End Sub

Public Sub CBFindString4(ctrControlName As Control, strFindStr As String)
'This Routine will find something in the Item Data are of a control.
'This works best when looking for an amount that not just the list index number.

Dim intLoop As Integer, strStr As String

For intLoop = 0 To ctrControlName.ListCount - 1
   strStr = ctrControlName.ItemData(intLoop)
   If Left$(UCase$(strStr), 4) = Trim(UCase$(strFindStr)) Then
      ctrControlName.ListIndex = intLoop
      intLoop = ctrControlName.ListCount
      ctrControlName.SetFocus
   Else
      ctrControlName.ListIndex = -1
   End If
Next intLoop

End Sub

Public Sub CBFindString2(ctrControlName As Control, strFindStr As String)

Dim intLoop As Integer, strStr As String, strID As String

For intLoop = 0 To ctrControlName.ListCount - 1
'   strStr = ctrControlName.ItemData(intLoop)
   strStr = ctrControlName.List(intLoop)
   strID = Left(Trim$(UCase$(strStr)), 3)
   If Field2Str2(strID) = Trim(UCase$(strFindStr)) Then
'   If Left(Trim$(UCase$(strStr)), 3) = Trim(UCase$(strFindStr)) Then
      ctrControlName.ListIndex = intLoop
      intLoop = ctrControlName.ListCount
      ctrControlName.SetFocus
      Exit Sub
   Else
      ctrControlName.ListIndex = -1
   End If
Next intLoop

End Sub

Public Function FieldSelect(lstCtrl As Control)
   lstCtrl.SelStart = 0
   If lstCtrl.MaxLength > 0 Then
      lstCtrl.SelLength = lstCtrl.MaxLength
   Else
      lstCtrl.SelLength = 1000
   End If
End Function

Public Sub ErrorHandler2()
   Set frmError.ErrorObj = Err
   frmError.Show vbModal
End Sub


Public Function FindMax(ByVal strFILE As String, ByVal strField As String)
Dim strSQL As String, oRSMAX As Recordset
'Dim strField As String, strFile As String

   strSQL = "SELECT Max(" & strField & ") as MAXField from " & strFILE 'tblOption"
   Set oRSMAX = New Recordset
   oRSMAX.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly

   FindMax = oRSMAX!maxfield
   oRSMAX.Close

End Function