Const INC_MS_CTS_ON       = $10
Const INC_MS_DSR_ON       = $20
Const INC_MS_RING_ON      = $40
Const INC_MS_RLSD_ON      = $80
 
Const INC_SETXOFF         = 1
Const INC_SETXON          = 2
Const INC_SETRTS          = 3
Const INC_CLRRTS          = 4
Const INC_SETDTR          = 5
Const INC_CLRDTR          = 6
Const INC_RESETDEV        = 7
Const INC_SETBREAK        = 8
Const INC_CLRBREAK        = 9

Const INC_GENERIC_READ    = $80000000
Const INC_GENERIC_WRITE   = $40000000
Const INC_OPEN_EXISTING   = 3

; Grundfunktionen

Function INC_OpenCom%(lpDef$)
	nCid = api_CreateFile(Left(lpDef$, 4), INC_GENERIC_READ Or INC_GENERIC_WRITE, 0, 0, INC_OPEN_EXISTING, 0, 0)
	If nCid > 0 Then OPENCOM = nCid Else OPENCOM = 0
	Return OPENCOM
End Function

Function INC_CloseCom(nCid)
	api_CloseHandle(nCid)
End Function

; Ausgangsfunktionen

Function INC_DTR(nCid,Status)
	If Status = 1 Then
		api_EscapeCommFunction nCid, INC_SETDTR
	Else
		api_EscapeCommFunction nCid, INC_CLRDTR
	EndIf
End Function

Function INC_RTS(nCid,Status)
	If Status = 1 Then
		api_EscapeCommFunction nCid, INC_SETRTS
	Else
		api_EscapeCommFunction nCid, INC_CLRRTS
	EndIf
End Function

Function INC_TXD(nCid,Status)
	If Status = 1 Then
		api_EscapeCommFunction(nCid, INC_SETBREAK)
	Else
		api_EscapeCommFunction nCid, INC_CLRBREAK
	EndIf
End Function

.lib "kernel32.dll"    ;<-- Jetzt hab ichs

api_CreateFile%(FileName$, DesiredAccess%, ShareMode%, pSecurrityAttribute%, CreationDistribution%, FlagsAndAttributes%, TemplateFile%) : "CreateFileA"
api_CloseHandle% (hObject%) : "CloseHandle"
api_EscapeCommFunction% (nCid%, nFunc%) : "EscapeCommFunction"

' Die VB-Libs
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal NOlpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function EscapeCommFunction Lib "kernel32" (ByVal nCid As Long, ByVal nFunc As Long) As Long
Declare Function GetCommModemStatus Lib "kernel32" (ByVal hFile As Long, lpModemStat As Long) As Long

Dim nCid As Long


'///////////////////////////////////////////////////
'///Diese Funktionen waren kein Problem/////////////
'///////////////////////////////////////////////////
Function OPENCOM(ByVal lpDef As String) As Integer
  nCid = CreateFile(Left(lpDef, 4), INC_GENERIC_READ Or INC_GENERIC_WRITE, 0, 0, INC_OPEN_EXISTING, 0, 0)
  If nCid > 0 Then OPENCOM = nCid Else OPENCOM = 0
End Function
Sub CLOSECOM()
   x = CloseHandle(nCid)
End Sub

Sub DTR(Status As Integer)
  If Status = 1 Then EscapeCommFunction nCid, INC_SETDTR Else: EscapeCommFunction nCid, INC_CLRDTR
End Sub
Sub RTS(Status As Integer)
  If Status = 1 Then EscapeCommFunction nCid, INC_SETRTS Else: EscapeCommFunction nCid, INC_CLRRTS
End Sub
Sub TXD(Status As Integer)
  If Status = 1 Then EscapeCommFunction nCid, INC_SETBREAK Else: EscapeCommFunction nCid, INC_CLRBREAK
End Sub


'///////////////////////////////////////////////////
'///Hier beginnen die Eingangsfunktionen////////////
'///////////////////////////////////////////////////
Function CTS() As Integer
  Dim mask As Long
  GetCommModemStatus nCid, mask
  If (mask And INC_MS_CTS_ON) = INC_MS_CTS_ON Then CTS = 1 Else CTS = 0
End Function
Function DSR() As Integer
  Dim mask As Long
  GetCommModemStatus nCid, mask
  If (mask And INC_MS_DSR_ON) = INC_MS_DSR_ON Then DSR = 1 Else DSR = 0
End Function
Function RI() As Integer
  Dim mask As Long
  GetCommModemStatus nCid, mask
  If (mask And INC_MS_RING_ON) = INC_MS_RING_ON Then RI = 1 Else RI = 0
End Function
Function DCD() As Integer
  Dim mask As Long
  GetCommModemStatus nCid, mask
  If (mask And INC_MS_RLSD_ON) = INC_MS_RLSD_ON Then DCD = 1 Else DCD = 0
End Function
Function Inputs() As Integer
  Dim mask As Long
  GetCommModemStatus nCid, mask
  Inputs = (Int(mask / 16)) And 15
End Function