Attribute VB_Name = "Modul1"
Declare Sub pmbsSend Lib "pmbslib2.dll" (ByVal port As Integer, ByVal text$)
Declare Sub pmbsQuit Lib "pmbslib2.dll" (ByVal port As Integer)
Declare Sub pmbsRead Lib "pmbslib2.dll" (ByVal port As Integer, ByVal vorgabe$, ByVal zeichen As Integer, ByVal puffer$)
Declare Sub pmbsBRead Lib "pmbslib2.dll" (ByVal port As Integer, ByVal vorgabe$, ByVal zeichen As Integer, ByVal puffer$)
Declare Sub pmbsMemory Lib "pmbslib2.dll" (ByVal zahl As String)
Declare Sub pmbsGetPort Lib "pmbslib2.dll" (ByVal zahl As Integer, ByVal text$)
Declare Sub pmbsCursor Lib "pmbslib2.dll" (ByVal zahl As Integer, ByVal text$, ByVal text2$)
Declare Sub pmbsGetUser Lib "pmbslib2.dll" (ByVal zahl As Integer, ByVal text$)
Declare Sub pmbsGetDir Lib "pmbslib2.dll" (ByVal zahl As Integer, ByVal text$)
Declare Sub pmbsGetNetDir Lib "pmbslib2.dll" (ByVal zahl As Integer, ByVal text$)
Declare Sub pmbsGetUserDos Lib "pmbslib2.dll" (ByVal zahl As Integer, ByVal text$)
Declare Sub pmbsGetBox Lib "pmbslib2.dll" (ByVal zahl As Integer, ByVal text$)
Declare Sub pmbsCheckCarrier Lib "pmbslib2.dll" (ByVal zahl As Integer, ByVal text$)
Declare Sub pmbsGetChar Lib "pmbslib2.dll" (ByVal zahl As Integer, ByVal text$)
Declare Sub pmbsSendFile Lib "pmbslib2.dll" (ByVal zahl As Integer, ByVal text$, ByVal text2$)
Declare Sub pmbsReceiveFile Lib "pmbslib2.dll" (ByVal zahl As Integer, ByVal text$)
Public port As Integer
Public esc$
Public cs$
Public r$
Public memory As Long
Public Sub main()
Dim a$
Dim i As Integer
Dim user$

esc$ = Chr$(27) + "[": r$ = Chr$(13) + Chr$(10): cs$ = esc$ + "H" + esc$ + "2J"
port = Val(Command$)    ' Von welchem Port werde ich aufgerufen?
memory = pMemory

user$ = String(20, 0)   'Username bekommen, so kann man auch GetNetDir, GetDir,GetUserDOs ansprechen
pmbsGetUser port, user$
user$ = removenull(user$)

pSend cs$ + "Willkommen zur °V1VisualBasic°V7 Demonstration"
pSend r$ + "Ihr Username ist °H5" + user$ + "°H0"

If pCheckCarrier <> 0 Then
    pSend (r$ + "Carrier ist da")
End If

pSend r$ + r$ + "Testeingabe: "
a$ = pRead("vorgabe", 20, True)
pSend r$ + "Eingabe:" + a$ + r$

a$ = pcursor("^1^JN|JN|Beispielauswahl <J)a> <N)ein>")
pSend r$ + "Rueckgabe: " + a$

pSend (r$ + r$ + "°H4Portuebersicht" + Space(40) + "°H0")
For i = 0 To 5
    a$ = String(100, 0)
    pmbsGetPort i, a$
    pSend r$ + "Port " + Str$(i) + ": " + removenull(a$)
Next i
pquit
End Sub

Public Sub pSend(text$)
pmbsSend port, text$
End Sub

Public Sub pquit()
pmbsQuit port
End Sub

Public Function pMemory()
Dim a As String
Dim l As Long
a = String(4, 0)
pmbsMemory a
pMemory = getzahl(a)
End Function

Public Function pRead(ByVal vorgabe$, ByVal zeichen As Integer, ByVal blue As Boolean)
Dim a$
a$ = String(zeichen, 0)
If blue = False Then
pmbsRead port, vorgabe$, zeichen, a$
Else
pmbsBRead port, vorgabe$, zeichen, a$
End If
pRead = removenull(a$)
End Function

Public Function getzahl(ByVal a As String)
Dim l As Long
l = Asc(Mid(a, 4, 1)) * &H1000000 + Asc(Mid(a, 3, 1)) * &H10000 + Asc(Mid(a, 2, 1)) * &H100 + Asc(Mid(a, 1, 1))
getzahl = l
End Function

Public Function removenull(ByVal a As String)
Dim i As Integer
Dim b As String
For i = Len(a) To 1 Step -1
    If Asc(Mid(a, i, 1)) <> 0 Then
        Exit For
    End If
Next i
removenull = Left(a, i)
End Function

Public Function pcursor(ByVal tx$)
Dim a$
a$ = String(4, 0)
pmbsCursor port, tx$, a$
pcursor = Chr$(getzahl(a$))
End Function

Public Function pCheckCarrier()
Dim a$
a$ = String(4, 0)
pmbsCheckCarrier port, a$
pCheckCarrier = getzahl(a$)
End Function

Public Function pSendfile(ByVal filename$)
Dim a$
a$ = String(4, 0)
pmbsSendFile port, filename$, a$
pSendfile = getzahl(a$) ' Rückgabe ob erfolgreich
End Function

Public Function pReceiveFile()
Dim a$
a$ = String(4, 0)
pmbsReceiveFile port, a$
pReceiveFile = getzahl(a$)
End Function