Serielle Schnittstelle ansprechen mit VB und API

Gast #533653
Lesenswert?

Hallo

Ich hab mich da ein wenig hinein gelesen und dann selbst ein Programm 
geschrieben, dass den COM Port abfragt und grafisch auf dem Bildschirm 
darstellt, allerdings in C. Das funktioniert auch noch mit 115200 Baud!

Für den gesamten Code bitte nachfragen.

Im Prinzip geht das so:

erst ein:

RS232=CreateFile(PORT,GENERIC_READ | 
GENERIC_WRITE,0,NULL,OPEN_EXISTING,NULL,NULL);

PORT ist hier zb. "COM1" (mit "")
RS232 ist der Handle, den dir Windows zurückliefert

Dann die Einstellungen abfragen:
GetCommState(RS232,&settings);

Dann die Einstellungen bearbeiten:

settings.BaudRate=BAUDRATE;
settings.ByteSize=8;
settings.Parity=NOPARITY;
settings.StopBits=ONESTOPBIT;´

Dann die geänderten Einstellungen setzten:

SetCommState(RS232,&settings);

Tja und dann kannst du theoretisch die Schnittstelle mit:

ReadFile(RS232,&data,1,&received_bytes,NULL);

auslesen.

Was die Befehle jetzt im Detail zu bedienen sind, und was es sonst noch 
gibt, siehe hier:

http://msdn2.microsoft.com/en-us/library/aa363196.aspx
OP #537034
Lesenswert?

So, hier ist fast alles was das Herz begehrt.

COM-Port mit VBA 6.0 bedienen.
Suchbefriffe: Visual Basic COM SERIELL
1
Option Explicit
2

3
Public Const COM_PORT_MAX = 9
4
Public Const GENERIC_READ = &H80000000
5
Public Const GENERIC_WRITE = &H40000000
6
Public Const OPEN_EXISTING = 3
7
Public Const FILE_ATTRIBUTE_NORMAL = &H80
8
Public Const INVALID_HANDLE_VALUE = -1
9

10

11
Type dcb 'Com-Port Settings
12
        DCBlength As Long
13
        BaudRate As Long
14
        fBitFields As Long
15
        wReserved As Integer
16
        XonLim As Integer
17
        XoffLim As Integer
18
        ByteSize As Byte
19
        Parity As Byte
20
        StopBits As Byte
21
        XonChar As Byte
22
        XoffChar As Byte
23
        ErrorChar As Byte
24
        EofChar As Byte
25
        EvtChar As Byte
26
        wReserved1 As Integer
27
End Type
28

29
'Handle erstellen
30
Public Declare Function CreateFile _
31
    Lib "kernel32" _
32
    Alias "CreateFileA" _
33
    (ByVal lpFileName As String, _
34
    ByVal dwDesiredAccess As Long, _
35
    ByVal dwShareMode As Long, _
36
    ByRef lpSecurityAttributes As Long, _
37
    ByVal dwCreationDisposition As Long, _
38
    ByVal dwFlagsAndAttributes As Long, _
39
    ByVal hTemplateFile As Long) _
40
As Long
41

42
'Handle löschen
43
Public Declare Function CloseHandle _
44
    Lib "kernel32" _
45
    (ByVal hObject As Long) _
46
As Long
47

48
'Von Handle empfangen
49
Public Declare Function ReadFile _
50
    Lib "kernel32" _
51
    (ByVal hFile As Long, _
52
    ByVal lpBuffer As Any, _
53
    ByVal nNumberOfBytesToRead As Long, _
54
    ByRef lpNumberOfBytesRead As Long, _
55
    ByVal lpOverlapped As Any) _
56
As Long
57

58
'An Handle senden
59
Public Declare Function WriteFile _
60
    Lib "kernel32" _
61
    (ByVal hFile As Long, _
62
    ByVal lpBuffer As Any, _
63
    ByVal nNumberOfBytesToWrite As Long, _
64
    ByRef lpNumberOfBytesWritten As Long, _
65
    ByVal lpOverlapped As Any) _
66
As Long
67

68
'Com Port Eigenschaften Setzen
69
Public Declare Function SetCommState _
70
    Lib "kernel32" _
71
    (ByVal hCommDev As Long, _
72
    lpDCB As dcb) _
73
As Long
74

75
'Com Port Eigenschaften Holen
76
Public Declare Function GetCommState _
77
    Lib "kernel32" _
78
    (ByVal nCid As Long, _
79
    lpDCB As dcb) _
80
As Long
81

82
'Kommunikationsweg freiblasen
83
Declare Function FlushFileBuffers _
84
    Lib "kernel32" _
85
    (ByVal hFile As Long) _
86
As Long
87

88
'Com setting setzen
89
Public Sub SetCOM(ByVal handle As Long, ByVal BaudRate, ByteSize, Parity, StopBits As Integer)
90
    Dim settings As dcb
91
    settings.DCBlength = LenB(settings)
92
    Call GetCommState(handle, settings)
93
    settings.BaudRate = BaudRate
94
    settings.ByteSize = ByteSize
95
    settings.Parity = Parity
96
    settings.StopBits = StopBits
97
    Call SetCommState(handle, settings)
98
    'Nach mir die Sintflut, die alten settings gehen verloren
99
End Sub
100

101
Public Function DetectWaage() As Long
102
    Dim CurrentHandle As Long
103
    Dim CurrentMember As Integer
104
    
105
    For CurrentMember = 1 To COM_PORT_MAX
106
        CurrentHandle = CreateFile("COM" + Right(Str(CurrentMember), Len(Str(CurrentMember)) - 1) + Chr(0), _
107
        GENERIC_READ Or GENERIC_WRITE, ByVal 0, ByVal 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0)
108
        
109
        'TODO Gerät erkennen
110
        '************
111
        If Not CurrentHandle = INVALID_HANDLE_VALUE Then
112
            Exit For
113
        End If
114
        '*************
115
    Next CurrentMember
116
    
117
    DetectWaage = CurrentHandle
118
End Function
119

120
Public Sub send(ByVal handle As Long, ByVal message As String)
121
    Dim nirvana_long As Long
122
    Dim nirvana_string As String * 1024
123
    Call WriteFile(handle, message, Len(message), nirvana_long, vbNullString)
124
    Call ReadFile(handle, nirvana_string, Len(message), nirvana_long, vbNullString)
125
End Sub
126

127
Public Function read(ByVal handle As Long) As String
128
    Dim nirvana_long As Long
129
    Dim counter As Long
130
    Dim buffer As String
131
    Dim readonce As String * 1
132
    readonce = ""
133
    buffer = ""
134
    counter = 0
135
    Do Until (Left$(readonce, 1) = vbCr)
136
        Call ReadFile(handle, readonce, 1, nirvana_long, vbNullString)
137
        counter = counter + 1
138
        buffer = buffer + Left$(readonce, 1)
139
    Loop
140
    readx = Left$(buffer, counter)
141
End Function
Gast #537169
Lesenswert?

Hallo, ein kleines Beispiel für VB2005 und der SystemIO (Framework 2.0). 
Ein Teil des Codes hab ich im Internet gefunden. Das Programm 
funktioniert (getestet hab ich die Empfangs- und Senderoutine mittels 
Virtual Serial Port).

Die Buffergroesse laesst sich variable einstellen, aber mich wuerde 
interessieren ob man trotzdem noch einen Ringbuffer implementiert oder 
nicht.
1
Imports System.IO.Ports
2

3

4
Public Delegate Sub rxDataDelegate()
5

6
Public Class Form1
7
    Dim WithEvents SerialPort As New SerialPort
8
    Dim rev(80) As Byte
9
    Dim cnt_index As Byte
10

11
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
12

13
        If SerialPort.IsOpen Then
14
            SerialPort.Close()
15
        End If
16

17
        Try
18
            With SerialPort
19
                .PortName = "Com4"
20
                .BaudRate = 9600
21
                .Parity = Parity.None
22
                .DataBits = 8
23
                .StopBits = StopBits.One
24
            End With
25
            SerialPort.Open()
26
        Catch ex As Exception
27
            MsgBox(ex.ToString)
28
        End Try
29

30

31
    End Sub
32

33

34
    REM Private Sub com1_DataReceived(ByVal sender As Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles com1.DataReceived
35
    REM Dim returnStr As String
36
    REM returnStr = com1.ReadLine
37
    REM ReceiveSerialData(returnStr)
38
    REM End Sub
39

40

41

42
    Sub SendSerialData(ByVal data As String)
43
        ' Send strings to a serial port.
44
        SerialPort.WriteLine(data)
45
    End Sub
46

47

48
    Private Sub ReceiveSerialData()
49
        'TextBox1.AppendText(SerialPort.ReadLine)
50
        rev(cnt_index) = SerialPort.ReadByte
51
        ListBox1.Items.Add(rev(cnt_index))
52
        ListBox1.Items.Add(cnt_index)
53
        cnt_index = cnt_index + 1
54
    End Sub
55

56

57
    Private Sub serialport_DataReceived(ByVal sender As Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles SerialPort.DataReceived, SerialPort1.DataReceived
58
        TextBox1.Invoke(New rxDataDelegate(AddressOf ReceiveSerialData), New Object() {})
59
    End Sub
60

61

62
    Private Sub Button1_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
63
        'SendSerialData("TestString")
64
        SendSerialData("hhhh")
65
    End Sub
66

67
   
68
    Private Sub GetSerialPortNames()
69
        ' Show all available COM ports.
70
        For Each sp As String In My.Computer.Ports.SerialPortNames
71
            ListBox1.Items.Add(sp)
72
        Next
73
    End Sub
74

75

76
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
77
        GetSerialPortNames()
78
    End Sub
79

80

81
    Private Sub SetuToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SetuToolStripMenuItem.Click
82
        GetSerialPortNames()
83
    End Sub
84
End Class

Antwort schreiben

Bitte melde dich an, um einen Beitrag zu schreiben.

oder

Mit Google-Account einloggen

Die Registrierung ist kostenlos und dauert nur eine Minute.

Jetzt registrieren