Files
claudetools/clients/valleywide/app-modernization/source-code/Full-Project/VWP_Inv/frmBillingStatus22.frm
Mike Swanson 5359e7c49e 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:27 -07:00

687 lines
19 KiB
Plaintext

VERSION 5.00
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX"
Object = "{8DDE6232-1BB0-11D0-81C3-0080C7A2EF7D}#3.0#0"; "Flp32a30.ocx"
Begin VB.Form frmBillingStatus
Caption = "Billing Status"
ClientHeight = 5835
ClientLeft = 60
ClientTop = 345
ClientWidth = 8385
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 5835
ScaleWidth = 8385
StartUpPosition = 3 'Windows Default
Begin LpLib.fpList lstShipping
Height = 3675
Left = 120
TabIndex = 11
Top = 120
Width = 8115
_Version = 196608
_ExtentX = 14314
_ExtentY = 6482
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Enabled = -1 'True
MousePointer = 0
Object.TabStop = -1 'True
BackColor = -2147483643
ForeColor = -2147483640
Columns = 5
Sorted = 0
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = -1
ColumnWidthScale= 2
RowHeight = -1
MultiSelect = 0
WrapList = 0 'False
WrapWidth = 0
SelMax = -1
AutoSearch = 1
SearchMethod = 0
VirtualMode = 0 'False
VRowCount = 0
DataSync = 3
ThreeDInsideStyle= 1
ThreeDInsideHighlightColor= -2147483633
ThreeDInsideShadowColor= -2147483627
ThreeDInsideWidth= 1
ThreeDOutsideStyle= 1
ThreeDOutsideHighlightColor= -2147483628
ThreeDOutsideShadowColor= -2147483632
ThreeDOutsideWidth= 1
ThreeDFrameWidth= 0
BorderStyle = 0
BorderColor = -2147483642
BorderWidth = 1
ThreeDOnFocusInvert= 0 'False
ThreeDFrameColor= -2147483633
Appearance = 2
BorderDropShadow= 0
BorderDropShadowColor= -2147483632
BorderDropShadowWidth= 3
ScrollHScale = 2
ScrollHInc = 0
ColsFrozen = 0
ScrollBarV = 1
NoIntegralHeight= 0 'False
HighestPrecedence= 0
AllowColResize = 0
AllowColDragDrop= 0
ReadOnly = 0 'False
VScrollSpecial = 0 'False
VScrollSpecialType= 0
EnableKeyEvents = -1 'True
EnableTopChangeEvent= -1 'True
DataAutoHeadings= -1 'True
DataAutoSizeCols= 2
SearchIgnoreCase= -1 'True
ScrollBarH = 1
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= -1 'True
ColumnHeaderHeight= 300
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmBillingStatus.frx":0000
End
Begin VB.CommandButton cmdMark
Caption = "Mark All Invoices"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1575
TabIndex = 10
Top = 4860
Visible = 0 'False
Width = 1035
End
Begin VB.CommandButton cmdDelete
Caption = "Delete"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2981
TabIndex = 9
Top = 4860
Width = 1035
End
Begin Crystal.CrystalReport crShipped
Left = 4200
Top = 5400
_ExtentX = 741
_ExtentY = 741
_Version = 348160
PrintFileLinesPerPage= 60
End
Begin VB.CommandButton cmdPrint
Caption = "Print"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 7200
TabIndex = 8
Top = 4860
Width = 1035
End
Begin VB.CommandButton cmdExit
Caption = "Exit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 5793
TabIndex = 4
Top = 4860
Width = 1035
End
Begin VB.CommandButton cmdSave
Caption = "Save"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4387
TabIndex = 3
Top = 4860
Width = 1035
End
Begin VB.CheckBox chkShipped
Alignment = 1 'Right Justify
Caption = "Order Shipped"
Height = 315
Left = 90
TabIndex = 1
Top = 4980
Width = 1395
End
Begin VB.TextBox txtShippingDate
Height = 315
Left = 1200
MaxLength = 10
TabIndex = 2
Top = 5460
Width = 2175
End
Begin VB.ListBox lstShipping2
Height = 3180
Left = 120
Sorted = -1 'True
TabIndex = 0
Top = 975
Width = 8115
End
Begin VB.Label lblAmount
BorderStyle = 1 'Fixed Single
Height = 375
Left = 120
TabIndex = 7
Top = 4440
Width = 8115
End
Begin VB.Label lblData
BorderStyle = 1 'Fixed Single
Height = 375
Left = 120
TabIndex = 6
Top = 4020
Width = 8115
End
Begin VB.Label lblDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Shipping Date:"
Height = 195
Left = 75
TabIndex = 5
Top = 5520
Width = 1050
End
End
Attribute VB_Name = "frmBillingStatus"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSBill As Recordset
Dim mlngTRANSID As Long, mstrType As String, mstrSDate As String
Dim mboolSHOW As Boolean, mintBOOKMARK As Integer
Dim mstrCHECK As String
Private Sub BillingLoad()
Dim oRS As Recordset
Dim strSQL As String
Dim strTYPE As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT trans_ID, lot_id, header, job_number, shipped, ship_date, Invoice_date, Inv_type, ProjLot FROM tblARInvoice WHERE header and not shipped" ' ORDER by ship_date"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstShipping.Clear
Do Until oRS.EOF
With lstShipping
gintLOTID = Field2Str2(oRS!Lot_id)
If oRS!inv_type = "L" Then
strTYPE = "LATH "
ElseIf oRS!inv_type = "S" Then
strTYPE = "STUCCO "
ElseIf oRS!inv_type = "V" Then
strTYPE = "STONE "
ElseIf oRS!inv_type = "C" Then
strTYPE = "COMPLETE"
End If
' strLine = ""
strLine = Field2Str2(oRS!Trans_ID) & vbTab & Field2Str(oRS!ship_date) & vbTab & strTYPE & vbTab
strLine = strLine & Format(Field2Str(oRS!job_number), "!@@@@@@@@@") & vbTab
strLine = strLine & Field2Str(oRS!ProjLot)
.AddItem strLine
' .ItemData(.NewIndex) = oRS!trans_id
oRS.MoveNext
End With
Loop
oRS.Close
If lstShipping.ListCount Then
lstShipping.ListIndex = 0
mlngTRANSID = lstShipping.ItemData(lstShipping.ListIndex)
Else
mlngTRANSID = 0
End If
Exit Sub
Error_EH:
gstrMODULE = "Form BillingStatus - Module BillingLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub chkShipped_Click()
cmdSave.Enabled = True
lstShipping.Enabled = False
If chkShipped = vbChecked Then
mstrSDate = Date
Else
mstrSDate = ""
End If
End Sub
Private Sub cmdDelete_Click()
On Error GoTo Error_EH
moRSBill!shipped = vbChecked
moRSBill!done = vbChecked
moRSBill.Update
gintLOTID = Field2Str(moRSBill!Lot_id)
Call LotChange(moRSBill!ProjLot, "Delete An Invoice")
Call BillingLoad
cmdDelete.Enabled = False
Exit Sub
Error_EH:
gstrMODULE = "Form BillingStatus - Module BillingLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdMark_Click()
Dim intCnt As Integer
Dim strSQL As String, oRS As Recordset
mintBOOKMARK = 0
lstShipping.ListIndex = 0
strSQL = "SELECT * FROM tblARInvoice WHERE inv_type = '" & mstrType & "' and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
Do Until mintBOOKMARK + 1 > lstShipping.ListCount
Do Until oRS.EOF
With oRS
!invoice_date = DateAdd("d", 3, Str2Field(txtShippingDate))
!ship_date = Str2Field(txtShippingDate)
!shipped = chkShipped
!sh_date = Str2Field(mstrSDate)
.Update
End With
oRS.MoveNext
Loop
Call BillingLoad
If FormFind() Then
Call FormShow
Else
Call FormClear
End If
''' moRSUpdate!ready = vbChecked
''' moRSUpdate.Update
''' If mintBOOKMARK < lstPOItems.ListCount Then
''' lstPOItems.ListIndex = mintBOOKMARK + 1
''' mintBOOKMARK = mintBOOKMARK + 1
''' End If
Loop
''' Call POLoad
''' lstPOItems.ListIndex = lstPOItems.ListCount - 1
'' mintBOOKMARK = lstShipping.ListIndex
'' lstShipping.ListIndex = 0
'' Do Until lstShipping.ListIndex = lstShipping.ListCount - 1
'' chkShipped = vbChecked
'' Loop
'' cmdSave.Enabled = False
'' cmdDelete.Enabled = False
'' lstShipping.Enabled = True
'' lstShipping.ListIndex = mintBOOKMARK
End Sub
Private Sub cmdPrint_Click()
Dim strPDate As String, strSQL As String
strPDate = InputBox("Enter The Invoice Release Date to Print - (MMDDYYYY)", "Print Invoice List")
If Len(strPDate) > 0 Then
strPDate = Format(strPDate, "00/00/####")
If Not IsDate(strPDate) Then
MsgBox "The Date You Entered is not Valid & No Report Will Print - ReEnter", vbOKOnly, "Invalid Date"
Exit Sub
Else
gintPRINT = 9
frmReport.Show 1
' strSQL = "{tblReport.lot_id} = " & gintLOTID & " and {tblLOTINFO.lot_id} = " & gintLOTID
strSQL = "{tblARINVOICE.SH_DATE}=Date (" & Format(strPDate, "YYYY,MM,DD") & ")"
crShipped.ReportFileName = App.Path & "\InvoiceList.rpt"
crShipped.ReplaceSelectionFormula (strSQL)
' crshipped.Destination = crptToWindow
' crshipped.Destination = crptToPrinter
crShipped.Destination = gintDEST
crShipped.CopiesToPrinter = gintCOPY
crShipped.Action = 1
Exit Sub
End If
End If
End Sub
Private Sub cmdSave_Click()
mintBOOKMARK = lstShipping.ListIndex
Call FormSave
cmdSave.Enabled = False
cmdDelete.Enabled = False
lstShipping.Enabled = True
lstShipping.ListIndex = mintBOOKMARK
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 4 Then
Exit Sub
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Form_Load()
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
Call BillingLoad
If FormFind() Then
Call FormShow
Else
Call FormClear
End If
Exit Sub
Error_EH:
gstrMODULE = "Form BillingStatus - Module Form_Load"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String, strPlan As String, strMEMO As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblARInvoice "
strSQL = strSQL & "WHERE Trans_id = " & mlngTRANSID
Set moRSBill = New Recordset
moRSBill.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If moRSBill.EOF Then
FormFind = False
Else
FormFind = True
gintLOTID = Field2Str2(moRSBill!Lot_id)
mstrType = Field2Str(moRSBill!inv_type)
End If
Exit Function
Error_EH:
gstrMODULE = "Form BillingStatus - Module FormFind"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub FormShow()
Dim strTYPE As String
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
lblData.Caption = ""
' If gbytSECURITY = 7 Then
' chkShipped.Enabled = False
' txtShippingDate.Enabled = False
' End If
mboolSHOW = True
txtShippingDate = Field2Str(moRSBill!ship_date)
If moRSBill!inv_type = "L" Then
strTYPE = "LATH"
ElseIf moRSBill!inv_type = "S" Then
strTYPE = "STUCCO"
ElseIf moRSBill!inv_type = "C" Then
strTYPE = "COMPLETE"
End If
lblData = Field2Str(moRSBill!ProjLot) & " - " & strTYPE
lblAmount = "Invoice Date - " & Field2Str(moRSBill!invoice_date) & " Inv. Amt. " & Format(Field2Str(moRSBill!non_tax_amt), "currency")
chkShipped = Field2CheckBox(moRSBill!shipped)
mboolSHOW = False
Exit Sub
Error_EH:
gstrMODULE = "Form BillingStatus - Module FormShow"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FieldsSave()
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblARInvoice WHERE inv_type = '" & mstrType & "' and lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
Do Until oRS.EOF
With oRS
!invoice_date = DateAdd("d", 3, Str2Field(txtShippingDate))
!ship_date = Str2Field(txtShippingDate)
!shipped = chkShipped
!sh_date = Str2Field(mstrSDate)
.Update
End With
oRS.MoveNext
Loop
Call BillingLoad
If FormFind() Then
Call FormShow
Else
Call FormClear
End If
Exit Sub
Error_EH:
gstrMODULE = "Form BillingStatus - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormClear()
txtShippingDate = ""
lblData = ""
lblAmount = ""
chkShipped = vbUnchecked
End Sub
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
' Store the controls to the recordset
Call FieldsSave
Call BillingLoad
Exit Sub
Error_EH:
gstrMODULE = "Form BillingStatus - Module FormSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If moRSBill.State = adStateOpen Then
moRSBill.Close
End If
End Sub
Private Sub lstShipping_Click()
On Error GoTo Error_EH
If lstShipping.ListIndex <> -1 Then
' mlngTRANSID = lstShipping.ItemData(lstShipping.ListIndex)
lstShipping.col = 0
mlngTRANSID = lstShipping.ColText
If FormFind() Then
Call FormShow
Else
Call FormClear
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form BillingStatus - Module lstShipping_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstShipping_DblClick()
If lstShipping.ListIndex <> -1 Then
If gbytSECURITY < 3 Then
cmdDelete.Enabled = True
mlngTRANSID = lstShipping.ItemData(lstShipping.ListIndex)
End If
End If
End Sub
Private Sub txtShippingDate_GotFocus()
mstrCHECK = Field2Str(txtShippingDate)
Call FieldSelect(txtShippingDate)
End Sub
Private Sub txtShippingDate_KeyPress(KeyAscii As Integer)
If mstrCHECK <> Field2Str(txtShippingDate) Then
cmdSave.Enabled = True
lstShipping.Enabled = False
End If
End Sub
Private Sub txtShippingDate_LostFocus()
Dim lngPOS As Long
If Not IsDate(txtShippingDate) Then
lngPOS = InStr(1, txtShippingDate, "/", 1)
If lngPOS = 0 Then
If Len(txtShippingDate) > 0 Then
txtShippingDate = Format(txtShippingDate, "00/00/####")
If Not IsDate(txtShippingDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtShippingDate.SetFocus
End If
End If
Else
MsgBox "Invalid Date Format, Enter as 12312009", , "Invalid Date - ReEnter"
txtShippingDate.SetFocus
End If
End If
End Sub