contoh code program RS-485 Tester

contoh code  program RS-485 Tester

Compiler : Visual basic 6

Menu Utama:

Menu Utama rs485 tester

Menu Utama rs485 tester

Rangkaian:

Rangkaian Rs485 network

Rangkaian Rs485 network

Potongan Code program :

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetTickCount Lib "kernel32" () As Long

Dim Timeout As Boolean
Dim data_pantulan As String
Dim perintah As String
Dim messagetosend As Variant
Dim transferprogress As Boolean

Private Sub PollSlave()
Dim no_slave As Integer
Dim buffer As Variant
Dim ALAMAT As Integer
Dim ack As Boolean
Dim reply As Boolean
Dim data_dari_slave As String
ALAMAT = &H60
transferprogress = True
'mengirim alamat node tunggu ack ,kirim perintah  dan menunggu reply data
'kemudian simpan hasil

For no_slave = 1 To 8
'txtno_slave.Text = no_slave
'======hapus inbuffer dan outbuffer
MSComm1.OutBufferCount = 0
If MSComm1.InBufferCount > 0 Then
buffer = MSComm1.Input
End If
'===================================
Call enabletransmitter ' -->

ALAMAT = ALAMAT + 1   ' alamat = 68h,69h,6Ah,6Bh,6Ch,6Dh,6Eh,6Fh
alamat_slave = Chr(ALAMAT)
txtno_slave.Text = alamat_slave
buffer = Chr(ALAMAT)
'MsgBox buffer
'kirim alamat ke i
MSComm1.Output = buffer
'=======================================================================
Do 'tunggu pantulan byte alamat yg dikirim
txtstatus.Text = "tunggu pantulan alamat = " & buffer
tmrTimeout.Enabled = True
Timeout = False
     '===============sampe trima 1 byte alamat pantulan
      Call disabletransmitter  '<--
      Do
     DoEvents
     Loop Until (MSComm1.InBufferCount >= 1) Or (Timeout = True)
     '=================

     If Timeout = False Then

     tmrTimeout.Enabled = False
     'baca byte pantulan  dan bandingkan dgn yg dikirim
      data_pantulan = MSComm1.Input
      txtalamatslave.Text = txtalamatslave.Text & Asc(data_pantulan)

      If StrComp(data_pantulan, alamat_slave, vbBinaryCompare) = 0 Then
       ack = True
      txtstatus.Text = "alamat sama okehh"
      Else
            ack = False
        txtstatus.Text = " alamat  beda"
      End If

    Else
     lbtimeout.Caption = "waiting adress timeout slave no " & no_slave
      ack = False
    End If
Loop Until ack = True Or Timeout = True
tmrTimeout.Enabled = False
Timeout = False
'=========================================================================
txtinbuffer.Text = " count= " & MSComm1.InBufferCount & "  size = " & MSComm1.InBufferSize & "  isi = " & MSComm1.Input

If ack = True Then
'================================================================
Call enabletransmitter  '-->  Out
perintah = "b"  'kirim perintah baca data output
messagetosend = perintah
tmrTimeout.Interval = 1000
tmrTimeout.Enabled = True
ack = False
MSComm1.Output = messagetosend

 Call disabletransmitter  '<-- IN
 Do

 Timeout = False

 Do
 DoEvents
 Loop Until (MSComm1.InBufferCount > 4) Or (Timeout = True)

 lbtimeoutdata.Caption = "waiting reply data timeout slave no " & no_slave

  If Timeout = False Then
  tmrTimeout.Enabled = False
  data_dari_slave = MSComm1.Input

  reply = True
     If StrComp(Asc(Left(data_dari_slave, 1)), ALAMAT, vbBinaryCompare) = 0 Then
     txtoutput_ok(no_slave).Text = data_dari_slave
      'txtoutput_ng.Text = Asc(Val("&h" & Mid(data_dari_slave, 4, 2)))
     'simpanhasil(no_slave,output_ok,output_ng)
      txtdata_dari_slave.Text = txtdata_dari_slave.Text & Asc(data_dari_slave)
     txtstatus.Text = "alamat cocok"

     Else
     'alamat data tdk cocok
      txtstatus.Text = "alamat tdk cocok"
      End If

  Else
lbtimeoutdata.Caption = "waiting reply data timeout slave no " & no_slave

  End If

Loop Until reply = True Or Timeout = True
tmrTimeout.Enabled = False
'====================================================
End If
txtoutbuffer.Text = " count= " & MSComm1.OutBufferCount & "  size = " & MSComm1.OutBufferSize

Next no_slave

transferprogress = False
tmrTimeout.Enabled = False
txtstatus.Text = "selesai 1 loop"
End Sub
Private Sub tmrTimeout_Timer()
tmrTimeout.Enabled = False
Timeout = True
End Sub

Private Sub enabletransmitter()
'Call delay(200)
MSComm1.RTSEnable = False
'Call delay(200)
End Sub
Private Sub disabletransmitter()
MSComm1.RTSEnable = True
End Sub
Private Sub Form_Load()
Call cmdOpen_Click
End Sub

Private Sub Form_Unload(Cancel As Integer)
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False

End Sub

Private Sub cmdstart_Click()
If MSComm1.PortOpen = False Then Exit Sub
Call Poll
tmrtransferinterval.Enabled = True
End Sub

Private Sub cmdstop_Click()
tmrtransferinterval.Enabled = False
End Sub

Private Sub cmdOpen_Click()

If MSComm1.PortOpen = False Then
   MSComm1.Settings = "9600,N,8,1"
   MSComm1.CommPort = 1
   MSComm1.PortOpen = True
 End If

End Sub

Private Sub tmrtransferinterval_Timer()
If transferprogress = False Then
Call Poll
End If
End Sub
Advertisements

About pccontrol

Berisi Tutorial Menggunakan PC untuk mengontrol Peralatan dengan cara mudah & praktis.

Posted on 08/06/2011, in Contoh-contoh Aplikasi. Bookmark the permalink. Leave a comment.

Komentar ,Saran atau Pertanyaan

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: