azcomputerguru/claudetools
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
claudetools/clients/valleywide/app-modernization/source-code/Full-Project/VWP_Inv/frmInvPrice.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

867 lines
23 KiB
Plaintext
Raw Permalink Blame History

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 frmInvPrice
Caption = "Supplier Inventory Prices"
ClientHeight = 5265
ClientLeft = 60
ClientTop = 345
ClientWidth = 11880
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 5265
ScaleWidth = 11880
StartUpPosition = 3 'Windows Default
Begin LpLib.fpList lstInv
Height = 2160
Left = 120
TabIndex = 16
Top = 2910
Visible = 0 'False
Width = 3075
_Version = 196608
_ExtentX = 5424
_ExtentY = 3810
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 = 0 'False
BackColor = -2147483643
ForeColor = -2147483640
Columns = 2
Sorted = 0
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = 0
ColumnWidthScale= 2
RowHeight = -1
MultiSelect = 0
WrapList = 0 'False
WrapWidth = 0
SelMax = -1
AutoSearch = 1
SearchMethod = 1
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= 210
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmInvPrice.frx":0000
End
Begin LpLib.fpList lstInventory
Height = 4680
Left = 3240
TabIndex = 15
Top = 435
Width = 4170
_Version = 196608
_ExtentX = 7355
_ExtentY = 8255
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 = 0 'False
BackColor = -2147483643
ForeColor = -2147483640
Columns = 3
Sorted = 1
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = 0
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= 210
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmInvPrice.frx":029E
End
Begin VB.CommandButton cmdPrint
Caption = "Print Inv List"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 7590
TabIndex = 14
Top = 2400
Width = 1155
End
Begin Crystal.CrystalReport crInvList
Left = 10290
Top = -15
_ExtentX = 741
_ExtentY = 741
_Version = 348160
PrintFileLinesPerPage= 60
End
Begin VB.CommandButton cmdExit
Caption = "&Exit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 9112
TabIndex = 13
Top = 2400
Width = 1155
End
Begin VB.CommandButton cmdDeleteInv
Caption = "&Delete Inventory"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 10635
TabIndex = 12
Top = 1740
Width = 1155
End
Begin VB.CommandButton cmdSaveInv
Caption = "&Save Inventory"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 9112
TabIndex = 10
Top = 1740
Width = 1155
End
Begin VB.CommandButton cmdAddInv
Caption = "&Add Inventory"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 7590
TabIndex = 11
Top = 1740
Width = 1155
End
Begin VB.CommandButton cmdFindInv
Height = 435
Left = 10965
Picture = "frmInvPrice.frx":0584
Style = 1 'Graphical
TabIndex = 7
Top = 360
Visible = 0 'False
Width = 435
End
Begin VB.TextBox txtPrice
Alignment = 1 'Right Justify
Height = 315
Left = 8235
MaxLength = 8
TabIndex = 9
Top = 1260
Width = 855
End
Begin VB.TextBox txtDesc
Height = 315
Left = 8235
MaxLength = 30
TabIndex = 8
Top = 840
Width = 3555
End
Begin VB.TextBox txtInvNo
Height = 315
Left = 8235
MaxLength = 15
TabIndex = 6
Top = 420
Width = 2625
End
Begin VB.ListBox lstSupplier
Height = 2400
Left = 120
Sorted = -1 'True
TabIndex = 0
Top = 420
Width = 3075
End
Begin VB.Label lblPrice
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "VWP Cost:"
Height = 195
Left = 7440
TabIndex = 5
Top = 1305
Width = 780
End
Begin VB.Label lblDesc
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Descptn:"
Height = 195
Left = 7575
TabIndex = 4
Top = 900
Width = 645
End
Begin VB.Label lblInvNo
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Invtry #:"
Height = 195
Left = 7635
TabIndex = 3
Top = 480
Width = 585
End
Begin VB.Label lblInventory
Caption = "Inventory Items"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3300
TabIndex = 2
Top = 120
Width = 1815
End
Begin VB.Label lblSupplier
Caption = "Supplier"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 180
TabIndex = 1
Top = 120
Width = 1095
End
End
Attribute VB_Name = "frmInvPrice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSMat As Recordset
Dim mboolSHOW As Boolean
Dim mboolAdding As Boolean
Private Sub LoadInventory()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT Inv_no, Desc, Price from tblInvPrice WHERE sup_no = " & lstSupplier.ItemData(lstSupplier.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstInventory.Clear
Do Until oRS.EOF
With lstInventory
strLine = oRS!inv_no & vbTab & Format$(Field2Str(oRS!price), "##,##0.00") & vbTab & oRS!Desc
.AddItem strLine
' .ItemData(.NewIndex) = oRS!inv_no
End With
oRS.MoveNext
Loop
oRS.Close
If lstInventory.ListCount Then
lstInventory.ListIndex = 0
End If
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub LoadSupplier()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblSupplier WHERE type <> 'A'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstSupplier.Clear
Do Until oRS.EOF
With lstSupplier
strLine = oRS!Type & vbTab & oRS!supplier
.AddItem strLine
.ItemData(.NewIndex) = oRS!sup_no
End With
oRS.MoveNext
Loop
oRS.Close
If lstSupplier.ListCount Then
lstSupplier.ListIndex = 0
End If
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub cmdFindInv_Click()
Dim oRS As Recordset
Dim strSQL As String, lngFind As String
'*** FIX On Error GoTo Error_EH
strSQL = "SELECT * from tblInvtry WHERE Inv_no = '" & txtInvNo.Text & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If oRS.RecordCount > 0 Then
With oRS
txtInvNo = Field2Str(!inv_no)
txtDesc = Field2Str(!Desc)
txtPrice.SetFocus
End With
Else
lstInv.Visible = True
Call LoadMInventory
lngFind = Field2Str(txtInvNo)
Call ListFindItem2(lstInv, lngFind)
End If
oRS.Close
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub LoadMInventory()
Dim oRS As Recordset
Dim strSQL As String ', strInvNo As String
Dim strLine As String
On Error GoTo Error_EH
' lstInv.col = 0
' strInvNo = lstInv.ColText
strSQL = "SELECT Inv_no, Desc from tblInvtry"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstInv.Clear
Do Until oRS.EOF
With lstInv
strLine = oRS!inv_no & vbTab & oRS!Desc
.AddItem strLine
' .ItemData(.NewIndex) = oRS!inv_no
End With
oRS.MoveNext
Loop
oRS.Close
If lstInv.ListCount Then
lstInv.ListIndex = -1
End If
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub FormClear()
txtInvNo = ""
txtDesc = ""
txtPrice = ""
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String, strINVNO As String
On Error GoTo Error_EH
' lstInventory.col = 0
' strINVNO = lstInventory.ColText
strSQL = "SELECT * FROM tblInvPrice WHERE Sup_no = " & lstSupplier.ItemData(lstSupplier.ListIndex) & " AND INV_NO = '" & strINVNO & "'"
If moRSMat.State = adStateOpen Then
moRSMat.Close
End If
moRSMat.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If moRSMat.EOF Then
FormFind = False
Else
FormFind = True
End If
Exit Function
Error_EH:
moRSMat.Update
Resume Next
End Function
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
If mboolAdding Then
moRSMat.AddNew
End If
' Store the controls to the recordset
Call FieldsSave
moRSMat.Update
If mboolAdding Then
mboolAdding = False
End If
Exit Sub
Error_EH:
Call ErrorHandler(moRSMat.ActiveConnection)
Exit Sub
End Sub
Private Sub FormShow()
On Error GoTo Error_EH
mboolSHOW = True
With moRSMat
txtInvNo = Field2Str(!inv_no)
txtDesc = Field2Str(!Desc)
txtPrice = Format$(Field2Str(!price), "##,###.00")
End With
mboolSHOW = False
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub FieldsSave()
On Error GoTo Error_EH
With moRSMat
!inv_no = Str2Field(UCase(txtInvNo))
!Desc = Str2Field(txtDesc)
!price = Str2Field(txtPrice)
!sup_no = lstSupplier.ItemData(lstSupplier.ListIndex)
!l_update = Now()
!LUUser = gstrLOGIN
End With
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub cmdAddInv_Click()
cmdAddInv.Enabled = False
cmdSaveInv.Enabled = True
cmdDeleteInv.Enabled = False
mboolAdding = True
Call FormClear
txtInvNo.SetFocus
cmdFindInv.Visible = True
End Sub
Private Sub cmdDeleteInv_Click()
cmdDeleteInv.Enabled = False
cmdSaveInv.Enabled = False
cmdAddInv.Enabled = True
moRSMat.Delete
Call LoadInventory
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdPrint_Click()
Dim strSQL As String, strMSG As String, strSql2 As String
Dim oRS As Recordset, intResponse As Integer
strSQL = "SELECT * FROM tblInvPrice WHERE Sup_No = " & lstSupplier.ItemData(lstSupplier.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
' intCount = oRS.RecordCount
strSql2 = "{tblinvprice.sup_no} = " & lstSupplier.ItemData(lstSupplier.ListIndex)
strMSG = "Do you want to print to the Printer?" & vbLf & vbCr
' strMSG = strMSG & intCount & " Checks did not match - Do You Want A Report"
intResponse = MsgBox(strMSG, vbYesNo, "Print to Printer")
gintCOPY = 1
crInvList.ReportFileName = App.Path & "\InvListByVendor.rpt"
crInvList.ReplaceSelectionFormula (strSql2)
If intResponse = vbYes Then
crInvList.Destination = crptToPrinter
Else
crInvList.Destination = crptToWindow
End If
crInvList.CopiesToPrinter = gintCOPY
crInvList.WindowState = crptMaximized
crInvList.Action = 1
crInvList.Reset
' Else
' Exit Sub
' End If
End Sub
Private Sub cmdSaveInv_Click()
cmdSaveInv.Enabled = False
cmdDeleteInv.Enabled = False
cmdAddInv.Enabled = True
cmdFindInv.Visible = False
Call FormSave
Call LoadInventory
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 4 Then
Exit Sub
End If
If Not cmdSaveInv.Enabled Then
cmdSaveInv.Enabled = True
cmdAddInv.Enabled = False
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()
Set moRSMat = New Recordset
Call LoadSupplier
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim intResponse As Integer, strMSG As String
On Error GoTo Error_EH
If cmdSaveInv.Enabled Then
strMSG = "Data Has Been Changed"
strMSG = strMSG & Chr(13) & Chr(10)
strMSG = strMSG & "Save Changes ?"
intResponse = MsgBox(strMSG, vbQuestion + vbYesNoCancel, Me.Caption)
Select Case intResponse
Case vbYes
Call FormSave
Case vbNo
Case vbCancel
Cancel = True
End Select
End If
If moRSMat.State = adStateOpen Then
moRSMat.Close
End If
Exit Sub
Error_EH:
If Err = 3219 Then
Resume Next
Else
End If
End Sub
Private Sub lstInv_DblClick()
Dim oRS As Recordset
Dim strSQL As String, strM_INVNO As String
On Error GoTo Error_EH
lstInv.col = 0
strM_INVNO = lstInv.ColText
strSQL = "SELECT Inv_no, Desc FROM tblInvtry where Inv_no = '" & strM_INVNO & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
With oRS
txtInvNo = Field2Str(!inv_no)
txtDesc = Field2Str(!Desc)
End With
oRS.Close
txtPrice.SetFocus
lstInv.Visible = False
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub lstInventory_Click()
On Error GoTo Error_EH
If lstInventory.ListIndex <> -1 Then
If FormFind() Then
Call FormShow
End If
End If
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub lstInventory_DblClick()
cmdSaveInv.Enabled = True
cmdDeleteInv.Enabled = True
cmdAddInv.Enabled = False
End Sub
Private Sub lstSupplier_Click()
On Error GoTo Error_EH
If lstSupplier.ListIndex <> -1 Then
Call LoadInventory
End If
Exit Sub
Error_EH:
Call ErrorHandler2
Exit Sub
End Sub
Private Sub txtDesc_GotFocus()
Call FieldSelect(txtDesc)
End Sub
Private Sub txtInvNo_GotFocus()
Call FieldSelect(txtInvNo)
End Sub
Private Sub txtInvNo_LostFocus()
txtInvNo = UCase(txtInvNo)
End Sub
Private Sub txtPrice_GotFocus()
Call FieldSelect(txtPrice)
End Sub
Reference in New Issue View Git Blame Copy Permalink