Skip to content
Sign upLog in
← Back to Community

What is False?

Profile icon
Dart20

'*************************************************************************
' CHAT.BAS = Kleines Chatprogramm fuer eine Verbindung mit Nullmodemkabel
' ========
' Dieses Chatprogramm habe ich in ein paar Stunden schnell
' zusammengezimmert, ist also noch ausbaufähig. Wenn ihr wollt, könnte
' ich noch etwas aehnliches fuers Netzwerk machen, allerdings mit
' Datenaustausch über eine Datei, da TCP/IP unter QB nur mit speziellen
' Treibern funktioniert und das dann für die meisten uninteressant ist.
'
' Gruesse aus Suedtirol
' [email protected]
'
' (c) Karl Pircher ("[email protected]"; karl.pirchergmx.net ) 15.5.2003 ]
'
'
***********************************************************************
DECLARE FUNCTION Recieve$ (kanal%)
DECLARE FUNCTION Send% (Rec AS STRING, kanal%)
DECLARE FUNCTION OpenCom% (Comport%, kanal%)
DECLARE SUB PrintStatus (Comport%, PortOpen%, RStatus AS ANY)
DECLARE SUB PrintSend (Rec AS STRING, char AS STRING, Rect AS ANY)
DECLARE SUB PrintRecieve (char AS STRING, Rect AS ANY)
DECLARE SUB Form (left%, Top%, HSend%, HRecieve%, HStatus%)
'
'------------------------------------------------Deklarationen
TYPE Rect
x1 AS INTEGER
y1 AS INTEGER
x2 AS INTEGER
y2 AS INTEGER
END TYPE
'
'------------------------------------------------Fehlerbehandlung
ON ERROR GOTO ErrorHandler
'
'------------------------------------------------Dimensionierungen
DEFINT A-Z ' Default alle Variablen als Integer definieren
DIM InRec AS STRING ' Einlesestring Tastatur
DIM InChar AS STRING ' Letzte Zeichen von Tastatur
DIM tmp AS STRING ' tempor„re Variable
DIM RSend AS Rect ' Koordinaten Empfangsfenster
DIM RRecieve AS Rect ' Koordinaten SendeFenster
DIM RStatus AS Rect ' Koordinaten Statusfenster
DIM SHARED fehler ' letzter aufgetretener Fehler
'
'------------------------------------------------Zuweisungen
Comport = 1 ' Nummer der Com
Top = 1 ' Oberer Rand
left = 5 ' linker Rand
HSend = 9 ' Anzahl Zeilen Sendefenster
HRecieve = 9 ' Anzahl Zeilen Empfangsfenster
HStatus = 1 ' Anzahl Zeilen Statusfenster
RSend.x1 = left + 2
RSend.x2 = 80 - (left + 1) * 2 - 1
RSend.y1 = Top + HRecieve + 3
RSend.y2 = HSend - 1
RRecieve.x1 = left + 2
RRecieve.x2 = 80 - (left + 1) * 2 - 1
RRecieve.y1 = Top + 2
RRecieve.y2 = HRecieve - 1
RStatus.x1 = left + 2
RStatus.x2 = 80 - (left + 1) * 2 - 1
RStatus.y1 = Top + HSend + HRecieve + 4
RStatus.y2 = HRecieve - 1
'
'------------------------------------------------Bildschirm
CLS
Form left, Top, HSend, HRecieve, HStatus ' Anzeige Bildschirmmaske
PrintSend "", "", RSend ' Kursor positionieren
'
'------------------------------------------------Port ”ffnen
kanal = FREEFILE
PortOpen = OpenCom(Comport, kanal)
PrintStatus Comport, PortOpen, RStatus
PrintSend "", "", RSend ' Kursor positionieren
'
'------------------------------------------------Main
DO
'
'------------------------------------------------Eingabe
InChar = INKEY$
'
IF LEN(InChar) = 2 THEN ' Funktionstasten
SELECT CASE InChar
CASE CHR$(0) + CHR$(59) ' F1
Comport = 1 ' Com1 festlegen
PortOpen = OpenCom(Comport, kanal) ' Com1 ”ffen
PrintStatus Comport, PortOpen, RStatus ' Status aktualisieren
PrintSend "", "", RSend ' Kursor positionieren
CASE CHR$(0) + CHR$(60) ' F2
Comport = 2 ' Com2 festlegen
PortOpen = OpenCom(Comport, kanal) ' Com2 ”ffnen
PrintStatus Comport, PortOpen, RStatus' Status aktualisieren
PrintSend "", "", RSend ' Kursor positionieren
END SELECT
'
ELSE ' Andere Tasten
IF InChar <> "" THEN
SELECT CASE InChar
CASE CHR$(8) ' Backspace
IF LEN(InRec) > 0 THEN
PrintSend InRec, InChar, RSend ' Zeichen l”schen
ELSE
BEEP
END IF
CASE CHR$(13) ' Enter
s = Send(InRec, kanal) ' Zeile senden
InRec = "" ' Eingabe l”schen
PrintSend InRec, InChar, RSend ' Neue Zeile
CASE CHR$(27) ' Esc
EXIT DO
CASE ELSE
InRec = InRec + InChar ' Eingabe aktualisieren
PrintSend InRec, InChar, RSend ' und anzeigen
END SELECT
END IF
END IF
'
'------------------------------------------------Einlesen
IF PortOpen = -1 THEN ' Wenn Port ge”ffnet
tmp = Recieve(kanal) ' Daten von Com holen
IF tmp <> "" THEN ' Wenn Daten eingetroffen
PrintRecieve tmp, RRecieve ' dann anzeigen
PrintSend "", "", RSend ' Kursor wieder ins Sendfendter
END IF
END IF

LOOP

CLOSE kanal ' Kanal schliessen
SYSTEM ' und beednen
'
'------------------------------------------------Fehlerbehandlung
ErrorHandler:
fehler = ERR
RESUME NEXT

'
SUB Form (left, Top, HSend, HRecieve, HStatus)
'-----------------------------------------------
' SUB Form - Anzeige Bildschirmmaske
' =========
' Parameter:
' Left = Linker Rand in Spalten
' Top = Rand oben in Zeilen
' HSend = Hoehe Fenster Senden in Zeilen
' HRecieve = Hoehe Fenster Empfangen in Zeilen
' HStatus = H”he fenster Status in Zeilen
'-----------------------------------------------
FOR i = 0 TO Top - 1
PRINT
NEXT
'
PRINT SPACE$(left);
PRINT CHR$(218); ' Ú
PRINT STRING$(78 - 2 * left, 196); ' Ä
PRINT CHR$(191) ' ¿
FOR i = 1 TO HRecieve
PRINT SPACE$(left);
PRINT CHR$(179); ' ³
PRINT SPACE$(78 - 2 * left);
PRINT CHR$(179) ' ³
NEXT
PRINT SPACE$(left);
PRINT CHR$(195); ' Ã
PRINT STRING$(78 - 2 * left, 196); ' Ä
PRINT CHR$(180) ' ´
FOR i = 1 TO HSend
PRINT SPACE$(left);
PRINT CHR$(179); ' ³
PRINT SPACE$(78 - 2 * left);
PRINT CHR$(179) ' ³
NEXT
'
PRINT SPACE$(left);
PRINT CHR$(195); ' Ã
PRINT STRING$(78 - 2 * left, 196); ' Ä
PRINT CHR$(180) ' ´
FOR i = 1 TO HStatus
PRINT SPACE$(left);
PRINT CHR$(179); ' ³
PRINT SPACE$(78 - 2 * left);
PRINT CHR$(179) ' ³
NEXT
'
PRINT SPACE$(left);
PRINT CHR$(192); ' À
PRINT STRING$(78 - 2 * left, 196); ' Ä
PRINT CHR$(217); ' Ù
'
END SUB

'
FUNCTION OpenCom (Comport, kanal)
'---------------------------------------------
' FUNCTION OpenCom - Com Port oeffnen
' ================
'---------------------------------------------
fehler = 0
'
CLOSE #kanal
OPEN "com" + LTRIM$(STR$(Comport)) + ": 9600,n,8,1,cs0,ds0,cd0" FOR RANDOM AS #kanal
'
IF fehler = 0 THEN
OpenCom = -1
ELSE
OpenCom = 0
END IF
'
END FUNCTION

'
SUB PrintRecieve (printstring AS STRING, Rect AS Rect)
'--------------------------------------------------------
' SUB PrintRecieve - Anzeige e.Strings im Empfangsfenster
' ================
'--------------------------------------------------------
'
STATIC XPos
STATIC YPos
DIM char AS STRING
'
LOCATE Rect.y1 + YPos, Rect.x1 + XPos, 0
'
FOR k = 1 TO LEN(printstring)
char = MID$(printstring, k, 1)
SELECT CASE char
CASE CHR$(13)
IF YPos < Rect.y2 THEN
YPos = YPos + 1
ELSE
VIEW PRINT Rect.y1 TO Rect.y1 + Rect.y2
FOR i = 1 TO Rect.y2
PRINT
NEXT
PRINT
PRINT SPACE$(Rect.x1 - 2);
PRINT CHR$(179);
PRINT SPACE$(Rect.x2 + 1);
PRINT CHR$(179);
VIEW PRINT
END IF
XPos = 0
LOCATE Rect.y1 + YPos, Rect.x1 + XPos
CASE ELSE
PRINT char;
IF XPos < Rect.x2 THEN
XPos = XPos + 1
ELSEIF XPos = Rect.x2 THEN
IF YPos < Rect.y2 THEN
YPos = YPos + 1
ELSE
VIEW PRINT Rect.y1 TO Rect.y1 + Rect.y2
FOR i = 1 TO Rect.y2
PRINT
NEXT
PRINT
PRINT SPACE$(Rect.x1 - 2);
PRINT CHR$(179);
PRINT SPACE$(Rect.x2 + 1);
PRINT CHR$(179);
VIEW PRINT
END IF
XPos = 0
END IF
END SELECT
NEXT
'
END SUB

'
SUB PrintSend (Rec AS STRING, char AS STRING, Rect AS Rect)
'--------------------------------------------------------
' SUB PrintSend - Anzeige eines Zeichens im Sendfenster
' =============
'--------------------------------------------------------
'
STATIC XPos
STATIC YPos
'
LOCATE Rect.y1 + YPos, Rect.x1 + XPos, 1
IF char <> "" THEN
SELECT CASE char
CASE CHR$(13)
IF YPos < Rect.y2 THEN
YPos = YPos + 1
ELSE
VIEW PRINT Rect.y1 TO Rect.y1 + Rect.y2
FOR i = 1 TO Rect.y2
PRINT
NEXT
PRINT
PRINT SPACE$(Rect.x1 - 2);
PRINT CHR$(179);
PRINT SPACE$(Rect.x2 + 1);
PRINT CHR$(179);
VIEW PRINT
END IF
XPos = 0
LOCATE Rect.y1 + YPos, Rect.x1 + XPos
CASE CHR$(8)
IF XPos > 0 THEN
XPos = XPos - 1
LOCATE Rect.y1 + YPos, Rect.x1 + XPos
PRINT " ";
LOCATE Rect.y1 + YPos, Rect.x1 + XPos
Rec = LEFT$(Rec, LEN(Rec) - 1)
ELSE
BEEP
END IF
CASE ELSE
PRINT char;
IF XPos < Rect.x2 THEN
XPos = XPos + 1
ELSEIF XPos = Rect.x2 THEN
IF YPos < Rect.y2 THEN
YPos = YPos + 1
ELSE
VIEW PRINT Rect.y1 TO Rect.y1 + Rect.y2
FOR i = 1 TO Rect.y2
PRINT
NEXT
PRINT
PRINT SPACE$(Rect.x1 - 2);
PRINT CHR$(179);
PRINT SPACE$(Rect.x2 + 1);
PRINT CHR$(179);
VIEW PRINT
END IF
XPos = 0
LOCATE Rect.y1 + YPos, Rect.x1 + XPos, 1
END IF
END SELECT
END IF
'
END SUB

'
SUB PrintStatus (Comport, PortOpen, RStatus AS Rect)
'---------------------------------------------------------
' SUB PrintStatus - Anzeige Status
' ===============
'---------------------------------------------------------
'
DIM Status AS STRING
'
LOCATE RStatus.y1, RStatus.x1
Status = "F1 = Com1: F2 = Com2: ESC = Ende "
IF PortOpen = -1 THEN
Status = Status + "Parameter: Com" + LTRIM$(STR$(Comport)) + ": 9600,n,8,1 "
ELSE
Status = Status + "Fehler beim ™ffnen der Com" + LTRIM$(STR$(Comport)) + ":"
END IF
Status = LEFT$(Status + SPACE$(80), RStatus.x2 + 1)
PRINT Status
'
END SUB

'
FUNCTION Recieve$ (kanal)
'---------------------------------------------
' FUNCTION Recieve$ - Zeichen empfangen
' =================
'---------------------------------------------
'
IF NOT EOF(kanal) THEN
Recieve$ = INPUT$(LOC(kanal), kanal)
END IF
'
END FUNCTION

'
FUNCTION Send (Rec AS STRING, kanal)
'-----------------------------------------------
' FUNCTION Send - Senden der eingegeben Daten.
' =============
'-----------------------------------------------
'
PRINT #kanal, Rec
'
END FUNCTION

Voters
Profile icon
alhmhShmhmbWhaq
Profile icon
Dart20
Comments
hotnewtop
Profile icon
mwilki7

I don't understand the context of the question.
Do you have a repl for the code?

Profile icon
Dart20

@mwilki7
no sorry it is the code