function writing problem

Private Sub Command1_Click()
On Error GoTo trap
Dim timeout As Variant
Dim sende As String
Dim checksum As String
Dim i
MSCmm1.PortOpen = True
Command1.Enabled = False
sende = ""
empfang = ""
'sende = Chr$(&H10) + Chr$(&H5B) + Chr$(&HFE) + Chr$(&H59) + Chr$(&H16) 'Direct communication for the CF-ECHO
sende = Chr$(&H10) + Chr$(&H5B) + Chr$(&H1) + Chr$(&H5C) + Chr$(&H16) 'First external Communication attached to CF-ECHO

MSCmm1.Output = sende
timeout = Now() + 2 / 86400
Do
DoEvents
Loop Until Now() > timeout
Print Len(empfang)

Text1.Text = ""
For i = 1 To Len(empfang)
Text1.Text = Text1.Text + " " + HexByte(Asc(Mid(empfang, i, 1)))
Next


Print "Tv=", Val(HexByte(Asc(Mid(empfang, 51, 1))) + HexByte(Asc(Mid(empfang, 50, 1)))) / 10
Print "Return Temparature =", Val(HexByte(Asc(Mid(empfang, 55, 1))) + HexByte(Asc(Mid(empfang, 54, 1))))
/ 10

Command1.Enabled = True
MSCmm1.PortOpen = False

trap:

End Sub
Private Sub MSCmm1_OnComm()
empfang = empfang + MSCmm1.Input
End Sub
Private Function HexByte(b As Byte) As String

Const HexChar = "0123456789ABCDEF"
Dim upbit As Byte 'Upper Nibble
Dim lowbit As Byte 'Lower Nibble
upbit = b \ 16
lowbit = b Mod 16
HexByte = Mid(HexChar, upbit + 1, 1) + Mid(HexChar, lowbit + 1, 1)

End Function

The above code is working form for calculation of temparature from a
device attached to com1 port and another two objects are
connected,which delivers the required temparature.

Now my problem is i must do the following
Empfang function writing
sende code for 1 to the empfang
data receiving for sende code1 from the empfang function
sende code for 2 to the empfang
data receiving for sende code2 from the emfang function
sende code for either 1 or 2 to use the empfang function to receive 1 & 2 sende together
For which i do wrote the code like the following but i could not able
to receive the output as i required

Option Explicit
Dim sende As String
Dim i

Private Function empfang(str As String)
Dim timeout As Variant

' empfang = ""

str = ""
For i = 1 To Len(str)
str = str + " " + HexByte(Asc(Mid(empfang, i, 1)))
Next
timeout = Now() + 2 / 86400
Do
DoEvents
Loop Until Now() > timeout
Print Len(str)


'timeout = Now() + 2 / 86400
' Do
' DoEvents
' Loop Until Now() > timeout
' Print Len(str)
empfang = str
End Function
Private Function HexByte(b As Byte) As String
'This function a byte converts into Hex representation
Const HexChar = "0123456789ABCDEF"
Dim upbit As Byte 'Upper Nibble
Dim lowbit As Byte 'Lower Nibble
upbit = b \ 16
lowbit = b Mod 16
HexByte = Mid(HexChar, upbit + 1, 1) + Mid(HexChar, lowbit + 1, 1)
'Hex for representation for byte produce
End Function

Private Sub Command1_Click()

Dim checksum As String

Dim s As String
MSCmm1.PortOpen = True
Command1.Enabled = False
sende = ""
s = ""
'sende = Chr$(&H10) + Chr$(&H5B) + Chr$(&HFE) + Chr$(&H59) +
Chr$(&H16) 'Direct communication for the CF-ECHO
sende = Chr$(&H10) + Chr$(&H5B) + Chr$(&H1) + Chr$(&H5C) +
Chr$(&H16) 'First external Communication attached to CF-ECHO
Call empfang(sende)

'MSCmm1.Output = sende
''s = Val(HexByte(Asc(Mid(s, 51, 1))) + HexByte(Asc(Mid(s, 50,
1)))) / 10
's = 33
'Print HexByte(Asc(Mid(s, 51, 1)))
''Print "Tv=", Val(HexByte(Asc(Mid(s, 51, 1))) + HexByte(Asc(Mid(s,
50, 1)))) / 10
'Print "Return Temparature =", Val(HexByte(Asc(Mid(s, 55, 1))) +
HexByte(Asc(Mid(s, 54, 1)))) / 10

Command1.Enabled = True
MSCmm1.PortOpen = False

'trap:

End Sub

Private Sub Form_Load()
MSCmm1.Settings = "9600, e, 8, 1"
MSCmm1.CommPort = 1
End Sub


vb123

I am having trouble trying to understand what you are trying to do.

It looks like the psuedo code for your working program may go as follows:

Set up a string (sende)
Send string to Com1
Read reply from Com1 into variable (empfang)
Parse variable (empfang) and print out data

A brief look at the code you have for the new function:

str = "" :you have just cleared your argument (sende)

I also do not see Private Sub MSCmm1_OnComm() in the new program.

You are trying to alter the value of a function from outside that function. I do not know the implications but I doubt that it would work.

Post some pseudo code showing what you want to do and we can have another look at it.

hi Stev

thanks for giving me reply this is what i need to do in the empfang function

Maybe I misunderstood your original post. Please confirm that the code in the first part of your posting is working.

If it is not, please advise any error messages or what is happening when you run it.

Are you looking for a function where you can pass different instructions through the comm port to the device and read the replies?

Is there only one reply for each instruction or do some instructions start a continuous output from the device?

Do all outputs follow the same format?

hi stev,
my following code is working fine
Option Explicit
Dim empfang As String
Private Sub Command1_Click()
On Error GoTo trap
Dim timeout As Variant
Dim sende As String
Dim checksum As String
Dim i
MSCmm1.PortOpen = True
Command1.Enabled = False
sende = ""
empfang = ""
sende = Chr$(&H10) + Chr$(&H5B) + Chr$(&HFE) + Chr$(&H59) + Chr$(&H16) 'Direct communication for the CF-ECHO
'sende = Chr$(&H10) + Chr$(&H5B) + Chr$(&H1) + Chr$(&H5C) + Chr$(&H16) 'First external Communication attached to CF-ECHO

MSCmm1.Output = sende
timeout = Now() + 2 / 86400
Do
DoEvents
Loop Until Now() > timeout
Print Len(empfang)

Text1.Text = ""
For i = 1 To Len(empfang)
Text1.Text = Text1.Text + " " + HexByte(Asc(Mid(empfang, i, 1)))
Next


Print "Tv=", Val(HexByte(Asc(Mid(empfang, 51, 1))) + HexByte(Asc(Mid(empfang, 50, 1)))) / 10
Print "Return Temparature =", Val(HexByte(Asc(Mid(empfang, 55, 1))) + HexByte(Asc(Mid(empfang, 54, 1)))) / 10

Command1.Enabled = True
MSCmm1.PortOpen = False

trap:

End Sub
Private Sub MSCmm1_OnComm()
empfang = empfang + MSCmm1.Input
End Sub
Private Function HexByte(b As Byte) As String

Const HexChar = "0123456789ABCDEF"
Dim upbit As Byte 'Upper Nibble
Dim lowbit As Byte 'Lower Nibble
upbit = b \ 16
lowbit = b Mod 16
HexByte = Mid(HexChar, upbit + 1, 1) + Mid(HexChar, lowbit + 1, 1)

End Function





Private Sub Form_Load()
MSCmm1.Settings = "9600, e, 8, 1"
MSCmm1.CommPort = 1

End Sub
UrQuestion : Are you looking for a function where you can pass
different instructions through the comm port to the
device and read the replies?

Answer :yes i want to send different instructions like different
sendes to get the output from empfang function to
read the different temparatures of a test bench

UrQuestion :Is there only one reply for each instruction or
do some instructions start a continuous output from
the device?

Answer : I get two outputs when i send two inputs through
mscomm control. i will send u my outputs like this.

UrQuestion o all outputs follow the same format?

hi stev,
my following code is working fine
Option Explicit
Dim empfang As String
Private Sub Command1_Click()
On Error GoTo trap
Dim timeout As Variant
Dim sende As String
Dim checksum As String
Dim i
MSCmm1.PortOpen = True
Command1.Enabled = False
sende = ""
empfang = ""
sende = Chr$(&H10) + Chr$(&H5B) + Chr$(&HFE) + Chr$(&H59) + Chr$(&H16) 'Direct communication for the CF-ECHO
'sende = Chr$(&H10) + Chr$(&H5B) + Chr$(&H1) + Chr$(&H5C) + Chr$(&H16) 'First external Communication attached to CF-ECHO

MSCmm1.Output = sende
timeout = Now() + 2 / 86400
Do
DoEvents
Loop Until Now() > timeout
Print Len(empfang)

Text1.Text = ""
For i = 1 To Len(empfang)
Text1.Text = Text1.Text + " " + HexByte(Asc(Mid(empfang, i, 1)))
Next


Print "Tv=", Val(HexByte(Asc(Mid(empfang, 51, 1))) + HexByte(Asc(Mid(empfang, 50, 1)))) / 10
Print "Return Temparature =", Val(HexByte(Asc(Mid(empfang, 55, 1))) + HexByte(Asc(Mid(empfang, 54, 1)))) / 10

Command1.Enabled = True
MSCmm1.PortOpen = False

trap:

End Sub
Private Sub MSCmm1_OnComm()
empfang = empfang + MSCmm1.Input
End Sub
Private Function HexByte(b As Byte) As String

Const HexChar = "0123456789ABCDEF"
Dim upbit As Byte 'Upper Nibble
Dim lowbit As Byte 'Lower Nibble
upbit = b \ 16
lowbit = b Mod 16
HexByte = Mid(HexChar, upbit + 1, 1) + Mid(HexChar, lowbit + 1, 1)

End Function





Private Sub Form_Load()
MSCmm1.Settings = "9600, e, 8, 1"
MSCmm1.CommPort = 1

End Sub
UrQuestion : Are you looking for a function where you can pass
different instructions through the comm port to the
device and read the replies?

Answer :yes i want to send different instructions like different
sendes to get the output from empfang function to
read the different temparatures of a test bench

UrQuestion :Is there only one reply for each instruction or
do some instructions start a continuous output from
the device?

Answer : I get two outputs when i send two inputs through
mscomm control. i will send u my outputs like this.

UrQuestion o all outputs follow the same format?

Answer : Yes my output must follow the same format

stev sorry for posting my answer two times, while i wrongly pressed enter while i have to attach that zip file

vb123

Here is one way of doing what you want.

****************************************

Option Explicit
Dim senddircomm As String
Dim sendfirstexternalcom As String

Private Sub Command1_Click()

Command1.Enabled = False 'disable command buttons until empfang function finished
Command2.Enabled = False

empfang (senddircomm)

Command1.Enabled = True
Command2.Enabled = True


End Sub

Private Sub Command2_Click()

Command1.Enabled = False
Command2.Enabled = False


empfang (sendfirstexternalcom)

Command1.Enabled = True
Command2.Enabled = True


End Sub

Private Sub Form_Load()

MSComm1.Settings = "9600,e,8,1"
MSComm1.CommPort = 1
MSComm1.RThreshold = 0 'data in buffer will not cause CommEvent
senddircomm = Chr$(16) & Chr$(&H5B) & Chr$(&HFE) & Chr$(&H59) & Chr$(&H16)
sendfirstexternalcom = Chr$(16) & Chr$(&H5B) & Chr$(&H1) & Chr$(&H5C) & Chr$(&H16)

End Sub
Private Function HexByte(b As Byte) As String

Const HexChar = "0123456789ABCDEF"
Dim upbit As Byte 'Upper Nibble
Dim lowbit As Byte 'Lower Nibble

upbit = b \ 16
lowbit = b Mod 16
HexByte = Mid(HexChar, upbit + 1, 1) + Mid(HexChar, lowbit + 1, 1)


End Function
Private Function empfang(str As String) As Integer

'This function will accept a string to send to the com port
'and place the hex data into text1 and print to screen

Dim timeout As Variant
Dim TempString As String


If MSComm1.PortOpen = True Then 'Check to see if port is already open
Text1.Text = "empfang function failed. Port is already open"
MSComm1.PortOpen = False
empfang = False
Exit Function
End If

MSComm1.PortOpen = True
MSComm1.Output = str

timeout = Now() + 2 / 86200
Do
DoEvents
Loop While Now() < timeout

If MSComm1.InputLen < 60 Then
Text1.Text = "empfang function failed. Timed out before all data received"
MSComm1.PortOpen = False
empfang = False
Exit Function
End If

TempString = MSComm1.Input 'get data from buffer
Print Len(TempString)

Text1.Text = ""
For i = 1 To Len(TempString)
Text1.Text = Text1.Text + " " + HexByte(Asc(Mid(TempString, i, 1)))
Next

Print "Tv=", Val(HexByte(Asc(Mid(TempString, 51, 1))) + HexByte(Asc(Mid(TempString, 50, 1)))) / 10
Print "Return Temparature =", Val(HexByte(Asc(Mid(TempString, 55, 1))) + HexByte(Asc(Mid(TempString, 54, 1)))) / 10

MSComm1.PortOpen = False
empfang = True

End Function
************************************************** *

You wil note that I have done away with reading the buffer every time a character is received. You could declare a variable at the module level but I think this is tidier. Hope this helps.

hi stev,
ur idea is good but y i don't know when i press command1 button it is going directly to the if condition

If MSComm1.InputLen < 60 Then

Text1.Text = "empfang function failed. Timed out before all data received"
MSComm1.PortOpen = False
empfang = False
Exit Function
End If

where do we give the following command to my program? while where are we giving instruction to the comm control that we are sending input through empfang function


Private Sub MSComm1_OnComm()
empfang = empfang + MSComm1.Input
End Sub

Inputlength always becomes 0 that might be problem

vb123

I removed that partiucular subroutine so that the data would accumulate in the buffer. If you have not removed it, it will be clearing the buffer every time there is a comm event.

Add a "Print MSComm1.InputLen" statement and see what is in the buffer at this point.

MSComm1.Output = str 'This sends data to your device

TempString = MSComm1.Input ' This gets data from your device

hi stev,
that gives also 0 instead of 83 bits what i receive y i did not understand i'll try again-

vb123

Sorry to take so long to get back to you. I had to make a null modem cable to test parts of the code I wrote.

Can you send me the code you have written in a zip file?

Have you put the following lines in the General Declarations section?

Dim senddircomm As String
Dim sendfirstexternalcom As String

You check that these variables have sufficient scope by printing them just before you send them to the comm port.

I will run some tests on my code in the meantime

Found the problem with my code.

The line

If MSComm1.InputLen < 60 Then

should be

IF MSComm1.InBufferCount < 60 Then


Sorry about the error

hi stev
working nicely thank you very much for your help....

vb123