Option Explicit
 
Public Const COM_PORT_MAX = 9
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const OPEN_EXISTING = 3
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const INVALID_HANDLE_VALUE = -1
 
 
Type dcb 'Com-Port Settings
        DCBlength As Long
        BaudRate As Long
        fBitFields As Long
        wReserved As Integer
        XonLim As Integer
        XoffLim As Integer
        ByteSize As Byte
        Parity As Byte
        StopBits As Byte
        XonChar As Byte
        XoffChar As Byte
        ErrorChar As Byte
        EofChar As Byte
        EvtChar As Byte
        wReserved1 As Integer
End Type
 
'Handle erstellen
Public Declare Function CreateFile _
    Lib "kernel32" _
    Alias "CreateFileA" _
    (ByVal lpFileName As String, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, _
    ByRef lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) _
As Long
 
'Handle löschen
Public Declare Function CloseHandle _
    Lib "kernel32" _
    (ByVal hObject As Long) _
As Long
 
'Von Handle empfangen
Public Declare Function ReadFile _
    Lib "kernel32" _
    (ByVal hFile As Long, _
    ByVal lpBuffer As Any, _
    ByVal nNumberOfBytesToRead As Long, _
    ByRef lpNumberOfBytesRead As Long, _
    ByVal lpOverlapped As Any) _
As Long
 
'An Handle senden
Public Declare Function WriteFile _
    Lib "kernel32" _
    (ByVal hFile As Long, _
    ByVal lpBuffer As Any, _
    ByVal nNumberOfBytesToWrite As Long, _
    ByRef lpNumberOfBytesWritten As Long, _
    ByVal lpOverlapped As Any) _
As Long
 
'Com Port Eigenschaften Setzen
Public Declare Function SetCommState _
    Lib "kernel32" _
    (ByVal hCommDev As Long, _
    lpDCB As dcb) _
As Long
 
'Com Port Eigenschaften Holen
Public Declare Function GetCommState _
    Lib "kernel32" _
    (ByVal nCid As Long, _
    lpDCB As dcb) _
As Long
 
'Kommunikationsweg freiblasen
Declare Function FlushFileBuffers _
    Lib "kernel32" _
    (ByVal hFile As Long) _
As Long
 
'Com setting setzen
Public Sub SetCOM(ByVal handle As Long, ByVal BaudRate, ByteSize, Parity, _
  StopBits As Integer)
    Dim settings As dcb
    settings.DCBlength = LenB(settings)
    Call GetCommState(handle, settings)
    settings.BaudRate = BaudRate
    settings.ByteSize = ByteSize
    settings.Parity = Parity
    settings.StopBits = StopBits
    Call SetCommState(handle, settings)
    'Nach mir die Sintflut, die alten settings gehen verloren
End Sub
 
Public Function DetectWaage() As Long
    Dim CurrentHandle As Long
    Dim CurrentMember As Integer
 
    For CurrentMember = 1 To COM_PORT_MAX
        CurrentHandle = CreateFile("COM" + Right(Str(CurrentMember), Len(Str( _
          CurrentMember)) - 1) + Chr(0), _
        GENERIC_READ Or GENERIC_WRITE, ByVal 0, ByVal 0, OPEN_EXISTING, _
        FILE_ATTRIBUTE_NORMAL, ByVal 0)
 
        'TODO Gerät erkennen
        '************
        If Not CurrentHandle = INVALID_HANDLE_VALUE Then
            Exit For
        End If
        '*************
    Next CurrentMember
 
    DetectWaage = CurrentHandle
End Function
 
Public Sub send(ByVal handle As Long, ByVal message As String)
    Dim nirvana_long As Long
    Dim nirvana_string As String * 1024
    Call WriteFile(handle, message, Len(message), nirvana_long, vbNullString)
    Call ReadFile(handle, nirvana_string, Len(message), nirvana_long, _
      vbNullString)
End Sub
 
Public Function read(ByVal handle As Long) As String
    Dim nirvana_long As Long
    Dim counter As Long
    Dim buffer As String
    Dim readonce As String * 1
    readonce = ""
    buffer = ""
    counter = 0
    Do Until (Left$(readonce, 1) = vbCr)
        Call ReadFile(handle, readonce, 1, nirvana_long, vbNullString)
        counter = counter + 1
        buffer = buffer + Left$(readonce, 1)
    Loop
    readx = Left$(buffer, counter)
End Function

With MSComm1
  .CommPort = 10
  .Settings = "9600,N,8,1"
  .PortOpen = True
End With

SetCOM 11, 9600, N, 8, 1
send 11, "Befehl"