VERSION 5.00 Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX" Begin VB.Form Form1 Caption = "microMETER Capture 2002 v1.10" ClientHeight = 5295 ClientLeft = 60 ClientTop = 450 ClientWidth = 7680 Icon = "Form1.frx":0000 LinkTopic = "Form1" ScaleHeight = 5295 ScaleWidth = 7680 StartUpPosition = 3 'Windows Default Begin VB.CommandButton Command6 Caption = "Init" Height = 255 Left = 2520 TabIndex = 18 ToolTipText = "Initialize default support files when Obs # is cleared." Top = 3720 Width = 615 End Begin VB.ListBox List2 Height = 840 Left = 3360 TabIndex = 17 ToolTipText = "Alarm limits and status." Top = 4200 Width = 4215 End Begin VB.TextBox Text4 Height = 285 Left = 6840 TabIndex = 15 Text = "2000" ToolTipText = "Timing interval." Top = 3720 Width = 615 End Begin VB.TextBox Text3 Height = 285 Left = 5160 TabIndex = 14 Text = "1" ToolTipText = "Set number of complete observation sets (groups of 16)." Top = 3720 Width = 615 End Begin VB.CommandButton Command5 Caption = "End now" Height = 255 Left = 3360 TabIndex = 13 ToolTipText = "Stop processing without updating database." Top = 3720 Width = 855 End Begin VB.TextBox Text2 Height = 285 Left = 840 TabIndex = 10 ToolTipText = "Lines count." Top = 3720 Width = 615 End Begin VB.TextBox Text1 Height = 285 Left = 120 TabIndex = 9 Text = "mM01" ToolTipText = "Processor subdirectory and file marker (4 char)." Top = 3720 Width = 615 End Begin VB.DirListBox Dir1 Height = 1440 Left = 120 TabIndex = 7 ToolTipText = "Select subdirectory for processor to be read with double click." Top = 480 Width = 2175 End Begin VB.DriveListBox Drive1 Height = 315 Left = 120 TabIndex = 6 ToolTipText = "Select drive for processor to be read." Top = 120 Width = 2175 End Begin VB.CommandButton Command4 Caption = "Com4" Enabled = 0 'False Height = 375 Left = 2400 TabIndex = 4 ToolTipText = "Com port to read processor." Top = 1560 Width = 855 End Begin VB.CommandButton Command3 Caption = "Com3" Enabled = 0 'False Height = 375 Left = 2400 TabIndex = 3 ToolTipText = "Com port to read processor." Top = 1080 Width = 855 End Begin VB.CommandButton Command2 Caption = "Com2" Enabled = 0 'False Height = 375 Left = 2400 TabIndex = 2 ToolTipText = "Com port to read processor." Top = 600 Width = 855 End Begin VB.Timer Timer2 Left = 8280 Top = 1200 End Begin VB.Timer Timer1 Left = 8280 Top = 720 End Begin VB.CommandButton Command1 Caption = "Com1" Enabled = 0 'False Height = 375 Left = 2400 TabIndex = 1 ToolTipText = "Com port to read processor." Top = 120 Width = 855 End Begin VB.ListBox List1 Height = 3375 Left = 3360 TabIndex = 0 ToolTipText = "Processor data stream." Top = 120 Width = 4215 End Begin MSCommLib.MSComm MSComm1 Left = 120 Top = 4200 _ExtentX = 1005 _ExtentY = 1005 _Version = 393216 DTREnable = -1 'True RThreshold = 7 End Begin VB.Label Label6 Caption = "Obs #" Height = 255 Left = 4440 TabIndex = 19 Top = 3720 Width = 735 End Begin VB.Label Label5 Caption = "Interval" Height = 255 Left = 6120 TabIndex = 16 Top = 3720 Width = 615 End Begin VB.Label Label4 Height = 255 Left = 2280 TabIndex = 12 ToolTipText = "Obs counter." Top = 2640 Width = 735 End Begin VB.Label Label3 Height = 255 Left = 1680 TabIndex = 11 ToolTipText = "Processor type." Top = 3720 Width = 615 End Begin VB.Label Label2 Height = 255 Left = 2400 TabIndex = 8 Top = 2640 Width = 615 End Begin VB.Label Label1 Appearance = 0 'Flat BackColor = &H80000004& ForeColor = &H80000008& Height = 255 Left = 360 TabIndex = 5 ToolTipText = "Progress template." Top = 2640 Width = 2055 End Begin VB.Shape Shape1 BackStyle = 1 'Opaque Height = 1455 Left = 120 Top = 2040 Width = 3135 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False 'CAP2002 - (c) Ozona Systems 2002 Dim cnt1, cnt2, cnt3, cnt4, sw1 As Integer Dim rec1S, rec2S, rec3S, rec4S, CTCAP, MICRO2CAP, FileNameS As String Dim BK(17), PF(17), LV(17) As Single Dim LL(17), HL(17) As Single Dim CKTS(17) As String Dim SCAL, SCA2, PRICE, COL, C00 As Single Private Sub getfilename() file1FileName = "" If (Right$(Dir1.Path, 1) = "\") Then FileNameS = Dir1.Path + file1FileName Else FileNameS = Dir1.Path + "\" + file1FileName End If Text1 = Left$(Right$(FileNameS, 5), 4) sw1 = 0 'mM1 or 2 End Sub Private Sub setport() If MSComm1.PortOpen = True Then MSComm1.PortOpen = False MSComm1.Settings = "300,N,8,1" Shape1.BackColor = vbRed Label1.Caption = "Please wait 3 minutes" LoadSetup1 'scal LoadSetup2 'ct LoadSetup3 'txt End Sub Private Sub Command1_Click() getfilename setport MSComm1.CommPort = 1: MSComm1.PortOpen = True End Sub Private Sub Command2_Click() getfilename setport MSComm1.CommPort = 2: MSComm1.PortOpen = True End Sub Private Sub Command3_Click() getfilename setport MSComm1.CommPort = 3: MSComm1.PortOpen = True End Sub Private Sub Command4_Click() getfilename setport MSComm1.CommPort = 4: MSComm1.PortOpen = True End Sub Private Sub Command5_Click() 'stops the program 'sends a control code before exit x = Val(Text3.Text) If x < 0 Then x = 0 If x > 255 Then x = 255 y = Chr$(x) MSComm1.Output = "AT CAP2002:" & y & Chr$(13) & Chr$(10) Text3 = 0 If cnt4 < 1 Then Timer1.Enabled = False If MSComm1.PortOpen = True Then MSComm1.PortOpen = False End End If End Sub Private Sub Command6_Click() If Val(Text3.Text) > 0 Then List2.AddItem ("invalid operation") Exit Sub End If getfilename InitSetup1 'scal InitSetup2 'ct InitSetup3 'txt List2.AddItem ("files created") End Sub Private Sub Drive1_Change() Dir1.Path = Drive1.Drive End Sub Private Sub Dir1_Change() Command1.Enabled = True Command2.Enabled = True Command3.Enabled = True Command4.Enabled = True End Sub Private Sub File1_Change() 'Command1.Enabled = True 'Command2.Enabled = True 'Command3.Enabled = True 'Command4.Enabled = True End Sub Private Sub Form_Load() cnt1 = 0: cnt2 = 0: cnt3 = 0: cnt4 = 0 rec1S = "": CTCAP = "": MICRO2CAP = "" End Sub Private Sub MSComm1_OnComm() 'MSComm1 runs Timer1, Timer1 runs Process1, Process1 runs Process2 'after 16 reads. Stop pgm with End statement. 'Beep Timer1.Interval = Val(Text4) '2000 dad's pc has problem Timer1.Enabled = True cnt4 = Val(Text3) End Sub Private Sub Timer1_Timer() Timer1.Enabled = False If cnt3 > 0 Then Process1 Else List1.AddItem ("sync ") Shape1.BackColor = vbYellow c1$ = MSComm1.Input 'discard 1st End If cnt3 = cnt3 + 1 'absolute count End Sub Private Sub Process1() 'every 10 seconds cnt1 = cnt1 + 1 'all but first read a1$ = "mM01" + Mid$(Date$, 7, 4) + Mid$(Date$, 1, 2) + Mid$(Date$, 4, 2) a3$ = Mid$(Time$, 1, 2) + Mid$(Time$, 4, 2) + Mid$(Time$, 7, 2) c1$ = MSComm1.Input 'A little Fortran-style formatting Open FileNameS + "cp.txt" For Output As 1 Print #1, c1$ Print #1, c1$ 'stupid MS bug Close 1 '16,255,99999,99999 = 18 max mM 1 '1,0,0,0,0,0,0,10000 = 19 min mM 2 If Len(c1$) > 18 Then sw1 = 1 If sw1 = 0 Then Label3 = "mMI" If sw1 = 1 Then Label3 = "mMII" Open FileNameS + "cp.txt" For Input As 1 If sw1 = 0 Then Input #1, a, b, c, d If sw1 = 1 Then Input #1, a, b, c, d, e, f, g, h Close 1 'fix stupid MS bug - "a" comes in empty almost every time in a set of 16 If sw1 = 1 And h < 10000 Then a = b: b = c: c = d: d = e: e = f: f = g: g = h: h = 11111 End If ast = Mid(Str$(a), 2, Len(Str$(a))) bst = Mid(Str$(b), 2, Len(Str$(b))) cst = Mid(Str$(c), 2, Len(Str$(c))) dst = Mid(Str$(d), 2, Len(Str$(d))) If sw1 = 1 Then est = Mid(Str$(e), 2, Len(Str$(e))) fst = Mid(Str$(f), 2, Len(Str$(f))) gst = Mid(Str$(g), 2, Len(Str$(g))) hst = Mid(Str$(h), 2, Len(Str$(h))) Else est = "000" fst = "00000" gst = "00000" hst = "00000" End If For i = 1 To 5 If Len(ast) < 2 Then ast = "0" + ast If Len(bst) < 3 Then bst = "0" + bst If Len(cst) < 5 Then cst = "0" + cst If Len(dst) < 5 Then dst = "0" + dst If Len(est) < 3 Then est = "0" + est If Len(fst) < 5 Then fst = "0" + fst If Len(gst) < 5 Then gst = "0" + gst If Len(hst) < 5 Then hst = "0" + hst Next i If sw1 = 0 Then c1$ = ast + "," + bst + "," + cst + "," + dst If sw1 = 1 Then c1$ = ast + "," + bst + "," + cst + "," + dst + "," + est + "," + fst + "," + gst + "," + hst c2$ = c1$ List1.AddItem (c2$) 'build database entry rec1S = rec1S + "," + c2$ 'have to use S instead of $ for strings when using functions rec2$ = a1$ + a3$ + "" + rec1S Text2 = cnt1 CTCAP = CTCAP + Mid$(c2$, 1, 18) + Chr$(13) + Chr$(10) MICRO2CAP = MICRO2CAP + Time$ + " " + Date$ + Chr$(13) + Chr$(10) If cnt1 = 15 Then Shape1.BackColor = vbGreen Label1.Caption = " Update pending ... " End If If cnt1 = 16 Then rec2S = rec2$ Process2 Writefiles Shape1.BackColor = vbGreen Label1.Caption = "We have a good reading " cnt1 = 0 cnt2 = cnt2 + 1 'groups of 16 Label4 = cnt2 rec1S = "": CTCAP = "": MICRO2CAP = "" If cnt4 > 0 Then cnt4 = cnt4 - 1 Text3 = cnt4 End If Beep 'For i = 1 To 10000: Next i End If If cnt4 < 1 Then Command5_Click 'stop the program End If 'alarm limits i = a If LL(i) > 0 And b > LL(i) Then MSComm1.Output = "AT CAP2002 Channel High:" & ast & Chr$(13) & Chr$(10) List2.AddItem (ast & " high " & a1$ & a3$) Open FileNameS + "alarmlog.txt" For Append As 1 Print #1, ast & " high " & a1$ & a3$ Close 1 End If If HL(i) < 254 And b < HL(i) Then MSComm1.Output = "AT CAP2002 Channel Low :" & ast & Chr$(13) & Chr$(10) List2.AddItem (ast & " low " & a1$ & a3$) Open FileNameS + "alarmlog.txt" For Append As 1 Print #1, ast & " low " & a1$ & a3$ Close 1 End If End Sub Private Sub Process2() 'have to use S instead of $ for strings when using some functions 'mM0120020909131542,05,010,38979,00028,06,174,50596,00231, 14 more groups 're-order rec2S as rec3S 'mM0120020909131542,01,010,38979,00028,02,174,50596,00231, 14 more groups 'mM0120020909131542,01,010,38979,00028,010,38979,00028,10000, 15 more groups mMII d1 = 19: d2 = 19 'header length, reading length If sw1 = 1 Then d2 = 41 rec3S = rec2S + " " For j = 1 To 16 For i = 1 To 16 i2$ = Trim(Str(j)) If Len(i2$) < 2 Then i2$ = "0" + i2$ End If d = d1 + (i - 1) * d2 + 1 e = d1 + (j - 1) * d2 + 1 If Mid$(rec2S, d, 2) = i2$ Then Mid$(rec3S, e, d2) = Mid$(rec2S, d, d2) End If Next i Next j Mid$(rec3S, 1, 4) = Mid$(Text1, 1, 4) End Sub Private Sub Writefiles() 'add new reading to database '540 rec/day 322 byte/rec rec len 323 ends w , 'mM0120020909131542,01,010,38979,00028,02,174,50596,00231, 14 more groups Open FileNameS + "mm.db1" For Append As 1 Print #1, rec3S Close 1 'maintain legacy files Open FileNameS + "ct.cap" For Output As 1 Print #1, Mid$(CTCAP, 1, 320) Close 1 Open FileNameS + "usage.cap" For Append As 1 Print #1, Mid$(CTCAP, 1, 318) 'drop x crlf Close 1 Open FileNameS + "micro2.cap" For Output As 1 Print #1, Mid$(MICRO2CAP, 1, 336) Close 1 End Sub Private Sub LoadSetup1() On Error GoTo skip1 Open FileNameS + "micro.dat" For Input As 1 Input #1, SCAL Input #1, SCA2 Input #1, PRICE Input #1, COL Input #1, C00, C01, C02, C03 Input #1, C04, C05, C06, C07 'Input #1, C2, C3 Close 1 Exit Sub skip1: Text2 = "Problem with file micro.dat" End Sub Private Sub LoadSetup2() On Error GoTo skip1 Open FileNameS + "ct.dat" For Input As 1 'BK=breaker PF=power factor LV=line voltage 'LL=low limit HL=high limit For i = 1 To 16 Line Input #1, rec4S CKTS(i) = Mid$(rec4S, 1, 25) BK(i) = Val(Mid$(rec4S, 27, 4)) PF(i) = Val(Mid$(rec4S, 32, 4)) LV(i) = Val(Mid$(rec4S, 37, 3)) LL(i) = Val(Mid$(rec4S, 41, 4)) HL(i) = Val(Mid$(rec4S, 45, 3)) If LV(i) = 0 Then LV(i) = 120 Next i Close 1 Exit Sub skip1: Text2 = "Problem with file ct.dat" End Sub Private Sub LoadSetup3() On Error GoTo skip1 Open FileNameS + "micro.txt" For Input As 1 Line Input #1, CoNameS Close 1 Exit Sub skip1: Text2 = "Problem with file micro.txt" End Sub Private Sub InitSetup1() On Error GoTo skip1 Open FileNameS + "micro.dat" For Output As 1 Print #1, " 12.75 " Print #1, " 2516.447 " Print #1, " 6.95 " Print #1, " 1 " Print #1, " 0 1 2 3 " Print #1, " 4 5 6 7 " Print #1, " 7 7 0 0 " Close 1 Exit Sub skip1: Text2 = "Problem creating file micro.dat" End Sub Private Sub InitSetup2() On Error GoTo skip1 Open FileNameS + "ct.dat" For Output As 1 Print #1, " 1 - ,0020,1.00,120,000,999 ." Print #1, " 2 - ,0020,1.00,120,000,999 ." Print #1, " 3 - ,0020,1.00,120,000,999 ." Print #1, " 4 - ,0020,1.00,120,000,999 ." Print #1, " 5 - ,0020,1.00,120,000,999 ." Print #1, " 6 - ,0020,1.00,120,000,999 ." Print #1, " 7 - ,0020,1.00,120,000,999 ." Print #1, " 8 - ,0020,1.00,120,000,999 ." Print #1, " 9 - ,0020,1.00,120,000,999 ." Print #1, " 10 - ,0020,1.00,120,000,999 ." Print #1, " 11 - ,0020,1.00,120,000,999 ." Print #1, " 12 - ,0020,1.00,120,000,999 ." Print #1, " 13 - ,0020,1.00,120,000,999 ." Print #1, " 14 - ,0020,1.00,120,000,999 ." Print #1, " 15 - ,0020,1.00,120,000,999 ." Print #1, " 16 - ,0020,1.00,120,000,999 ." Close 1 Exit Sub skip1: Text2 = "Problem creating file ct.dat" End Sub Private Sub InitSetup3() On Error GoTo skip1 Open FileNameS + "micro.txt" For Output As 1 Print #1, " microMETER Corp. " Print #1, " " Print #1, " Energy usage charges due and payable for the period ending. " Print #1, " Taxes and customer charges have been added proportionately. " Print #1, " Thank you for your prompt payment. " Print #1, " Customer Billing Period Usage Amount Due " Print #1, " Rate: Non-demand, Non-TOU - Customer chg incl. @ xxxx cts/kwh " Close 1 Exit Sub skip1: Text2 = "Problem creating file micro.txt" End Sub VERSION 5.00 Begin VB.Form Form1 Caption = "microMETER Display 2002 v1.14" ClientHeight = 5295 ClientLeft = 60 ClientTop = 450 ClientWidth = 7680 Icon = "Form1.frx":0000 LinkTopic = "Form1" ScaleHeight = 5295 ScaleWidth = 7680 StartUpPosition = 3 'Windows Default Begin VB.PictureBox Picture1 BorderStyle = 0 'None Height = 855 Left = 4200 Picture = "Form1.frx":0442 ScaleHeight = 855 ScaleWidth = 3135 TabIndex = 17 Top = 4080 Width = 3135 End Begin VB.Timer Timer3 Enabled = 0 'False Interval = 9999 Left = 5640 Top = 3600 End Begin VB.Timer Timer2 Enabled = 0 'False Interval = 9999 Left = 5040 Top = 3600 End Begin VB.Timer Timer1 Enabled = 0 'False Interval = 9999 Left = 4440 Top = 3600 End Begin VB.CommandButton Command3 Caption = "refresh" Enabled = 0 'False Height = 255 Left = 4200 TabIndex = 15 Top = 3240 Width = 975 End Begin VB.CheckBox Check3 Caption = "graphics" Height = 255 Left = 120 TabIndex = 14 ToolTipText = "check before directory is selected" Top = 4080 Width = 975 End Begin VB.ListBox List3 Height = 1425 Left = 1800 TabIndex = 13 Top = 3600 Width = 2175 End Begin VB.CheckBox Check2 Caption = "true power" Height = 375 Left = 120 TabIndex = 12 ToolTipText = "uncheck for mMII kva" Top = 3600 Value = 1 'Checked Width = 1095 End Begin VB.CommandButton Command2 Caption = "ie browser" Enabled = 0 'False Height = 255 Left = 3000 TabIndex = 10 Top = 3240 Width = 975 End Begin VB.CheckBox Check1 Caption = "html" Height = 255 Left = 120 TabIndex = 9 ToolTipText = "uncheck for plaintext" Top = 3240 Value = 1 'Checked Width = 615 End Begin VB.TextBox Text2 Height = 375 Left = 120 TabIndex = 6 ToolTipText = "To record header" Top = 2760 Width = 7215 End Begin VB.TextBox Text1 Height = 375 Left = 120 TabIndex = 5 ToolTipText = "From record header" Top = 2400 Width = 7215 End Begin VB.CommandButton Command1 Caption = "mm.htm" Enabled = 0 'False Height = 255 Left = 1800 TabIndex = 4 Top = 3240 Width = 975 End Begin VB.ListBox List2 Height = 1815 Left = 5040 TabIndex = 3 ToolTipText = "Select to date" Top = 120 Width = 2175 End Begin VB.ListBox List1 Height = 1815 Left = 2760 TabIndex = 2 ToolTipText = "Select from date" Top = 120 Width = 2175 End Begin VB.DirListBox Dir1 Height = 1440 Left = 120 TabIndex = 1 ToolTipText = "Choose processor directory" Top = 480 Width = 2535 End Begin VB.DriveListBox Drive1 Height = 315 Left = 120 TabIndex = 0 ToolTipText = "Choose drive" Top = 120 Width = 2535 End Begin VB.Label Label4 Height = 255 Left = 1080 TabIndex = 16 ToolTipText = "Records scanned" Top = 2040 Width = 735 End Begin VB.Label Label3 Height = 255 Left = 120 TabIndex = 11 ToolTipText = "Detect processor type" Top = 2040 Width = 615 End Begin VB.Label Label2 Caption = "Select to date." Height = 255 Left = 5040 TabIndex = 8 Top = 2040 Width = 2175 End Begin VB.Label Label1 Caption = "Select from date." Height = 255 Left = 2760 TabIndex = 7 Top = 2040 Width = 2175 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False 'DIS2002 - (c) Ozona Systems 2002 Dim cnt1, cnt2, cnt3, sw1, d1, d2, lowv, amin, amax As Integer Dim A(65), B(65), C(65), D(65) As Single Dim E(65), F(65), G(65), H(65) As Single 'T-kvarh U-kvah V-pf W-amps X-kw Y-kwh Z-cost '65=ch1-16,totals17,3addl procecessors-48ch Dim T(65), U(65), V(65) As Single Dim W(65), X(65), Y(65), Z(65) As Single Dim G0(550, 17) As Single 'graphic Dim G1(3, 17) As Single 'graphic min,minnz,max Dim G2(3, 17) As String 'datetime Dim BK(65), PF(65), LV(65) As Single Dim LL(65), HL(65) As Single Dim CKTS(65), FORMATS, FF1, FF2, FF3, TD1, TD2, TD3 As String Dim SCAL, SCA2, PRICE, COL, C00 As Single Dim V18 As Single Dim I16, I17 As Integer Dim Q$, rec1S, rec2S, rec3S, CoNameS As String Dim CTCAP, MICRO2CAP, FileNameS As String Private Sub Command1_Click() 'calcs and main line List3.AddItem ("1") W(I17) = 0: X(I17) = 0: Y(I17) = 0: Z(I17) = 0 'clear totals T(I17) = 0: U(I17) = 0: V(I17) = 0 For i = 1 To I16 'mM0120020909131542,01,010,38979,00028,02,174,50596,00231, 14 more groups 'mM0120020909131542,01,010,38979,00028,010,38979,00028,10000, 15 more groups mMII List3.AddItem ("2 " + Str(i)) j = (i - 1) * d2 + d1 k = j If sw1 = 1 Then k = j + 16 '22 On Error GoTo skip1 'A=tp demand beancount B=low bucket C=high bucket D=accrued beancount 'E=ap demand beancount F=low bucket G=high bucket H=accrued beancount A(i) = Mid$(Text2.Text, j + 4, 3) B(i) = Mid$(Text2.Text, j + 8, 5) - Mid$(Text1.Text, j + 8, 5) C(i) = Mid$(Text2.Text, j + 14, 5) - Mid$(Text1.Text, j + 14, 5) D(i) = B(i) + C(i) * 65536 E(i) = Mid$(Text2.Text, k + 4, 3) F(i) = Mid$(Text2.Text, k + 8, 5) - Mid$(Text1.Text, k + 8, 5) G(i) = Mid$(Text2.Text, k + 14, 5) - Mid$(Text1.Text, k + 14, 5) H(i) = F(i) + G(i) * 65536 If sw1 = 1 And Check2.Value = 0 Then A(i) = E(i) 'use ap demand D(i) = H(i) 'use ap usage End If Next i List3.AddItem ("3 " + Str(i)) LoadSetup1 'scal List3.AddItem ("4 " + Str(i)) LoadSetup2 'ct List3.AddItem ("5 " + Str(i)) LoadSetup3 'txt List3.AddItem ("6 " + Str(i)) 'apply scaling lowv = 0.05 For i = 1 To I16 List3.AddItem ("7 " + Str(i)) 'T-kvarh U-kvah V-pf W-amps X-kw Y-kwh Z-cost W(i) = A(i) / SCAL * BK(i) / 20 X(i) = W(i) * PF(i) * LV(i) / 1000 Y(i) = (D(i) / SCA2 * BK(i) / 20 * PF(i) * LV(i) / 120): 'Scale to kwh U(i) = (H(i) / SCA2 * BK(i) / 20 * PF(i) * LV(i) / 120): 'Scale to kwh Z(i) = PRICE * Y(i) / 100 V(i) = D(i) / (H(i) + lowv) diff = (U(i) * U(i) - Y(i) * Y(i)) T(i) = 0 If diff > 0 Then T(i) = Sqr(diff) If C00 = 2 Then ' mMI anal pairs ap,tp 'T-kvarh U-kvah V-pf W-amps X-kw Y-kwh Z-cost 'ckt, a w/v, kva kw dem, kwh, kvah, kvarh, $, % If Int(i / 2) = i / 2 Then 'even CKTS(i) = "true power " V(i) = D(i) / (D(i - 1) + lowv) diff = (Y(i - 1) * Y(i - 1) - Y(i) * Y(i)) T(i) = 0 If diff > 0 Then T(i) = Sqr(diff) End If End If If T(i) < lowv Then T(i) = 0 If U(i) < lowv Then U(i) = 0 If V(i) < lowv Then V(i) = 0 If W(i) < lowv Then W(i) = 0 If X(i) < lowv Then X(i) = 0 If Y(i) < lowv Then Y(i) = 0 If Z(i) < lowv Then Z(i) = 0 'roll totals D(I17) = D(I17) + D(i) 'reversed CT's add nothing H(I17) = H(I17) + H(i) U(I17) = U(I17) + U(i) T(I17) = T(I17) + T(i) W(I17) = W(I17) + W(i) X(I17) = X(I17) + X(i) Y(I17) = Y(I17) + Y(i) Z(I17) = Z(I17) + Z(i) Next i List3.AddItem ("8 " + Str(i)) V(I17) = D(I17) / (H(I17) + lowv) 'too low, check phasing If H(I17) = 0 Then V(I17) = 0 'correct pf as needed - xxx V18 = 0 'hold max For i = 1 To I17 V(i) = V(i) * PF(i) 'apply known adjustments or kill w 0 List3.AddItem ("9 " + Str(i)) If V(i) > V18 Then V18 = V(i) Next i 'V18 holds max - scale the rest accordingly If V18 = 0 Then V18 = 1 For i = 1 To I17 List3.AddItem ("10 " + Str(i) + " pf " + Str(V(i))) V(i) = 0.999 * V(i) / (V18 + lowv / 10000) If V(i) > 1 Then V(i) = 0 'suppress any crazy pf Next i 'we are ready to make the report as a web page. List3.AddItem ("11 " + Str(i)) If Check1.Value = 0 Then Report1t 'text header Else Report1h 'mime type and header End If List3.AddItem ("12 " + Str(i)) If Check1.Value = 0 Then Report2 'text detail and total Else Report2 'html detail and total End If If Check3.Value = Checked And I17 = 17 Then For i = 1 To I17 Graph1 (i) List3.AddItem ("13 " + Str(i)) Next i End If Command2.Enabled = True Exit Sub skip1: End Sub Private Sub Report1t() 'headers ' 'FF1= 'Print #1, "limits" List3.AddItem ("RT1 1 ") On Error GoTo skip1 Open FileNameS + "mm.htm" For Output As 1 Q$ = Chr$(34) Print #1, "microMETER" Print #1, "
"
For i = 1 To Len(CoNameS) 'eat the <><><> stuff in micro.txt
 List3.AddItem ("RT1 2 " + Str(i))
 If Mid$(CoNameS, i, 1) = "<" Then Mid$(CoNameS, i, 1) = " "
 If Mid$(CoNameS, i, 1) = ">" Then Mid$(CoNameS, i, 1) = " "
Next i
Print #1, CoNameS
'do headers - even ch tp
FNS = Mid$(Text1, 1, 4) 'FileNameS
SDS = Mid$(Text1, 5, 8)
EDS = Mid$(Text2, 5, 8)
TMS = Mid$(Text2, 13, 2) + ":" + Mid$(Text2, 15, 2)
PRS = PRICE / 100
ATPRS = "" & PRS & "/kwh"
List3.AddItem ("RT1 3 " + Str(i))
Print #1, FNS & " Summary from " & SDS & " to " & EDS & " at " & ATPRS
H1$ = "Circuit ID                 "
H2$ = " w/v     kw                      "
H3$ = "                           "
H4$ = "amps    kva      kwh     kvah    kvarh    cost      %    pf"
Print #1, H1$ & H2$
Print #1, H3$ & H4$
Exit Sub
skip1:
End Sub
Private Sub Report1h() 'headers
List3.AddItem ("RH1 1 ")
On Error GoTo skip1
Open FileNameS + "mm.htm" For Output As 1
Q$ = Chr$(34)
FF1 = ""
FF2 = ""
FF3 = ""
FF4 = ""
FF5 = ""

TD1 = "microMETER"
'
Print #1, ""
Print #1, ""
For i = 1 To Len(CoNameS) 'eat the <><><> stuff in micro.txt
 List3.AddItem ("RH1 2 " + Str(i))
 If Mid$(CoNameS, i, 1) = "<" Then Mid$(CoNameS, i, 1) = " "
 If Mid$(CoNameS, i, 1) = ">" Then Mid$(CoNameS, i, 1) = " "
Next i
'do headers - even ch tp
FNS = Mid$(Text1, 1, 4) 'FileNameS
SDS = Mid$(Text1, 5, 8)
EDS = Mid$(Text2, 5, 8)
TMS = Mid$(Text2, 13, 2) + ":" + Mid$(Text2, 15, 2)
PRS = PRICE / 100
ATPRS = "" & PRS & "/kwh"
List3.AddItem ("RH1 3 " + Str(i))
Print #1, "
" c3S = "#aaaaaa" Print #1, "" Print #1, TD1 & "Colspan=" & "1" & ">" & FF1 & CoNameS & "" Print #1, TD1 & "Colspan=" & "7" & ">" & FF1 & FNS & " from " & SDS & " to " & EDS & " at " & TMS & "" Print #1, TD1 & "Colspan=" & "4" & ">" & FF1 & Form1.Caption & "" ' ---------------------------------------- copy to center Print #1, "" Print #1, TD1 & ">" & FF1 & "channel and circuit name" Print #1, TD1 & ">" & FF1 & "amperes" Print #1, TD1 & ">" & FF1 & "kva" Print #1, TD1 & ">" & FF5 & "kwh" Print #1, TD1 & ">" & FF5 & "kvah" Print #1, TD1 & ">" & FF5 & "kvarh" List3.AddItem ("RH1 4 " + Str(i)) Print #1, TD1 & ">" & FF3 & "$ cost" Print #1, TD1 & ">" & FF1 & "%" Print #1, TD1 & ">" & FF2 & "alarm" Print #1, TD1 & ">" & FF1 & "demand" Print #1, TD1 & ">" & FF4 & "X10(tm)" Print #1, TD1 & ">" & FF1 & "power" Print #1, "" Print #1, TD1 & ">" & FF1 & "(true power)" Print #1, TD1 & ">" & FF1 & "watts/volts" Print #1, TD1 & ">" & FF1 & "kw dem" Print #1, TD1 & ">" & FF5 & "used" Print #1, TD1 & ">" & FF1 & "" Print #1, TD1 & ">" & FF1 & "" Print #1, TD1 & ">" & FF1 & ATPRS & "" Print #1, TD1 & ">" & FF1 & "of total" Print #1, TD1 & ">" & FF2 & "limits" Print #1, TD1 & ">" & FF1 & "graph" Print #1, TD1 & ">" & FF1 & "control" Print #1, TD1 & ">" & FF1 & "factor" Exit Sub skip1: End Sub Private Sub Report2() 'detail Q$ = Chr$(34): c3S = "#dddddd" TE1 = "" If Check1.Value = 0 Then TE1 = "": TE2 = "" End If CKTS(I17) = " totals " For i = 1 To I17 List3.AddItem ("R2 1 " + Str(i)) On Error GoTo skip1 'T-kvarh U-kvah V-pf W-amps X-kw Y-kwh Z-cost FORMATS = Format$(T(i), "0000000.0"): ZeroSuppress: TS = FORMATS FORMATS = Format$(U(i), "0000000.0"): ZeroSuppress: US = FORMATS FORMATS = Format$(V(i), "00.000"): ZeroSuppress: VS = FORMATS FORMATS = Format$(W(i), "0000.0"): ZeroSuppress: WS = FORMATS FORMATS = Format$(X(i), "00000.0"): ZeroSuppress: XS = FORMATS FORMATS = Format$(Y(i), "0000000.0"): ZeroSuppress: YS = FORMATS FORMATS = Format$(Z(i), "00000.00"): ZeroSuppress: ZS = FORMATS If Y(I17) > 0 Then pct = Y(i) / Y(I17) * 100 If C00 = 2 And i < 17 Then If Int(i / 2) = i / 2 Then 'even pct = (Y(i) + Y(i - 1)) / Y(I17) * 100 Else pct = 0 End If End If FORMATS = Format$(pct, "00000.0"): ZeroSuppress: PS = FORMATS CK2S = CKTS(i) If Check1.Value = 1 Then 'html - set color groupings c1S = "#fofodf": c2S = "#ffffee": c4S = "#fff7d7" If C00 = 0 Then 'normal If Int(i / 2) = i / 2 Then 'even Print #1, "" Else Print #1, "" End If End If If C00 = 2 Then 'anal pair If i = 1 Or i = 2 Or i = 5 Or i = 6 Or i = 9 Or i = 10 Or i = 13 Or i = 14 Then Print #1, "" Else Print #1, "" End If End If If C00 = 3 Then '3-phase If i = 1 Or i = 4 Or i = 7 Or i = 10 Or i = 13 Or i = 16 Then Print #1, "" End If If i = 2 Or i = 5 Or i = 8 Or i = 11 Or i = 14 Then Print #1, "" End If If i = 3 Or i = 6 Or i = 9 Or i = 12 Or i = 15 Then Print #1, "" End If End If List3.AddItem ("R2 2 " + Str(i)) CK2S = TD2 & ">" & FF1 & CKTS(i) & TE2 End If 'advanced options ALS = TE1 & TE2 GRS = TD1 & ">" & FF1 & "d" & TE2 If Check3.Value = 0 Then GRS = TE1 & TE2 If Check1.Value = 0 Then GRS = "" 'TD1 & ">" & FF1 & 2 CTS = TE1 & TE2 PFS = TE1 & TE2 List3.AddItem ("R2 3 " + Str(i)) 'T-kvarh U-kvah V-pf W-amps X-kw Y-kwh Z-cost If sw1 = 1 Then PFS = VS 'PFS = "" If C00 = 2 And i < I17 Then If Int(i / 2) = i / 2 Then 'even PFS = VS US = TE1 & TE2: GRS = TE1 & TE2 Else TS = TE1 & TE2: ZS = TE1 & TE2 PS = TE1 & TE2: YS = TE1 & TE2 End If End If If sw1 = 1 And V(i) < lowv Then PFS = TE1 & TE2 If sw1 = 1 And Y(i) < lowv Then PFS = TE1 & TE2 If sw1 = 1 And Check2.Value = 0 Then PFS = TE1 & TE2: TS = TE1 & TE2: YS = TE1 & TE2 End If If i = I17 Then Print #1, "" 'GRS = TE1 & TE2 'let the totals graph print Else If LL(i) > 0 And Check1.Value = 1 Then If E(i) > LL(i) Or A(i) > LL(i) Then ALS = TD1 & ">" & FF2 & "H" & TE2 End If If HL(i) < 256 And Check1.Value = 1 Then If E(i) < HL(i) Or A(i) < HL(i) Then ALS = TD1 & ">" & FF2 & "L" & TE2 End If End If 'T-kvarh U-kvah V-pf W-amps X-kw Y-kwh Z-cost 'ckt, a w/v, kva kw dem, kwh, kvah, kvarh, $, % Print #1, CK2S & WS & XS & YS & US & TS & ZS & PS; 'alarm, graph, control, power factor Print #1, ALS & GRS & CTS & PFS List3.AddItem ("R2 4 " + Str(i)) If Check1.Value = 1 Then Print #1, "" End If Next i If Check1.Value = 1 Then Print #1, "
": TE2 = "
pf
" End If List3.AddItem ("R2 5 " + Str(i)) Close 1 List3.AddItem ("R2 6 " + Str(i)) Exit Sub skip1: End Sub Private Sub Graph1(j) 'needs file b.gif in c:\micromtr List3.AddItem ("G1 1 ") amax = 255: amin = 0 On Error GoTo skip1 Open FileNameS + "m" + Trim(Str$(j)) + ".htm" For Output As 1 Print #1, "
" Print #1, "" p1 = "" BK(17) = BK(1): LV(17) = LV(1) ' total good only for all ckts similar to #1 yy = amax / SCAL * BK(j) / 20 yz = yy * LV(j) / 1000 zz = yz: If j = I17 Then zz = 0 Print #1, p1 & "max=" & Mid$(Str$(zz), 2, Len(yy) + 1) & p2 Print #1, "

kw 

demand 

" p2 = " 

" Print #1, "" ' alt=""> For i = 1 To 540 List3.AddItem ("G1 2 " + Str(i)) xx = G0(i, j) / SCAL * BK(j) / 20 ' * LV(j) If yy = 0 Then yy = 0.0000000001 p = xx / yy * 255 'Rnd * 300 'If j = I17 Then p = Int(p / 16) 'too small Print #1, ""; ' alt=""> Next i List3.AddItem ("G1 3 " + Str(i)) Print #1, "

" 'Print #1, "01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24" Print #1, "

" & CKTS(j) & "

" If j = I17 Then Print #1, "Total good only for all ckts similar to #1." End If Print #1, "

Most recent " Print #1, "min " & G1(1, j) & " on " & G2(1, j) Print #1, "minnz " & G1(2, j) & " on " & G2(2, j) Print #1, "max " & G1(3, j) & " on " & G2(3, j) Close 1 List3.AddItem ("G1 4 " + Str(i)) Exit Sub skip1: End Sub Private Sub ZeroSuppress() If Mid$(FORMATS, 1, 1) = "0" Then Mid$(FORMATS, 1, 1) = " " End If For i = 1 To Len(FORMATS) - 3 If Mid$(FORMATS, i, 2) = " 0" Then Mid$(FORMATS, i, 2) = " " End If Next i If Check1.Value = 1 Then FORMATS = TD3 & ">" & FF1 & FORMATS & "" End If End Sub Private Sub Command2_Click() '"http://www.dot.com" try "file://c:\file.htm" or "file:///c:\file.htm" to load a local url = "file://" + FileNameS + "mm.htm" Shell ("c:/program files/internet explorer/iexplore.exe " + url) Command2.Enabled = False Command3.Enabled = True End Sub Private Sub Command3_Click() Timer1.Enabled = True Command3.Enabled = False End Sub Private Sub Command3_Click2() Dir1_Change 'this refills the listboxes Text2 = rec1S 'gets the latest entry for "to date" Command1_Click 'recalc and refresh mm.htm Command1.Enabled = False Command2.Enabled = False End Sub Private Sub Dir1_Change() sw1 = 0 'mm1 or 2 List1.Clear List2.Clear List3.AddItem ("DC 1 ") Close ' Initialize for currently expanded directory. GoHigher = 0 ' Dir1.List(x) returns empty string if the directory ' doesn't exist. Do Until Dir1.List(GoHigher) = "" GoHigher = GoHigher - 1 List3.AddItem ("DC 2 " + Str(GoHigher)) Loop ' 'Convert to positive number, if desired. 'LevelsAbove = Abs(GoHigher) 'Text2 = GoHigher If GoHigher = 0 Then List3.AddItem ("DC 3 ") getfilename List1.Clear List2.Clear List3.AddItem ("DC 4 ") On Error GoTo skip1 Open FileNameS + "mm.db1" For Input As 1 d1 = 19: d2 = 19 'header length, reading length cnt1 = 0 'rec count While Not EOF(1) 'mM0120020909131542,01,010,38979,00028,02,174,50596,00231, 14 more groups 'mM0120020909131542,01,010,38979,00028,010,38979,00028,10000, 15 more groups mMII Line Input #1, rec1S If Len(rec1S) > 350 Then sw1 = 1: d2 = 41 'mMII present End If cnt1 = cnt1 + 1 List3.AddItem ("DC 5 " + Str(cnt1)) List1.AddItem (rec1S) List2.AddItem (rec1S) G0(cnt1, 17) = 0 If Check3.Value = 1 And I17 = 17 Then For i = 1 To I16 'i = 1 j = (i - 1) * d2 + d1 'reading length, header length G0(cnt1, i) = Val(Mid$(rec1S, j + 4, 3)) If G0(cnt1, i) <= G1(1, i) Then 'get min G1(1, i) = G0(cnt1, i) G2(1, i) = Mid$(rec1S, 5, 14) End If If G0(cnt1, i) <= G1(2, i) And G0(cnt1, i) > 0 Then 'get minnz G1(2, i) = G0(cnt1, i) G2(2, i) = Mid$(rec1S, 5, 14) End If If G0(cnt1, i) >= G1(3, i) Then 'get max G1(3, i) = G0(cnt1, i) G2(3, i) = Mid$(rec1S, 5, 14) End If G0(cnt1, 17) = G0(cnt1, 17) + G0(cnt1, i) Next i For i = I17 To I17 'good only for all same ckts ' j = (i - 1) * d2 + d1 'reading length, header length ' G0(cnt1, i) = Val(Mid$(rec1S, j + 4, 3)) If G0(cnt1, i) <= G1(1, i) Then 'get min G1(1, i) = G0(cnt1, i) G2(1, i) = Mid$(rec1S, 5, 14) End If If G0(cnt1, i) <= G1(2, i) And G0(cnt1, i) > 0 Then 'get minnz G1(2, i) = G0(cnt1, i) G2(2, i) = Mid$(rec1S, 5, 14) End If If G0(cnt1, i) >= G1(3, i) Then 'get max G1(3, i) = G0(cnt1, i) G2(3, i) = Mid$(rec1S, 5, 14) End If Next i End If Wend Close 1 If sw1 = 0 Then Label3.Caption = "mMI " If sw1 = 1 Then Label3.Caption = "mMII" Label4.Caption = Str$(cnt1) & " entries" End If Exit Sub skip1: Text2 = "Problem with file mm.db1 or directory structure" Close End Sub Private Sub Drive1_Change() Dir1.Path = Drive1.Drive End Sub Private Sub getfilename() file1FileName = "" If (Right$(Dir1.Path, 1) = "\") Then FileNameS = Dir1.Path + file1FileName Else FileNameS = Dir1.Path + "\" + file1FileName End If 'Text1 = Left$(Right$(FileNameS, 5), 4) End Sub Private Sub Form_Load() I16 = 16: I17 = 17 '65 'I16>16 causes problem in 2 reading database For i = 1 To 17 G1(1, i) = 255 G1(2, i) = 255 G1(3, i) = 0 Next i End Sub Private Sub List1_Click() Text1 = List1.Text Command1.Enabled = True If List2.ListIndex > List1.ListIndex Then Text2 = List2.Text Else Text2 = "Must be a later reading." Command1.Enabled = False End If If Mid$(List1.Text, 1, 4) <> Mid$(List2.Text, 1, 4) Then Text2 = "Must have matched unitID's." Command1.Enabled = False End If End Sub Private Sub List2_Click() Command1.Enabled = True If List2.ListIndex > List1.ListIndex Then Text2 = List2.Text 'add new option to refresh Else Text2 = "Must be a later reading." Command1.Enabled = False End If If Mid$(List1.Text, 1, 4) <> Mid$(List2.Text, 1, 4) Then Text2 = "Must have matched unitID's." Command1.Enabled = False End If End Sub Private Sub LoadSetup1() On Error GoTo skip1 Open FileNameS + "micro.dat" For Input As 1 Input #1, SCAL Input #1, SCA2 Input #1, PRICE Input #1, COL Input #1, C00, C01, C02, C03 Input #1, C04, C05, C06, C07 'Input #1, C2, C3 Close 1 Exit Sub skip1: Text2 = "Problem with file micro.dat" End Sub Private Sub LoadSetup2() On Error GoTo skip1 Open FileNameS + "ct.dat" For Input As 1 'BK=breaker PF=power factor LV=line voltage 'LL=low limit HL=high limit For i = 1 To 16 Line Input #1, rec1S CKTS(i) = Mid$(rec1S, 1, 25) BK(i) = Val(Mid$(rec1S, 27, 4)) PF(i) = Val(Mid$(rec1S, 32, 4)) LV(i) = Val(Mid$(rec1S, 37, 3)) LL(i) = Val(Mid$(rec1S, 41, 4)) HL(i) = Val(Mid$(rec1S, 45, 3)) If LV(i) = 0 Then LV(i) = 120 Next i Close 1 Exit Sub skip1: Text2 = "Problem with file ct.dat" End Sub Private Sub LoadSetup3() On Error GoTo skip1 Open FileNameS + "micro.txt" For Input As 1 Line Input #1, CoNameS Close 1 Exit Sub skip1: Text2 = "Problem with file micro.txt" End Sub Private Sub Timer1_Timer() Timer2.Enabled = True Timer1.Enabled = False End Sub Private Sub Timer2_Timer() Timer3.Enabled = True Timer2.Enabled = False End Sub Private Sub Timer3_Timer() Timer1.Enabled = True Timer3.Enabled = False Command3_Click2 End Sub VERSION 5.00 Begin VB.Form Form1 Caption = "microMETER EMUlate 2002 v1.04" ClientHeight = 5295 ClientLeft = 60 ClientTop = 450 ClientWidth = 7680 Icon = "Form1.frx":0000 LinkTopic = "Form1" ScaleHeight = 5295 ScaleWidth = 7680 StartUpPosition = 3 'Windows Default Begin VB.TextBox Text4 Height = 285 Left = 6840 TabIndex = 15 Text = "000" Top = 3720 Width = 615 End Begin VB.TextBox Text3 Height = 285 Left = 4320 TabIndex = 14 Text = "1" Top = 3690 Width = 615 End Begin VB.CommandButton Command5 Caption = "ctcap.txt" Height = 255 Left = 2760 TabIndex = 13 Top = 3720 Width = 1335 End Begin VB.TextBox Text2 Height = 285 Left = 960 TabIndex = 10 Top = 3720 Width = 615 End Begin VB.TextBox Text1 Height = 285 Left = 120 TabIndex = 9 Text = "mM01" Top = 3720 Width = 615 End Begin VB.DirListBox Dir1 Height = 1440 Left = 120 TabIndex = 7 Top = 480 Width = 2175 End Begin VB.DriveListBox Drive1 Height = 315 Left = 120 TabIndex = 6 Top = 120 Width = 2175 End Begin VB.CommandButton Command4 Caption = "Init II" Enabled = 0 'False Height = 375 Left = 2400 TabIndex = 4 Top = 1560 Width = 855 End Begin VB.CommandButton Command3 Caption = "Init I" Enabled = 0 'False Height = 375 Left = 2400 TabIndex = 3 Top = 1080 Width = 855 End Begin VB.CommandButton Command2 Caption = "Read II" Enabled = 0 'False Height = 375 Left = 2400 TabIndex = 2 Top = 600 Width = 855 End Begin VB.Timer Timer2 Left = 8280 Top = 1200 End Begin VB.Timer Timer1 Left = 8280 Top = 720 End Begin VB.CommandButton Command1 Caption = "Read I" Enabled = 0 'False Height = 375 Left = 2400 TabIndex = 1 Top = 120 Width = 855 End Begin VB.ListBox List1 Height = 3375 Left = 3360 TabIndex = 0 Top = 120 Width = 4215 End Begin VB.Label Label5 Caption = "duty %" Height = 255 Left = 6000 TabIndex = 16 Top = 3720 Width = 615 End Begin VB.Label Label4 Height = 255 Left = 2280 TabIndex = 12 Top = 2640 Width = 735 End Begin VB.Label Label3 Height = 255 Left = 1800 TabIndex = 11 Top = 3720 Width = 615 End Begin VB.Label Label2 Height = 255 Left = 2400 TabIndex = 8 Top = 2640 Width = 615 End Begin VB.Label Label1 Appearance = 0 'Flat BackColor = &H80000004& ForeColor = &H80000008& Height = 255 Left = 360 TabIndex = 5 Top = 2640 Width = 2055 End Begin VB.Shape Shape1 BackStyle = 1 'Opaque Height = 1455 Left = 120 Top = 2040 Width = 3135 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False 'EMU2002 - (c) Ozona Systems 2004 cloned from Cap2002 v1.05 Dim cnt1, cnt2, cnt3, cnt4, sw1 As Integer Dim rec1S, rec2S, rec3S, CTCAP, MICRO2CAP, FileNameS, c1S As String Dim BK(17), PF(17), LV(17) As Single Dim LL(17), HL(17), DT(17), Rn1(17), eupd As Single Dim CKTS(17), FORMATS, FF1, FF2, FF3, TD1, TD2, TD3 As String Private Sub getfilename() file1FileName = "" If (Right$(Dir1.Path, 1) = "\") Then FileNameS = Dir1.Path + file1FileName Else FileNameS = Dir1.Path + "\" + file1FileName End If Text1 = Left$(Right$(FileNameS, 5), 4) sw1 = 0 'mM1 or 2 End Sub Private Sub setport() Close Shape1.BackColor = vbRed Label1.Caption = "Please wait 3 minutes" LoadSetup2 On Error GoTo skip1 Open FileNameS + "mm.db1" For Input As 1 On Error GoTo skip2 Line Input #1, rec3S List1.AddItem ("init " + Mid$(rec3S, 1, 18)) Close 1 'get the elapsed time from init (in updates) dy1 = Mid$(rec3S, 5, 4): th1 = Mid$(rec3S, 13, 2) dy2 = Mid$(Date$, 7, 4): th2 = Mid$(Time$, 1, 2) dm1 = Mid$(rec3S, 9, 2): tm1 = Mid$(rec3S, 15, 2) dm2 = Mid$(Date$, 1, 2): tm2 = Mid$(Time$, 4, 2) dd1 = Mid$(rec3S, 11, 2): ts1 = Mid$(rec3S, 17, 2) dd2 = Mid$(Date$, 4, 2): ts2 = Mid$(Time$, 7, 2) tday1 = (Val(dy2) - Val(dy1)) * 365 tday2 = (Val(dm2) - Val(dm1)) * 30 tday3 = (Val(dy2) - Val(dy1)) tsec1 = (Val(th2) - Val(th1)) * 60 * 60 tsec2 = (Val(tm2) - Val(tm1)) * 60 tsec3 = (Val(ts2) - Val(ts1)) eday = tday1 + tday2 + tday3 ehrs = eday * 24 + (tsec1 + tsec2 + tsec3) / 3600 eupd = ehrs * 22.5 For i = 1 To 16 Rn1(i) = Rnd Next i Exit Sub skip1: List1.AddItem ("no file mm.db1") Exit Sub skip2: List1.AddItem ("no init record in mm.db1") End Sub Private Sub Command1_Click() getfilename setport cnt4 = Val(Text3) For i = 1 To 16 If HL(i) > 255 Then HL(i) = 255 range = HL(i) - LL(i) base = LL(i) + range / 2 * (Rn1(i) - 0.5) dem1 = Int(base) If BK(i) = 0 Then dem1 = 0 'kill unused ckts If PF(i) = 0 Then dem1 = 0 If LV(i) = 0 Then dem1 = 0 'calc cumulative duty = DT(i) / 100 'raw value in percent cum1 = (dem1 * eupd * duty) cum2 = (cum1 / 65536) cum01 = cum1 - Int(cum2) * 65536 If cum01 < 0 Then cum01 = 0 xdem = Trim$(Str$(dem1)) xcum1 = Trim$(Str$(Int(cum01))) xcum2 = Trim$(Str$(Int(cum2))) If Rnd > duty Then xdem = "0" 'duty cycle c1S = Right$(Str(i), 2) + "," + xdem + "," + xcum1 + "," + xcum2 Process1 Next i End Sub Private Sub Command2_Click() getfilename setport cnt4 = Val(Text3) For i = 1 To 16 If HL(i) > 255 Then HL(i) = 255 range = HL(i) - LL(i) base = LL(i) + range / 2 * (Rn1(i) - 0.5) dem1 = Int(base) dem2 = Int(base * PF(i)) If BK(i) = 0 Then dem1 = 0 'kill unused ckts If PF(i) = 0 Then dem1 = 0 If LV(i) = 0 Then dem1 = 0 If BK(i) = 0 Then dem2 = 0 'kill unused ckts If PF(i) = 0 Then dem2 = 0 If LV(i) = 0 Then dem2 = 0 'calc cumulative duty = DT(i) / 100 'raw value in percent cum1 = (dem1 * eupd * duty) cum2 = (cum1 / 65536) cum01 = cum1 - Int(cum2) * 65536 cum12 = (dem2 * eupd * duty) cum22 = (cum12 / 65536) cum012 = cum12 - Int(cum22) * 65536 If cum1 < 0 Then cum1 = 0 xdem = Trim$(Str$(dem2)) xcum1 = Trim$(Str$(Int(cum012))) xcum2 = Trim$(Str$(Int(cum22))) ydem = Trim$(Str$(dem1)) ycum1 = Trim$(Str$(Int(cum01))) ycum2 = Trim$(Str$(Int(cum2))) If Rnd > duty Then xdem = "0" 'duty cycle If Rnd > duty Then ydem = "0" 'duty cycle c1S = Right$(Str(i), 2) + "," + xdem + "," + xcum1 + "," + xcum2 + "," + ydem + "," + ycum1 + "," + ycum2 + ",90000" Process1 Next i End Sub Private Sub Command3_Click() getfilename setport cnt4 = Val(Text3) 'sw1 = 0 For i = 1 To 16 c1S = Right$(Str(i), 2) + ",0,0,0" Process1 Next i 'MSComm1.CommPort = 3: MSComm1.PortOpen = True End Sub Private Sub Command4_Click() getfilename setport cnt4 = Val(Text3) 'sw1 = 1 For i = 1 To 16 c1S = Right$(Str(i), 2) + ",0,0,0,0,0,0,90000" Process1 Next i End Sub Private Sub Command5_Click() 'get data from ctcap.txt getfilename setport Close 2 On Error GoTo skip1 Open FileNameS + "ctcap.txt" For Input As 2 For i = 1 To 16 Line Input #2, c1S Process1 Next i Close 2 Exit Sub skip1: Text2 = "Problem with file ctcap.txt" End Sub Private Sub Drive1_Change() Dir1.Path = Drive1.Drive End Sub Private Sub Dir1_Change() Command1.Enabled = True Command2.Enabled = True Command3.Enabled = True Command4.Enabled = True End Sub Private Sub File1_Change() Command1.Enabled = True Command2.Enabled = True Command3.Enabled = True Command4.Enabled = True End Sub Private Sub Form_Load() cnt1 = 0: cnt2 = 0: cnt3 = 0: cnt4 = 0 rec1S = "": CTCAP = "": MICRO2CAP = "" End Sub Private Sub Timer1_Timer() Timer1.Enabled = False If cnt3 > 0 Then Process1 Else List1.AddItem ("sync ") Shape1.BackColor = vbYellow c1$ = MSComm1.Input 'discard 1st End If cnt3 = cnt3 + 1 'absolute count End Sub Private Sub Process1() cnt1 = cnt1 + 1 'all but first read a1$ = "mM01" + Mid$(Date$, 7, 4) + Mid$(Date$, 1, 2) + Mid$(Date$, 4, 2) a3$ = Mid$(Time$, 1, 2) + Mid$(Time$, 4, 2) + Mid$(Time$, 7, 2) 'c1$ = MSComm1.Input c1$ = c1S 'A little Fortran-style formatting Close 1 Open FileNameS + "cp.txt" For Output As 1 Print #1, c1$ Print #1, c1$ 'stupid MS bug Close 1 '16,255,99999,99999 = 18 max mM 1 '1,0,0,0,0,0,0,10000 = 19 min mM 2 If Len(c1$) > 18 Then sw1 = 1 If sw1 = 0 Then Label3 = "mMI" If sw1 = 1 Then Label3 = "mMII" Open FileNameS + "cp.txt" For Input As 1 If sw1 = 0 Then Input #1, a, b, c, d If sw1 = 1 Then Input #1, a, b, c, d, e, f, g, h Close 1 'fix stupid MS bug - "a" comes in empty almost every time in a set of 16 If sw1 = 1 And h < 10000 Then a = b: b = c: c = d: d = e: e = f: f = g: g = h: h = 11111 End If ast = Mid(Str$(a), 2, Len(Str$(a))) bst = Mid(Str$(b), 2, Len(Str$(b))) cst = Mid(Str$(c), 2, Len(Str$(c))) dst = Mid(Str$(d), 2, Len(Str$(d))) If sw1 = 1 Then est = Mid(Str$(e), 2, Len(Str$(e))) fst = Mid(Str$(f), 2, Len(Str$(f))) gst = Mid(Str$(g), 2, Len(Str$(g))) hst = Mid(Str$(h), 2, Len(Str$(h))) Else est = "000" fst = "00000" gst = "00000" hst = "00000" End If For i = 1 To 5 If Len(ast) < 2 Then ast = "0" + ast If Len(bst) < 3 Then bst = "0" + bst If Len(cst) < 5 Then cst = "0" + cst If Len(dst) < 5 Then dst = "0" + dst If Len(est) < 3 Then est = "0" + est If Len(fst) < 5 Then fst = "0" + fst If Len(gst) < 5 Then gst = "0" + gst If Len(hst) < 5 Then hst = "0" + hst Next i If sw1 = 0 Then c1$ = ast + "," + bst + "," + cst + "," + dst If sw1 = 1 Then c1$ = ast + "," + bst + "," + cst + "," + dst + "," + est + "," + fst + "," + gst + "," + hst c2$ = c1$ List1.AddItem (c2$) 'build database entry rec1S = rec1S + "," + c2$ 'have to use S instead of $ for strings when using functions rec2$ = a1$ + a3$ + "" + rec1S Text2 = cnt1 CTCAP = CTCAP + Mid$(c2$, 1, 18) + Chr$(13) + Chr$(10) MICRO2CAP = MICRO2CAP + Time$ + " " + Date$ + Chr$(13) + Chr$(10) If cnt1 = 15 Then Shape1.BackColor = vbGreen Label1.Caption = " Update pending ... " End If If cnt1 = 16 Then rec2S = rec2$ Process2 Writefiles Shape1.BackColor = vbGreen Label1.Caption = "We have a good reading " cnt1 = 0 cnt2 = cnt2 + 1 'groups of 16 Label4 = cnt2 rec1S = "": CTCAP = "": MICRO2CAP = "" If cnt4 > 0 Then cnt4 = cnt4 - 1 Text3 = cnt4 End If Beep End If End Sub Private Sub Process2() 'have to use S instead of $ for strings when using some functions 'mM0120020909131542,05,010,38979,00028,06,174,50596,00231, 14 more groups 're-order rec2S as rec3S 'mM0120020909131542,01,010,38979,00028,02,174,50596,00231, 14 more groups 'mM0120020909131542,01,010,38979,00028,010,38979,00028,10000, 15 more groups mMII d1 = 19: d2 = 19 'header length, reading length If sw1 = 1 Then d2 = 41 rec3S = rec2S + " " For j = 1 To 16 For i = 1 To 16 i2$ = Trim(Str(j)) If Len(i2$) < 2 Then i2$ = "0" + i2$ End If d = d1 + (i - 1) * d2 + 1 e = d1 + (j - 1) * d2 + 1 If Mid$(rec2S, d, 2) = i2$ Then Mid$(rec3S, e, d2) = Mid$(rec2S, d, d2) End If Next i Next j Mid$(rec3S, 1, 4) = Mid$(Text1, 1, 4) End Sub Private Sub Writefiles() 'add new reading to database '540 rec/day 322 byte/rec rec len 323 ends w , 'mM0120020909131542,01,010,38979,00028,02,174,50596,00231, 14 more groups Open FileNameS + "mm.db1" For Append As 1 Print #1, rec3S Close 1 'maintain legacy files Open FileNameS + "ct.cap" For Output As 1 Print #1, Mid$(CTCAP, 1, 320) Close 1 Open FileNameS + "usage.cap" For Append As 1 Print #1, Mid$(CTCAP, 1, 318) 'drop x crlf Close 1 Open FileNameS + "micro2.cap" For Output As 1 Print #1, Mid$(MICRO2CAP, 1, 336) Close 1 End Sub Private Sub LoadSetup2() On Error GoTo skip1 Open FileNameS + "ct.dat" For Input As 1 'BK=breaker PF=power factor LV=line voltage 'LL=low limit HL=high limit For i = 1 To 16 Line Input #1, rec4S CKTS(i) = Mid$(rec4S, 1, 25) BK(i) = Val(Mid$(rec4S, 27, 4)) PF(i) = Val(Mid$(rec4S, 32, 4)) LV(i) = Val(Mid$(rec4S, 37, 3)) LL(i) = Val(Mid$(rec4S, 41, 4)) HL(i) = Val(Mid$(rec4S, 45, 3)) DT(i) = Val(Mid$(rec4S, 49, 3)) If LV(i) = 0 Then LV(i) = 120 If DT(i) = 0 Then DT(i) = 10 If (Val(Text4) > 0 And Val(Text4) <= 100) Then DT(i) = Val(Text4) Next i Close 1 Exit Sub skip1: Text2 = "Problem with file ct.dat" End Sub