feat(valleywide): recover VWP Orders VB6 source from D: backup drive

Recovered Darv's VB6 source for the Valley Wide Plastering Orders application from the D: backup drive (label "Backup", 8 TB, 5.3 TB used). This is the first time we've had the actual source — prior session only had a single frmPayroll.frm from the AD server. Three project variants identified across two snapshots: - Full-Project/ (2,129 files, 124 MB) — D:\Office-Estimates\Darv\Full\Project\ - Kingston-Project/ (2,189 files, 130 MB) — D:\Office-Estimates\Darv\Kingston\Project\ - Source/ (170 files, 559 MB) — D:\Office-Estimates\Darv\Source\ wholesale - SOURCE-HOLD/ (3 files, 1 MB) — D:\Office-Estimates\Darv\SOURCE HOLD\ Latest ORDERS_C.vbp date is 2020-06-09 (Kingston snapshot). Production Orders_10A.exe was live as of April 2024 — open question whether newer source exists on other backup drives Mike will scan next. Also includes per-category and per-keyword analysis CSVs from a WizTree file-list export, plus the analyzer script that produced them (re-runnable for the next drive's CSV). VMs (VWIN7-DW.vdi 8.3 GB + XP-for-ORDERS_copy.vdi 2.8 GB), the live VWP.mdb, and the 393 MB raw WizTree CSV stay on disk only — gitignored. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-16 17:36:02 -07:00
parent 7386460f55
commit 5359e7c49e
4426 changed files with 4478036 additions and 0 deletions
--- a/clients/valleywide/app-modernization/source-code/Source/History/ADO2.bas
+++ b/clients/valleywide/app-modernization/source-code/Source/History/ADO2.bas
@@ -0,0 +1,657 @@
+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