PowerBASIC Peer Support Forums
 

Go Back   PowerBASIC Peer Support Forums > User to user Discussions > Source Code

Source Code PowerBASIC and related source code. Please do not post questions or discussions, just source code.

Reply
 
Thread Tools Display Modes
  #1  
Old Jan 22nd, 2006, 08:24 AM
Doug McDonald Doug McDonald is offline
Member
 
Join Date: Jun 2001
Location: Tulsa Okla
Posts: 221
Data Logger for the Radio Shack DMM

Here some code for the Radio Shack Multi Meter model 22-812

[code]

#PBFORMS CREATED V1.50

#COMPILE EXE
#DIM ALL

'------------------------------------------------------------------------------
' ** Includes **
'------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES
#IF NOT %DEF(%WINAPI)
#INCLUDE "WIN32API.INC"
#End If
#INCLUDE "PBForms.INC"
#PBFORMS END INCLUDES
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
' ** Constants **
'------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%IDD_DIALOG1 = 101
%FNlbl = 1001
%CommLbl = 1002
%DRlbl = 1003
%StTimeLbl = 1004
%StpTimeLbl = 1005
%Actlbl = 1006
%bStart = 1007
%IDC_LABEL1 = 1008 '*
%bStop = 1009
%PathTxt = 1010
%CommTxt = 1011
%DRtxt = 1012
%DataTxt = 1013
%StTimeTxt = 1014
%StpTimeTxt = 1015
%bExit = 1016
%crlbl = 1017
%IDR_MENU1 = 102
%IDM_ABOUT = 1018 '*
%IDM_ABOUT1 = 1019
%IDC_IMGBUTTON1 = 1020 '*
%IDC_LABEL2 = 1021 '*
%IDC_IMGBUTTON2 = 1022 '*
%IDC_BUTTON1 = 1023 '*
%bexit1 = 1024
%IDC_COMBOBOX1 = 1025
#PBFORMS END CONSTANTS
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
' ** Declarations **
'------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
DECLARE FUNCTION AttachMENU1(BYVAL hDlg AS DWORD) AS DWORD
DECLARE FUNCTION FillComm() AS LONG
#PBFORMS DECLARATIONS

'------------------------------------------------------------------------------

Type CommInfo
iPortNo As Long
sPortName AS ASCIIZ * 255
End Type

%ERROR_NO_MORE_ITEMS = 259&
%BUFFER_SIZE = 255
%REG_SZ = 1
DECLARE SUB GetCommPortInfo(udtArr() AS CommInfo)

Global hComm As DWORD
Global Updating As Long
Global hThread As DWORD
Global ThreadClose As DWORD
Global hDlg As DWORD
Global lRslt As DWORD
DECLARE FUNCTION StartComms AS LONG
DECLARE FUNCTION SendLine(ASCIIZ) AS LONG
DECLARE FUNCTION ReceiveData(BYVAL LONG) AS LONG
DECLARE FUNCTION EndComms AS LONG
DECLARE FUNCTION ElapsedTime() AS STRING
DECLARE SUB start
DECLARE SUB bStop
DECLARE SUB display( t AS STRING)
DECLARE SUB StartTime()
Global Commport As String
Global Path As String
Global StTime As String
Global StpTime As String
Global DP As String
Global rate As String
Global datax() As Integer
Global writeTime As DWORD
Global wrFlag As Long
Global rateN As DWORD
Global sTime As DWORD
Global tc As DWORD
Global udtCommInfo() As CommInfo
'------------------------------------------------------------------------------
' ** Main Application Entry Point **
'------------------------------------------------------------------------------
Function PBMAIN()
ShowDIALOG1 %HWND_DESKTOP
End Function
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
' ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
LOCAL ret AS LONG
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
' Initialization handler

CASE %WM_NCACTIVATE
Static hWndSaveFocus As DWORD
IF ISFALSE CBWPARAM THEN
' Save control focus
hWndSaveFocus = GetFocus()
ElseIf hWndSaveFocus Then
' Restore control focus
'SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
End If

CASE %WM_COMMAND
' Process control notifications
SELECT CASE AS LONG CBCTL
' /* Inserted by PB/Forms 09-23-2004 09:54:36
CASE %IDC_COMBOBOX1
' */

' /* Inserted by PB/Forms 09-19-2004 06:52:42
CASE %bexit1
IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
MSGBOX "%bexit1=" + FORMAT$(%bexit1), %MB_TASKMODAL
End If
' */

' /* Inserted by PB/Forms 08-25-2004 12:57:54
CASE %IDM_ABOUT1
MsgBox "Radio Shack" & Chr$(174) & " 22-812 DMM ver 1.14 Written by Doug McDonald dmtulsa@cox.net" + Chr$(13) + " *** This software has nothing to do with Radio Shack***", , "About"

' */

' /* Inserted by PB/Forms 08-25-2004 08:18:25
CASE %crlbl
' */

' /* Inserted by PB/Forms 08-22-2004 09:13:19
CASE %bExit
' IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
Call EndComms
DIALOG END hdlg
' END IF
' */

CASE %FNlbl

CASE %CommLbl

CASE %DRlbl

CASE %StTimeLbl

CASE %StpTimeLbl

CASE %Actlbl

CASE %bStart
CONTROL SET FOCUS hDlg, %pathtxt
start
CASE %bStop
CONTROL SET FOCUS hDlg, %pathtxt
bStop
CASE %PathTxt

CASE %CommTxt

CASE %DRtxt

CASE %DataTxt

CASE %StTimeTxt

CASE %StpTimeTxt

End Select
End Select
End Function
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
' ** Dialogs **
'------------------------------------------------------------------------------
Function ShowDIALOG1(ByVal hParent As DWORD) As Long

#PBFORMS BEGIN DIALOG %IDD_DIALOG1->%IDR_MENU1->
' LOCAL hDlg AS DWORD
LOCAL hFont1 AS DWORD
LOCAL ret AS LONG
DIALOG NEW hParent, "Radio Shack" & CHR$(174) & " DMM ", 172, 66, 223, 160, %WS_POPUP OR _
%WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR _
%WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
%DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_WINDOWEDGE OR _
%WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
%WS_EX_RIGHTSCROLLBAR, TO hDlg
DIALOG SET COLOR hDlg, -1, RGB(243, 247, 136)
CONTROL ADD TEXTBOX, hDlg, %PathTxt, "", 80, 10, 125, 12, %WS_CHILD OR _
%WS_VISIBLE OR %WS_TABSTOP OR %ES_LEFT OR %ES_AUTOHSCROLL, _
%WS_EX_CLIENTEDGE OR %WS_EX_ACCEPTFILES OR %WS_EX_LEFT OR _
%WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
CONTROL ADD TEXTBOX, hDlg, %DRtxt, "1", 80, 50, 125, 12
CONTROL ADD LABEL, hDlg, %Actlbl, "Active Data", 5, 110, 65, 12
CONTROL SET COLOR hDlg, %Actlbl, -1, RGB(243, 247, 136)
CONTROL ADD LABEL, hDlg, %StTimeLbl, "Start Time", 5, 70, 65, 12
CONTROL SET COLOR hDlg, %StTimeLbl, -1, RGB(243, 247, 136)
CONTROL ADD LABEL, hDlg, %StpTimeLbl, "Elapsed Time", 5, 90, 65, 12
CONTROL SET COLOR hDlg, %StpTimeLbl, -1, RGB(243, 247, 136)
CONTROL ADD LABEL, hDlg, %DRlbl, "Data Rate in Sec", 5, 50, 70, 12
CONTROL SET COLOR hDlg, %DRlbl, -1, RGB(243, 247, 136)
CONTROL ADD LABEL, hDlg, %CommLbl, "Comm Port", 5, 30, 65, 12
CONTROL SET COLOR hDlg, %CommLbl, -1, RGB(243, 247, 136)
CONTROL ADD LABEL, hDlg, %FNlbl, "Data File Name", 5, 10, 65, 12
CONTROL SET COLOR hDlg, %FNlbl, -1, RGB(243, 247, 136)
CONTROL ADD TEXTBOX, hDlg, %DataTxt, "", 80, 110, 125, 12, %WS_CHILD OR _
%WS_VISIBLE OR %ES_LEFT OR %ES_AUTOHSCROLL OR %ES_READONLY, _
%WS_EX_CLIENTEDGE OR %WS_EX_STATICEDGE OR %WS_EX_LEFT OR _
%WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
CONTROL ADD TEXTBOX, hDlg, %StTimeTxt, "", 80, 70, 125, 12, %WS_CHILD OR _
%WS_VISIBLE OR %ES_LEFT OR %ES_AUTOHSCROLL OR %ES_READONLY, _
%WS_EX_CLIENTEDGE OR %WS_EX_STATICEDGE OR %WS_EX_LEFT OR _
%WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
CONTROL ADD TEXTBOX, hDlg, %StpTimeTxt, "", 80, 90, 125, 12, %WS_CHILD _
OR %WS_VISIBLE OR %ES_LEFT OR %ES_AUTOHSCROLL OR %ES_READONLY, _
%WS_EX_CLIENTEDGE OR %WS_EX_STATICEDGE OR %WS_EX_LEFT OR _
%WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
CONTROL ADD COMBOBOX, hDlg, %IDC_COMBOBOX1, , 80, 30, 125, 50
COMBOBOX ADD hDlg, %IDC_COMBOBOX1,"Select Comm Port"
COMBOBOX SELECT hDlg, %IDC_COMBOBOX1,1
hFont1 = PBFormsMakeFont("MS Sans Serif", 8, 700, %FALSE, %FALSE, %FALSE, _
%ANSI_CHARSET)

DIALOG SEND hDlg, %WM_SETFONT, hFont1, 0
CONTROL SEND hDlg, %PathTxt, %WM_SETFONT, hFont1, 0
CONTROL SEND hDlg, %DRtxt, %WM_SETFONT, hFont1, 0
CONTROL SEND hDlg, %Actlbl, %WM_SETFONT, hFont1, 0
CONTROL SEND hDlg, %StTimeLbl, %WM_SETFONT, hFont1, 0
CONTROL SEND hDlg, %StpTimeLbl, %WM_SETFONT, hFont1, 0
CONTROL SEND hDlg, %DRlbl, %WM_SETFONT, hFont1, 0
CONTROL SEND hDlg, %CommLbl, %WM_SETFONT, hFont1, 0
CONTROL SEND hDlg, %FNlbl, %WM_SETFONT, hFont1, 0
CONTROL SEND hDlg, %DataTxt, %WM_SETFONT, hFont1, 0
CONTROL SEND hDlg, %StTimeTxt, %WM_SETFONT, hFont1, 0
CONTROL SEND hDlg, %StpTimeTxt, %WM_SETFONT, hFont1, 0
CONTROL SEND hDlg, %IDC_COMBOBOX1, %WM_SETFONT, hFont1, 0

AttachMENU1 hDlg
#PBFORMS END DIALOG

ret = FillComm()
' Create a "listen" Thread to monitor input from the modem
THREAD CREATE ReceiveData(hDlg) TO hThread
DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

' Close down our "listen" Thread
ThreadClose = %TRUE
Do
THREAD CLOSE hThread TO lRslt

' Release time-slice for improved multitasking
SLEEP 100
LOOP UNTIL ISTRUE lRslt

' Flush & close the comm port
Call EndComms

#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
DeleteObject hFont1
#PBFORMS END CLEANUP

FUNCTION = lRslt
End Function
'------------------------------------------------------------------------------

Sub StartTime()
sTime = gettickcount() 'stime is a global returns number of milliseconds since windows started
writeTime = sTime / 1000
End Sub

Function ElapsedTime() As String
Dim tm As DWORD

Dim hh As Integer, mm As Integer, ss As Integer, day As Integer
Dim t As String
tc = gettickcount()
tm = (tc - sTime) / 1000
day = Int(tm / 86400)
hh = Int(tm / 3600) Mod 24
mm = Int((tm) / 60) Mod 60
ss = tm Mod 60
t = Str$(day) & " Days " & Str$(hh) & ":" & Str$(mm) & ":" & Str$(ss)
FUNCTION = t

End Function


Sub Writedata()
If wrFlag = 0 Then Exit Sub
LOCAL Fnum AS LONG
LOCAL temp AS STRING
Dim etime As String
etime = ElapsedTime()


' CONTROL SET TEXT hdlg,%StTimeTxt, STR$(writetime + raten)
CONTROL SET TEXT hdlg,%StpTimeTxt, etime
If (writeTime + rateN) < (tc / 1000) Then
' CONTROL SET TEXT hdlg,%DataTxt, tmp
CONTROL GET TEXT hdlg,%DataTxt TO temp
writeTime = tc / 1000
fnum = FreeFile
Open Path For Append As fnum
Print #fnum, Time$ & " " & temp
Close fnum
' MSGBOX "write"
End If
End Sub

Sub start()
LOCAL ret AS LONG

CONTROL GET TEXT hdlg,%PathTxt TO path

If Path = "" Then
wrFlag = 0
Else
wrFlag = 1
End If

COMBOBOX GET TEXT hdlg,%IDC_COMBOBOX1 TO commport
'IF INT(VAL(commport)) = 0 THEN
' MSGBOX "Not a valid Comm Port"
' EXIT SUB
'END IF

CONTROL GET TEXT hdlg,%DRTxt TO rate
rateN = Int(Val(rate))
If rateN = 0 Then
MsgBox "Rate must be >= 1 second"
Exit Sub
End If
CONTROL SET TEXT hdlg,%StTimeTxt, TIME$ & " " & DATE$
DIALOG SET TEXT hdlg, path

'Initialize the port ready for the session
IF ISFALSE StartComms THEN
MsgBox "Failure to start communications!" ',, $AppTitle
Exit Sub

End If
CONTROL DISABLE hDlg, %PathTxt
CONTROL DISABLE hDlg, %DRTxt
CONTROL DISABLE hDlg, %IDC_COMBOBOX1
StartTime

End Sub

Sub bStop()
LOCAL x AS LONG
x = EndComms
'CONTROL SET TEXT hdlg,%StpTimeTxt, TIME$
wrFlag = 0
DIALOG SET TEXT hdlg, "Radio Shack" & CHR$(174) & " DMM "
CONTROL ENABLE hDlg, %PathTxt
CONTROL ENABLE hDlg, %DRTxt
CONTROL ENABLE hDlg, %IDC_COMBOBOX1
End Sub

'Comm port routines ************************************************** *******

Function StartComms() As Long
Close hComm
Commport = Trim$(Commport)
hComm = FreeFile

COMM OPEN commport AS hcomm

CONTROL SET TEXT hdlg,%DataTxt, ERROR$(ERR)
COMM SET hcomm, BAUD = 4800 ' 14400 baud
COMM SET hcomm, BYTE = 8 ' 8 bits
COMM SET hcomm, PARITY = %FALSE ' No parity
COMM SET hcomm, STOP = 0 ' 1 stop bit
COMM SET hcomm, TXBUFFER = 4096 ' 4 Kb transmit buffer
COMM SET hcomm, RXBUFFER = 9 ' 4 Kb receive buffer
COMM SET hcomm, DTRFLOW = %true


'COMM SET hcomm, null = %true
' DIM dummy AS STRING
' SLEEP 1000
' IF COMM(hcomm, RXQUE) THEN
' COMM RECV hcomm, COMM(hcomm, RXQUE), dummy
' END IF
FUNCTION = %TRUE
End Function

Function ReceiveData(ByVal hWnd As DWORD) As Long
Dim InboundData As String
Dim Stuf As String
Dim Qty As Long
Dim i As Long
Qty = 0
InboundData = ""
Stuf = ""
'StartComms

WHILE ISFALSE ThreadClose
' Test the RX buffer
Qty = COMM(hComm, RXQUE)

' Abort this iteration if sending
IF ISFALSE Qty OR Updating THEN
SLEEP 100
ITERATE LOOP
End If


'CONTROL SET TEXT hdlg,%StpTimeTxt, STR$(qty)
' Read incoming characters
COMM RECV hcomm, Qty, Stuf
InboundData = InboundData & Stuf

If Qty = 9 Then
'FOR i = 0 TO 8
'CONTROL SET TEXT hdlg,%DataTxt, STR$(i)
display InboundData
'SLEEP 100
'NEXT i
End If
Wend
Dim dummy As String

' Flush the RX buffer & close the port
SLEEP 100

IF COMM(#hComm, RXQUE) THEN
COMM RECV #hComm, COMM(#hComm, RXQUE), dummy
End If


FUNCTION = %TRUE
i = EndComms
End Function

Function EndComms() As Long
Dim dummy As String
SLEEP 100
If COMM(hComm, RXQUE) Then
COMM RECV hcomm, COMM(hcomm, RXQUE), dummy
End If
COMM CLOSE hcomm

End Function


'LCD data **************************************************


Sub display(t As String)


Dim datax(1 To 9) As Integer
LOCAL i AS INTEGER
LOCAL ret AS INTEGER
LOCAL period AS INTEGER
LOCAL tmp AS STRING
LOCAL d1 AS STRING
LOCAL d2 AS STRING
tmp = ""
For i = 1 To 9

datax(i) = Asc(Mid$(t, i, 1))
Next i
For i = 4 To 7
ret = Bit(datax(i), 3)
If ret = 1 Then period = i
BIT RESET datax(i), 3

Next i
t = ""
ret = Bit(datax(8), 3)
If ret = 1 Then tmp = "-"

Select Case datax(7)
Case &HD7
d1 = "0"
Case &H50
d1 = "1"
Case &HB5
d1 = "2"
Case &HF1
d1 = "3"
Case &H72
d1 = "4"
Case &HE3
d1 = "5"
Case &HE7
d1 = "6"
Case &H51 '3
d1 = "7"
Case &HF7
d1 = "8"
Case &HF3
d1 = "9"
End Select
'If period = 7 Then d1 = d1 & "."
tmp = tmp & d1
'CONTROL SET TEXT hdlg,%DataTxt,tmp

Select Case datax(6)
Case &HD7
d1 = "0"
Case &H50
d1 = "1"
Case &HB5
d1 = "2"
Case &HF1
d1 = "3"
Case &H72
d1 = "4"
Case &HE3
d1 = "5"
Case &HE7
d1 = "6"
Case &H51 '3
d1 = "7"
Case &HF7
d1 = "8"
Case &HF3
d1 = "9"
End Select
If period = 6 Then d1 = "." & d1

tmp = tmp & d1
'CONTROL SET TEXT hdlg,%DataTxt,tmp

Select Case datax(5)
Case &HD7
d1 = "0"
Case &H50
d1 = "1"
Case &HB5
d1 = "2"
Case &HF1
d1 = "3"
Case &H72
d1 = "4"
Case &HE3
d1 = "5"
Case &HE7
d1 = "6"
Case &H51 '3
d1 = "7"
Case &HF7
d1 = "8"
Case &HF3
d1 = "9"
End Select
If period = 5 Then d1 = "." & d1

tmp = tmp & d1
'CONTROL SET TEXT hdlg,%DataTxt,tmp

Select Case datax(4)
Case &HD7
d1 = "0"
Case &H50
d1 = "1"
Case &HB5
d1 = "2"
Case &HF1
d1 = "3"
Case &H72
d1 = "4"
Case &HE3
d1 = "5"
Case &HE7
d1 = "6"
Case &H51 '3
d1 = "7"
Case &HF7
d1 = "8"
Case &HF3
d1 = "9"
End Select
If period = 4 Then d1 = "." & d1

tmp = tmp & d1
'CONTROL SET TEXT hdlg,%DataTxt,tmp

For i = 0 To 7
ret = Bit(datax(3), i)
If ret = 1 Then
Select Case i
Case 0
d2 = d2 & "MIN"
Case 1
d2 = d2 & "REL"
Case 2
d2 = d2 & "hFE"
Case 3
d2 = d2 & "%"
Case 4
d2 = d2 & "S"
Case 5
d2 = d2 & "dBm"
Case 6
d2 = d2 & "n"
Case 7
d2 = d2 & "u"

End Select
End If
Next i
For i = 0 To 7
ret = Bit(datax(2), i)
If ret = 1 Then
Select Case i
Case 0
d2 = d2 & "m"
Case 1
d2 = d2 & "V"
Case 2
d2 = d2 & "A"
Case 3
d2 = d2 & "F"
Case 4
d2 = d2 & "M"
Case 5
d2 = d2 & "K"
Case 6
d2 = d2 & "Ohm"
Case 7
d2 = d2 & "Hz"

End Select
End If
Next i
tmp = tmp & " " & d2
CONTROL SET TEXT hdlg,%DataTxt, tmp

'tmp = ""
If wrFlag = 1 Then
Writedata
End If
End Sub

'*******************Get Comm Ports ******************
Function FillComm() As Long
Dim i As Long, noofports As Long
Dim udtCommInfo() As CommInfo
ReDim udtCommInfo(0)
GetCommPortInfo (udtCommInfo())

FUNCTION = 1
End Function

'SUB GetCommPortInfo(udtArr() AS CommInfo) 'EXPORT
Sub GetCommPortInfo(ByRef udtArr() As CommInfo)
Dim hKey As Long
Dim lcount As Long
DIM sName AS ASCIIZ * 256
DIM sData AS ASCIIZ * 256
Dim lRet As Long
Dim lRetData As Long
Dim sValName As String
Dim sValTemp As String
Dim lValType As Long
Dim lresult As Long
Dim ret As Long
Dim indx As Long
Dim i As Long
'Open a registry key
IF RegOpenKey(%HKEY_LOCAL_MACHINE, "Hardware\DeviceMap\SerialComm", hKey) = 0 THEN
'initialize
sName = SPACE$(%BUFFER_SIZE)
sData = SPACE$(%BUFFER_SIZE)
lRet = %BUFFER_SIZE
lRetData = %BUFFER_SIZE
'enumerate the values
indx = 0
WHILE RegEnumValue(hKey, lcount, sName, lRet, BYVAL %null, BYVAL 0&, sData, lRetData) <> %ERROR_NO_MORE_ITEMS

'WHILE ret <> %ERROR_NO_MORE_ITEMS
'ret = RegEnumValue(hKey, lcount, sName, lRet, 0, BYVAL 0&, sData, lRetData)
'show data
If lRetData > 0 Then
'build the return array
udtArr(indx).sPortName = sData
udtArr(indx).iPortNo = lcount + 1
'prepare for next value
If indx& = UBound(udtArr) Then ReDim Preserve udtArr(UBound(udtArr) + 5)
INCR indx
lcount = lcount + 1
sName = SPACE$(%BUFFER_SIZE)
sData = SPACE$(%BUFFER_SIZE)
lRet = %BUFFER_SIZE
lRetData = %BUFFER_SIZE
End If
Wend
ReDim Preserve udtArr(indx - 1)
'Close the registry key
RegCloseKey hKey
Else
MSGBOX "Error while calling RegOpenKey", %MB_OK, "Error"


End If
For i = 0 To UBound(udtArr)
COMBOBOX ADD hdlg, %IDC_COMBOBOX1, TRIM$(udtCommInfo(i).sPortName)
Next i
'MSGBOX udtCommInfo(0).sPortName
End Sub

'------------------------------------------------------------------------------
Function AttachMENU1(ByVal hDlg As DWORD) As DWORD
#PBFORMS BEGIN MENU %IDR_MENU1->%IDD_DIALOG1
LOCAL hMenu AS DWORD

MENU NEW BAR TO hMenu
MENU ADD STRING, hMenu, "Start", %bStart, %MF_ENABLED
MENU ADD STRING, hMenu, "Stop", %bStop, %MF_ENABLED
MENU ADD STRING, hMenu, "Exit", %bExit, %MF_ENABLED
MENU ADD STRING, hMenu, "About", %IDM_ABOUT1, %MF_ENABLED

MENU ATTACH hMenu, hDlg
#PBFORMS END MENU
FUNCTION = hMenu
End Function
'------------------------------------------------------------------------------


------------------
__________________
Doug McDonald
KD5NWK
www.redforksoftware.com
Reply With Quote
  #2  
Old Jan 24th, 2006, 11:56 AM
Gary Peek Gary Peek is offline
Member
 
Join Date: Dec 2000
Location: St. Charles, MO
Posts: 139
Good job Doug. You might offer an EXE of this program to some of the electronics resources web sites. epanorama.com is one, but I'm sure there are many.


------------------
__________________
Gary Peek, Industrologic, Inc.
Reply With Quote
  #3  
Old Apr 2nd, 2012, 06:57 AM
paul d purvis paul d purvis is offline
Member
 
Join Date: Mar 2003
Posts: 1,646
this is console program that only monitors the Radio Shack 22-812 ac volts reading selection only.
i did not know of another listing on this equipment to just now, and i should of checked.
this is a console program and it may not be as good as the program above
i had troubles finding good descriptions of the data, but i am done now
i would suppose somebody could merge the information previous posted to do more than just AC volts.

i spent the entire weekend on this and could of really used the above source, i feel so foolish

i left out any logging, because i felt those that wanted to do it there way where going to compile there own program anyways
i believe my code might do a better job of retrieving more samples of data from the meter than the above code. once a second is just too slow for me when trouble shooting. this program will retrieve about 233 samples per minute and probably limited by devices 4800 baud rate.

i needed a program to monitor AC volt of 110/120.
i am having a hard time keeping track of a low voltage automatically
you will have add source code for that if you want to do a better job.
i broke my new multimeter on accident just as i finished the testing of what is here. you cannot expect much for 50 dollars and i plugged the wrong lead into the wrong hole and had some nice sparks. I really was testing the protection built into the multimeter in the case somebody had done that at my offices. I would rather test that than somebody get hurt.
Of course my test leads where custom made up to use a regular ac outlet receptacle rather than using those little pointed metal probes.

The Radio shack Multimeter 22-812 has a RS 232 connection.
I used an Ativa 828-545 USB to Serial adapter from Office Depot on a WinXPsp3 to connect to the multimeter.


Code:
'comm28812
'program to monitor a radio shack multimeter model 22-812
'when set in voltage mode
'
#COMPILER PBCC 6
#COMPILE EXE
#DIM ALL

GLOBAL g_spacketstartpattern AS STRING

FUNCTION convertfromdisplaycode(BYVAL x AS LONG) AS LONG
SELECT CASE x
'display codes for whole digits
    CASE 215
        FUNCTION=0
        EXIT FUNCTION
    CASE 80
        FUNCTION=1
        EXIT FUNCTION
    CASE 181
        FUNCTION=2
        EXIT FUNCTION
    CASE 241
        FUNCTION=3
        EXIT FUNCTION
    CASE 114
        FUNCTION=4
        EXIT FUNCTION
    CASE 227
        FUNCTION=5
        EXIT FUNCTION
    CASE 231
        FUNCTION=6
        EXIT FUNCTION
    CASE 89
        FUNCTION=7
        EXIT FUNCTION
    CASE 247
        FUNCTION=8
        EXIT FUNCTION
    CASE 243
        FUNCTION=9
        EXIT FUNCTION
 'display codes for decimals digits
    CASE 223
        FUNCTION=0
        EXIT FUNCTION
    CASE 88
        FUNCTION=1
        EXIT FUNCTION
    CASE 189
        FUNCTION=2
        EXIT FUNCTION
    CASE 249
        FUNCTION=3
        EXIT FUNCTION
    CASE 122
        FUNCTION=4
        EXIT FUNCTION
    CASE 235
        FUNCTION=5
       EXIT FUNCTION
     CASE 239
        FUNCTION=6
        EXIT FUNCTION
     CASE 1
        FUNCTION=7
        EXIT FUNCTION
     CASE 255
        FUNCTION=8
        EXIT FUNCTION
     CASE 251
        FUNCTION=9
        EXIT FUNCTION
     CASE ELSE
        FUNCTION=x
        EXIT FUNCTION
END SELECT
END FUNCTION

FUNCTION displaypacket(BYVAL spacket AS STRING) AS LONG
    LOCAL i AS LONG
    LOCAL icsum AS LONG
    DIM  ipacket(9) AS STATIC LONG
    STATIC icounter AS QUAD
    STATIC icountbadcksum AS QUAD
    LOCAL  ivoltage AS LONG
    LOCAL ilowrange AS LONG
    STATIC ivoltagehigh AS LONG
    STATIC ivoltagemin AS LONG
    STATIC ivoltagelow AS LONG
    STATIC scurrentdatetime AS STRING
    STATIC sbadchksummessage AS STRING
    STATIC sdatehigh AS STRING
    STATIC sdatelow AS STRING
    STATIC sdatemin AS STRING


    FOR i=1 TO 9
         ipacket(i)=ASC(spacket,i)
    NEXT i


   ' ipacket(1) must equal 1
   ' ipacket(2) must equal 2
   ' ipacket(3) must equal 0

    IF ipacket(1)<>1 OR ipacket(2)<>2 OR ipacket(3)<>0 OR ipacket(8)<6 OR ipacket(8)>7 THEN
        CON.CLS
        STDOUT "Make sure the multimeter is in volts mode"
    EXIT FUNCTION
    END IF

    iCSum = 0
    FOR i = 1 TO 8
    iCSum  = icSum + ipacket(i)
    NEXT
    iCSum = ((iCSum + 57 )MOD  256)
    IF ipacket(9)<>(icsum) THEN
          STDOUT "checksum "+STR$(ipacket(9))+" "+STR$(icsum)
          INCR icountbadcksum
          sbadchksummessage="number of bad checksums in packets"+STR$(icountbadcksum)+$CRLF
          sbadchksummessage+="counter "+STR$(icounter)+$CRLF
          sbadchksummessage+="bad checksum  in paceket = "+STR$(ipacket(9))+"  calculated ="+STR$(icsum)+$CRLF
          FOR i=1 TO 9
                sbadchksummessage+=STR$(i)+" "+STR$(ipacket(i))+$CRLF
          NEXT i
    END IF

    ivoltage=convertfromdisplaycode(ipacket(7))*1000+_
            convertfromdisplaycode(ipacket(6))*100+_
            convertfromdisplaycode(ipacket(5))*10+_
            convertfromdisplaycode(ipacket(4))

    INCR icounter
    scurrentdatetime=MID$(DATE$,7,4)+"-"+MID$(DATE$,1,5)+" "+TIME$

    IF ivoltage>ivoltagehigh THEN ivoltagehigh=ivoltage:sdatehigh=scurrentdatetime
    IF ivoltagelow=0 THEN ivoltagelow=ivoltagehigh:sdatelow=scurrentdatetime
    IF ivoltagemin=0 THEN ivoltagemin=ivoltagehigh:sdatemin=scurrentdatetime
    ilowrange=ivoltagehigh-(ivoltagehigh*25)
    IF ivoltage<>0 THEN IF ivoltage<ivoltagemin THEN ivoltagemin=ivoltage:sdatemin=scurrentdatetime
    IF ivoltage<>0 THEN IF ivoltage<ivoltagelow AND ivoltage>ilowrange THEN  ivoltagelow=ivoltage:sdatelow=scurrentdatetime
    CON.CLS
    STDOUT "Radio Shack Multimeter Model 22-812"
    IF ipacket(8)=6 THEN
        STDOUT "in mode RS-232 AC volts"
        ELSE
        STDOUT "in mode Auto RS-232 AC volts"
    END IF
    STDOUT  "current   "+FORMAT$(ivoltage*.1,"#.0")    +"    "+scurrentdatetime
    STDOUT  "high      "+FORMAT$(ivoltagehigh*.1,"#.0")+"    "+sdatehigh
    STDOUT  "low       "+FORMAT$(ivoltagelow*.1,"#.0") +"    "+sdatelow
    STDOUT  "min       "+FORMAT$(ivoltagemin*.1,"#.0") +"    "+sdatemin
    STDOUT "# of packets read"+STR$(icounter)
    STDOUT "# of bad checksums"+STR$(icountbadcksum)

END FUNCTION


FUNCTION processstream(BYREF sdatastream AS STRING) AS LONG
    LOCAL i AS LONG
    LOCAL j AS LONG
    STATIC icounternodata AS QUAD
    LOCAL spacket AS STRING
    J=INSTR(sdatastream,g_spacketstartpattern)
    IF J=0 THEN
        INCR icounternodata
        IF icounternodata>10 THEN
        icounternodata=0
        CON.CLS
        STDOUT "Make sure the multimeter is in volts mode"
        IF LEN(sdatastream)>250 THEN sdatastream=""
        EXIT FUNCTION
        END IF
    END IF
    STDOUT ".";
    IF LEN(sdatastream)=9 AND J=1 THEN
        spacket=sdatastream
        displaypacket(spacket)
        sdatastream=""
        EXIT FUNCTION
    END IF
    processlargestreamloop:
    IF LEN(sdatastream)>(j+7) THEN
       spacket=MID$(sdatastream,j,9)
       displaypacket(spacket)
       IF LEN(sdatastream)>(J+8) THEN
           sdatastream=RIGHT$(sdatastream,LEN(sdatastream)-j-8)
           J=INSTR(sdatastream,g_spacketstartpattern)
           IF J THEN GOTO processlargestreamloop
           ELSE
           sdatastream=""
       END IF
    END IF
END FUNCTION



'------------------------------------------------------------------------------
' Main program entry point...
'
FUNCTION PBMAIN () AS LONG

    LOCAL nComm   AS LONG    ' file number of open comm port.
    LOCAL ncbData AS LONG    ' bytes of data waiting
    LOCAL sData   AS STRING  ' data received or to send
    LOCAL sdatastream AS STRING
    LOCAL scommport AS STRING
    LOCAL icommportnumber AS LONG
    LOCAL sinkey AS STRING

    g_spacketstartpattern=CHR$(1)+CHR$(2)+CHR$(0)

    ' Set the commport from the command tail
    scommport = UCASE$(TRIM$(COMMAND$))

    STDOUT "Program to monitor a Radio Shack digital multimeter model 22-812"

    IF LEFT$(scommport,3)<> "COM" OR LEN(scommport)<4 OR INSTR(scommport," ") THEN
        STDOUT "Place the COM port name (COM1,COM2,COM3,COM4...) on the command tail"
        STDOUT "  used in connecting to the multimeter."
        STDOUT "Make sure the multimeter is already in RS232 mode and "
        STDOUT "  producing a digital readout in volts."
        EXIT FUNCTION
    END IF
    icommportnumber=VAL(RIGHT$(scommport,LEN(scommport)-3))
    IF icommportnumber<1 OR icommportnumber>4 THEN
        STDOUT "The com port is not set to a number of 1 to 9, use COMx"
        EXIT  FUNCTION
    END IF

    STDOUT "Set the multimeter in RS-232 mode and set in AC Volts mode."
    STDOUT "Make sure the multimeter display is displaying properly "
    STDOUT "  a digital readout in volts"
    STDOUT "The comm port monitored is "+scommport
    STDOUT ""
    STDOUT "  press any key to start the program"
    WAITKEY$


    ERRCLEAR
    ' Open the comm port. Exit if it can't be opened.
    nComm = FREEFILE
    COMM OPEN scommport AS #nComm
    IF ERR THEN
        STDERR "Can't open comm port " & scommport
        EXIT FUNCTION
    END IF
    CON.CLS
    STDOUT ""
    STDOUT "Connected to and communicating on " & scommport
    STDOUT ""
    STDOUT ".... Pressing the <ESC> escape key will end this program  ...."
    STDOUT ""
    STDOUT "The program will start monitoring the comm port in 5 seconds"
    SLEEP 5000
    IF INSTAT THEN
         sinkey = INKEY$
         IF sinkey = $ESC THEN  EXIT FUNCTION
    END IF
    sinkey=""

    COMM SET #nComm, BAUD   = 4800  ' 4800 baud
    COMM SET #nComm, BYTE   = 8     ' 8 bits
    COMM SET #nComm, PARITY = 0     ' No parity
    COMM SET #nComm, STOP   = 1    ' 1 stop bit

    DO
        ' Handle data from the serial port.
        ncbData = COMM(#nComm, RXQUE)
        IF ncbData>8 THEN
             COMM RECV #nComm, ncbData, sData
             sdatastream+=sdata
             IF LEN(sdatastream)>8 THEN processstream(sdatastream)
         END IF

       '  if an esc key is pressed then end the program
        IF INSTAT THEN
            sinkey = INKEY$
            IF sinkey = $ESC THEN  EXIT DO
        END IF
        ' Give other processes a chance to run.
        SLEEP 10
    LOOP

    ' Close the comm port.
    COMM CLOSE #nComm
END FUNCTION
Attached Files
File Type: zip RS22812.ZIP (23.3 KB, 25 views)
__________________
p purvis
Reply With Quote
  #4  
Old Apr 2nd, 2012, 07:12 AM
paul d purvis paul d purvis is offline
Member
 
Join Date: Mar 2003
Posts: 1,646
Check out the code

CASE 1
FUNCTION=7

These lines seem to return the proper digit but it looked odd too me, there might be an error here

and the line of code that is
STDOUT ".";
i had to have this in code to make my program continue in the case somebody starts trying to mark a section to do a copy while in the console window while the program was gathering serial data in the background
i do not have a clue what was going on with this issue, but adding some output code at near that location, appeared to have solved any problems.
After the user selects the box to copy to the clipboard, the program will process the built up ever growing string data from the serial port.
__________________
p purvis
Reply With Quote
  #5  
Old Apr 9th, 2012, 08:47 PM
paul d purvis paul d purvis is offline
Member
 
Join Date: Mar 2003
Posts: 1,646
i have altered the code for 22-812 above
this code should prove more helpful in anybody designing a program for this radio shack device

i removed two large functions that handled the datastream and displaying of the received information. now that information is all together in the pbmain function with a couple of other functions to handle some data conversions.
it is a bit more streamlined.
my equipment had just blown some fuses while i turned the dial settings to other non AC voltage reading while having the probes in the AC outlet and it was not damaged.

This program will give reports of different dial settings as you turn the dial, but it is made mostly to handle AC voltage readings.

This program logs to a file, RSMETER.LOG, all AC voltage readings below 120 and above 126, as well as the date and time and the battery status of the multimeter.
personally i like to know when my voltage is anything below 120 even though a +/-5% from 120 voltage is ok by USA national standards, if i read right in some papers off the internet.

i just put the battery status in and it should work. i will be finding out soon, as the multimeter is running 24 hours a day, alone with this program at a distance of a 2 hour automobile ride.
so i put the battery status in the display and log and for what is worth, i am remotely monitoring the computer hooked up the the multimeter on an off and on basis.
readings are received from the serial port at about 4 per second from the multimeter, which i do not believe you can get any faster reading from the RS 22-812 multimeter models i have tested.

one last thing needs to be done and i just forgot to do it. the log file needs to opened in a shared mode for reading so you can view or copy the log file while this program continues to record data to the log file.


Code:
'comm28812
'program to monitor a radio shack multimeter model 22-812
'
#COMPILER PBCC 6
#COMPILE EXE
#DIM ALL

GLOBAL g_spacketstartpattern AS STRING
GLOBAL g_decimal AS LONG

FUNCTION readingmode(BYREF a AS LONG) AS STRING
  SELECT CASE a
  CASE 0
      FUNCTION="Voltage DC Direct Current"
  CASE 1
      FUNCTION="Voltage AC Alternating Current"
  CASE 2
      FUNCTION="uA DC Direct Current"
  CASE 3
      FUNCTION="mA DC Direct Current"
  CASE 4
      FUNCTION="A  DC Direct Current"
  CASE 5
      FUNCTION="uA AC Alternating Current"
  CASE 6
      FUNCTION="mA AC Alternating Current"
  CASE 7
      FUNCTION="A  AC Alternating Current"
  CASE 8
      FUNCTION="Ohm"
  CASE 9
      FUNCTION="CAP"
  CASE 10
      FUNCTION="Hz
  CASE 11
      FUNCTION="NET hz"
  CASE 12
      FUNCTION="AMP hz"
  CASE 13
      FUNCTION="Duty"
  CASE 14
      FUNCTION="NET Duty"
  CASE 15
      FUNCTION="AMP Duty
  CASE 16
      FUNCTION="Width"
  CASE 17
      FUNCTION="NET Width
  CASE 18
      FUNCTION="AMP Width"
  CASE 19
      FUNCTION="Diode"
  CASE 20
      FUNCTION="Continuity mode"
  CASE 21
      FUNCTION="hFE"
  CASE 22
      FUNCTION="LOGIC"
  CASE 23
      FUNCTION="dBm"
  CASE 24
      FUNCTION="EF"
  CASE 25
      FUNCTION="TEMP
  CASE ELSE
      FUNCTION="Unkn"
END SELECT
END FUNCTION


FUNCTION convertfromdisplaycode(BYVAL x AS LONG) AS LONG
SELECT CASE x
    CASE 215
        FUNCTION=0
        EXIT FUNCTION
    CASE 80
        FUNCTION=1
        EXIT FUNCTION
    CASE 181
        FUNCTION=2
        EXIT FUNCTION
    CASE 241
        FUNCTION=3
        EXIT FUNCTION
    CASE 114
        FUNCTION=4
        EXIT FUNCTION
    CASE 227
        FUNCTION=5
        EXIT FUNCTION
    CASE 231
        FUNCTION=6
        EXIT FUNCTION
    CASE 81
        FUNCTION=7
        EXIT FUNCTION
    CASE 247
        FUNCTION=8
        EXIT FUNCTION
    CASE 243
        FUNCTION=9
        EXIT FUNCTION
 'number below this line indicate the decimal is to right of the number
    CASE 223
        g_decimal=1
        FUNCTION=0
        EXIT FUNCTION
    CASE 88
        g_decimal=1
        FUNCTION=1
        EXIT FUNCTION
    CASE 189
        g_decimal=1
        FUNCTION=2
        EXIT FUNCTION
    CASE 249
        g_decimal=1
        FUNCTION=3
        EXIT FUNCTION
    CASE 122
        g_decimal=1
        FUNCTION=4
        EXIT FUNCTION
    CASE 235
        g_decimal=1
        FUNCTION=5
       EXIT FUNCTION
    CASE 239
        g_decimal=1
        FUNCTION=6
        EXIT FUNCTION
    CASE 89
        g_decimal=1
        FUNCTION=7
        EXIT FUNCTION
    CASE 255
        g_decimal=1
        FUNCTION=8
        EXIT FUNCTION
    CASE 251
        g_decimal=1
        FUNCTION=9
        EXIT FUNCTION
    CASE ELSE
        FUNCTION=x
        EXIT FUNCTION
END SELECT
END FUNCTION


FUNCTION calccksum(BYREF a AS STRING) AS LONG
LOCAL i AS LONG
LOCAL x AS LONG
    x=0
    FOR i = 1 TO 8
    x+=ASC(a,i)
    NEXT
    FUNCTION=ASC(a,9)-(((x+ 57 )MOD  256))
END FUNCTION




'------------------------------------------------------------------------------
' Main program entry point...
'
FUNCTION PBMAIN () AS LONG

    LOCAL nComm   AS LONG    ' file number of open comm port.
    LOCAL ncbData AS LONG    ' bytes of data waiting
    LOCAL sData   AS STRING  ' data received or to send
    LOCAL sdatastream AS STRING
    LOCAL scommport AS STRING
    LOCAL icommportnumber AS LONG
    LOCAL sinkey AS STRING
    LOCAL sprevioussdata AS STRING
    LOCAL idecimalpoint AS LONG
    DIM idecimals(4) AS LONG
    LOCAL ilcdnumber AS LONG
    DIM imessage(8) AS LONG
    DIM iscope(8) AS LONG
    LOCAL smessage AS STRING
    LOCAL sscope AS STRING
    LOCAL slcdnumber AS STRING
    LOCAL sfile AS STRING
    LOCAL ifile AS LONG
    LOCAL tempstring AS STRING
    LOCAL sBatterystatus AS STRING
    g_spacketstartpattern=CHR$(1)+CHR$(2)+CHR$(0)


    ' Set the commport from the command tail
    scommport = UCASE$(TRIM$(COMMAND$))
    STDOUT "Program to monitor a Radio Shack digital multimeter model 22-812"

    IF LEFT$(scommport,3)<> "COM" OR LEN(scommport)<4 OR INSTR(scommport," ") THEN
        STDOUT "Place the COM port name (COM1,COM2,COM3,COM4...) on the command tail"
        STDOUT "  used in connecting to the multimeter."
        STDOUT "Make sure the multimeter is already in RS232 mode and "
        STDOUT "  producing a digital readout in volts."
        EXIT FUNCTION
    END IF
    icommportnumber=VAL(RIGHT$(scommport,LEN(scommport)-3))
    IF icommportnumber<1 OR icommportnumber>4 THEN
        STDOUT "The com port is not set to a number of 1 to 9, use COMx"
        EXIT  FUNCTION
    END IF

    STDOUT "Set the multimeter in RS-232 mode and set in AC Volts mode."
    STDOUT "Make sure the multimeter display is displaying properly "
    STDOUT "  a digital readout in volts"
    STDOUT "The comm port monitored is "+scommport
    STDOUT ""
    STDOUT "  press any key to start the program"
 '   WAITKEY$


    ERRCLEAR
    ' Open the comm port. Exit if it can't be opened.
    nComm = FREEFILE
    ifile=FREEFILE
    COMM OPEN scommport AS #nComm
    IF ERR THEN
        STDERR "Can't open comm port " & scommport
        EXIT FUNCTION
    END IF
    CON.CLS
    STDOUT ""
    STDOUT "Connected to and communicating on " & scommport
    STDOUT ""
    STDOUT ".... Pressing the <ESC> escape key will end this program  ...."
    STDOUT ""
    STDOUT "The program will start monitoring the comm port in 3 seconds"

    SLEEP 3000
    IF INSTAT THEN
         sinkey = INKEY$
         IF sinkey = $ESC THEN  EXIT FUNCTION
    END IF
    sinkey=""

    COMM SET #nComm, BAUD   = 4800  ' 4800 baud
    COMM SET #nComm, BYTE   = 8     ' 8 bits
    COMM SET #nComm, PARITY = 0     ' No parity
    COMM SET #nComm, STOP   = 1    ' 1 stop bit
    sfile="RSMETER.LOG"
    OPEN sfile FOR APPEND AS #ifile
     tempstring =  $DQ+MID$(DATE$,7,4)+"-"+MID$(DATE$,1,5)+" "+TIME$+$DQ+","+TRIM$("-1")+","+TRIM$(STR$(-1))+","+$DQ+"Battery status unkn"+$DQ
     PRINT  #ifile,tempstring
     FLUSH #ifile

    DO
        ' Handle data from the serial port.
        ncbData = COMM(#nComm, RXQUE)
        IF ncbdata>8 THEN
          COMM RECV #nComm, ncbData, sData

          IF LEN(sdata)<>9 THEN ITERATE DO
          IF calccksum(sdata) THEN ITERATE DO

          IF LEFT$(sdata,2)<>LEFT$(sprevioussdata,2) THEN
              sprevioussdata=sdata
              ITERATE DO
          END IF

           LOCAL i AS LONG
           DIM ipacket(9) AS LONG
           FOR i=1 TO 9
           ipacket(i)=ASC(sdata,i)
           NEXT i

          IF ipacket(1)<>1 OR ipacket(2)<>2 THEN
               CON.CLS
               STDOUT "Make sure the multimeter is in volts mode"
               ITERATE DO
          END IF

           idecimalpoint=0
           FOR i=4 TO 7
              g_decimal=0
              idecimals(i-3)=convertfromdisplaycode(ipacket(i))
               IF g_decimal=1 THEN idecimalpoint=i-3
           NEXT i

           ilcdnumber=idecimals(4)*1000+idecimals(3)*100+idecimals(2)*10+idecimals(1)
           FOR i=0 TO 7
                 iscope(i)=BIT(ipacket(2),i)
               imessage(i)=BIT(ipacket(8),i)
           NEXT I


           smessage="Radio Shack Model 22-812 Multimeter"+$CRLF+"mode "
             IF imessage(1) THEN smessage+="RS-232 "
             IF imessage(4) THEN smessage+="on HOLD status "
             'IF imessage(5) THEN smessage+="Battery Low"
             IF imessage(6) THEN smessage+="Diode "
             IF imessage(7) THEN smessage+="Beeping "
             IF BIT(ipacket(3),1) THEN smessage+="REL"
             IF imessage(5) THEN
                 sbatterystatus="Battery Low"
                 ELSE
                 sbatterystatus="Battery Good"
             END IF


             sscope=""
             IF iscope(0) THEN sscope+="m"
             IF iscope(1) THEN sscope+="V"
             IF iscope(2) THEN sscope+="A"
             IF iscope(3) THEN sscope+="F"
             IF iscope(4) THEN sscope+="M"
             IF iscope(5) THEN sscope+="K"
             IF iscope(6) THEN sscope+="ohm"
             IF iscope(7) THEN sscope+="Hz"

             IF ipacket(3)=128 THEN sscope+="u"
             IF BIT(ipacket(3),2) THEN sscope+="hfe "
             IF BIT(ipacket(3),5) THEN sscope+="dBm "

             IF BIT(ipacket(3),0) THEN sscope+=" Min"
             IF BIT(ipacket(7),3) THEN sscope+=" Max"

              slcdnumber=""
            '  IF imessage(2) THEN slcdnumber+="~ "
            '  IF imessage(3) THEN slcdnumber+="-"

              SELECT CASE idecimalpoint
                  CASE 0
                      slcdnumber+=FORMAT$(ilcdnumber,"0")
                  CASE 1
                      slcdnumber+=FORMAT$(ilcdnumber*.1,"0.0")
                  CASE 2
                      slcdnumber+=FORMAT$(ilcdnumber*.01,"0.00")
                  CASE 3
                      slcdnumber+=FORMAT$(ilcdnumber*.001,"0.000")
                  CASE 4
                      slcdnumber+=FORMAT$(ilcdnumber*.0001,"0.0000")
               END SELECT
               '   slcdnumber+="  "+sscope


             CON.CLS
             STDOUT smessage
             STDOUT sbatterystatus
             STDOUT readingmode(ipacket(1));
             IF imessage(0) THEN  STDOUT "   Auto ranging";
             STDOUT ""
             IF ipacket(5)=39 OR ipacket(5)=47 THEN
                  IF ipacket(4)=0 OR ipacket(4)=8 THEN
                     IF ipacket(6)=223 OR ipacket(6)=215 THEN STDOUT "voltage is out of range":ITERATE DO
                  END IF
             END IF
            LOCAL dlcdnumber AS SINGLE
            dlcdnumber=VAL(slcdnumber)

            IF dlcdnumber>750 AND ipacket(1)=1 THEN STDOUT "voltage is out of range":ITERATE DO
            IF ilcdnumber=0 THEN STDOUT "voltage is zero, there must be an error or"+$CRLF+_
                " the multimeter is not set proper or unplugged or there is no electrical source or "+$CRLF+_
                "the multimeter is disconnected for the computer":ITERATE DO

             STDOUT slcdnumber;
             STDOUT "  "+sscope;
                  IF imessage(4) THEN STDOUT "  on HOLD status, press the HOLD button on multimeter to release";

             STDOUT ""


          '   for i=1 to 9
          '      STDOUT STR$(ipacket(i)) 'this byte is always zero comming from the multimeter
          '   next i
            IF ilcdnumber<>0 AND ipacket(1)=1 AND ipacket(2)=2 THEN
            IF dlcdnumber<120 OR dlcdnumber>126 THEN
                tempstring =  $DQ+MID$(DATE$,7,4)+"-"+MID$(DATE$,1,5)+" "+TIME$+$DQ+","+TRIM$(slcdnumber)+","+TRIM$(STR$(ilcdnumber))+","+$DQ+sbatterystatus+$DQ
                PRINT  #ifile,tempstring
                FLUSH #ifile
             END IF
             END IF

             ITERATE DO

             sdatastream+=sdata
           IF LEN(sdatastream)>8 THEN
               'processstream(sdatastream)
               sdatastream=""
               END IF
        ELSE
           '  if an esc key is pressed then end the program
           IF INSTAT THEN
             sinkey = INKEY$
             IF sinkey = $ESC THEN  EXIT DO
           END IF
           ' Give other processes a chance to run.
           SLEEP 10
        END IF

    LOOP

    ' Close the comm port.
    COMM CLOSE #nComm
    'log the ending date and time to the log file
    tempstring =  $DQ+MID$(DATE$,7,4)+"-"+MID$(DATE$,1,5)+" "+TIME$+$DQ+","+TRIM$("-2")+","+TRIM$(STR$(-2))+","+$DQ+sbatterystatus+$DQ
    PRINT  #ifile,tempstring
    FLUSH #ifile
    CLOSE ifile

END FUNCTION
__________________
p purvis

Last edited by paul d purvis; Apr 9th, 2012 at 08:54 PM.
Reply With Quote
  #6  
Old Oct 10th, 2012, 06:23 AM
Stephane Fonteyne Stephane Fonteyne is online now
Member
 
Join Date: Aug 2002
Location: BELGIUM
Posts: 1,311
It doesn"t compile in PBWIN10 and PBCC6

Hi,

Please, can you posted code for the Windows version and Console version that can compiled with the newest compilers PBWin10 and PBCC6
Because I'm very interesting in this application for control DMM.

I have the DMM with model : Voltcraft Digital Multimeter M-3860M
What piece of code can I modified for using my DMM.

Thanks
Stephane
Reply With Quote
  #7  
Old Oct 10th, 2012, 12:50 PM
paul d purvis paul d purvis is offline
Member
 
Join Date: Mar 2003
Posts: 1,646
Stephane
Quote:
I have the DMM with model : Voltcraft Digital Multimeter M-3860M
What piece of code can I modified for using my DMM.
Is that for directed to me. I have been off the forums awhile.
__________________
p purvis
Reply With Quote
  #8  
Old Oct 10th, 2012, 01:29 PM
Arthur Gomide Arthur Gomide is offline
Member
 
Join Date: Dec 2005
Location: Ribeirão Preto, SP - Brasil
Posts: 878
Code from post #1 compiled with PBWin 7.04 and attached
Attached Files
File Type: zip Data Logger for the Radio Shack DMM.zip (28.7 KB, 20 views)
__________________
“Quando os que comandam perdem a vergonha, os que obedecem perdem o respeito” - Georg Lichtenberg (1742-1799)
Reply With Quote
  #9  
Old Oct 10th, 2012, 04:48 PM
paul d purvis paul d purvis is offline
Member
 
Join Date: Mar 2003
Posts: 1,646
The pbcc60 source code and exe that i am currently using to log only AC volts from the radio shack.

Without me reviewing the code or running it now, there are likely some IF THEN GOTO statements that cause the filtering out of non "AC Volts" messages to be logged.

Using a decent new 9 volt battery to supply the multimeter with power to the Radio Shack multimeter and having the multimeter connected to a Windows XP machine by a smart usb to serial adapter(purchased at Office Depot). This program will log about 14 days of continuous information from the multimeter.

If this program is stopped and restarted, the same log file will be used.
The file name logged to does not change and to create a new log file, the program has to be stopped and the log file renamed to something other than the default log file name.

The log file is limited to drive space and the program does not check for how much drive space is available or being used.

The console window(CUI) does show the current voltage of the multimeter.
Attached Files
File Type: zip COM22812.ZIP (27.1 KB, 15 views)
__________________
p purvis

Last edited by paul d purvis; Oct 10th, 2012 at 04:54 PM.
Reply With Quote
  #10  
Old Oct 17th, 2012, 05:39 PM
Walt Thompson Walt Thompson is offline
Member
 
Join Date: Jan 2004
Location: San Jose, CA
Posts: 501
Talking Updates for use with PB 10

As posted this program will not compile under PB 10. The changes below will allow it to compile and run.

Code:
'------------------------------------------------------------------------------
' ** Includes **
'------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES
#IF NOT %DEF(%WINAPI)
#INCLUDE "WIN32API.INC"
#End If 'Change this to #ENDIF
#INCLUDE "PBForms.INC"
#PBFORMS END INCLUDES
 
'Function ReceiveData(ByVal hWnd As DWORD) As Long 'Corrected code is on the line below
THREAD Function ReceiveData(ByVal hWnd As DWORD) As Long
Dim InboundData As String
Dim Stuf As String
Dim Qty As Long
Dim i As Long
Qty = 0
InboundData = ""
 
'Change SUB start... to SUB StartMeter...
 
CASE %bStart
CONTROL SET FOCUS hDlg, %pathtxt
start 'Comment this line
CASE %bStop
CONTROL SET FOCUS hDlg, %pathtxt
The above changes will allow the program to compile and run under PB 10. I don't own a 2200812 Radio Shack meter, so I don't know if the program will communicate with the meter.
Reply With Quote
  #11  
Old Nov 15th, 2012, 09:14 AM
Doug McDonald Doug McDonald is offline
Member
 
Join Date: Jun 2001
Location: Tulsa Okla
Posts: 221
It's been a long time since I posted the original code. I do have versions for pb 10 also. he reason data collection is once a second is thats how fast the meter transmits. I can't go faster unless they have updated the meter.

I'm happy some have found my code useful. Please give credit where credit is do.

Doug
__________________
Doug McDonald
KD5NWK
www.redforksoftware.com
Reply With Quote
  #12  
Old Nov 17th, 2012, 06:17 AM
paul d purvis paul d purvis is offline
Member
 
Join Date: Mar 2003
Posts: 1,646
Doug
I think the newer Radio Shack voltmeter model, that my code runs on, will send data 6 times a second. I have not looked at the code or ran the program in some time.
Basically without looking at your code and the model for which it was written, i believe the serial connection runs at a faster speed. I had an older model Radio Shack voltmeter that was slower at sending data and the serial data speed was much less than today's models. I wish they would have increased the serial data speed to something much higher inline with today's equipment capabilities as opposed to the 4800 serial baud speed.
__________________
p purvis
Reply With Quote
Reply

Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump


All times are GMT -4. The time now is 08:06 AM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.
Copyright © 1999-2011 PowerBASIC, Inc. All Rights Reserved.
Error in my_thread_global_end(): 1 threads didn't exit