Hab´s doch via RS232 hingekriegt durch Ersatz der PB-SerialFnc´s durch API...
(Umbau auf Drucker-Port wahr mir dann doch zu aufwändig).
Sind zwar -wie gefordert- nur 2 Schalt-Kanäle implementiert, Weitere brauch´ ich nicht.
Grundsätzlich kann der Port mit PB geöffnet werden, lediglich für´s ändern der Signale
Für alle Sucher wg. RS232 schalten hier noch der vollständige Source:
Code: Alles auswählen
#Prg_Name = "COM_outCtrl"
#Prg_Vers = "13505c" ;<-- set by PB_VersUpd Vers 11415a
#PB_Vers = "4.20"
; Mit diesem Prg können an einem RS232-Port (=COMx) zwei Schalt-Zustände gesteuert werden.
; An den Anschlüßen DTR (Pin 4) und RTS (Pin 7) können 2 LED´s bzw. Transistoren zur Relais=
; ansteuerung angeschloßen werden (Kathode jeweils an Pin 5, beim Relais die Freilauf-Diode
; nicht vergessen !!!).
; Der RS232-Port kann mit diesem Prg. eingestellt werden (Port-Nr {COMx}, BaudRate, Parity....ect)
; und die beiden Anschlüße können manuell ein- und ausgeschaltet werden...
#BufferIn = 1024
#BufferOut = 1024
EnableExplicit
Global RS232_Hdl ;Handle des RS232-Port´s (0=no Port open)
Global PortGad ;die #Gadget-Nr´s der Setup-Gadgets
Global BaudGad
Global ParityGad
Global WordGad
Global StopGad
Global HandGad
Global Dim GadNr(3);#GadgetNr´s der Signal-Cechkboxen
Global Dim Signal$(3)
Signal$(1) = "DTR"
Signal$(2) = "RTS"
;XIncludeFile "C:\AlsterSoft\PureBasic\PB4.20\Module\Registry.PBI"
;========== Begin Modul "RS232_Liste.PBI" ==========
;Modul RS232_Liste Version 1.01 vom 05.05.2013
#PB_Vers = "4.20"
;
;Funktion: liefert einen WortQueue aller verfügbaren COM´s (COMx {COMy {COMz...}})
;
;Aufruf: COM_Queue$ = RS232_Liste()
;
;#jaPBeExt exit
Procedure.s RS232_Liste() ;- liefert String, in dem alle verfügbaren COM´s enthalten sind
Protected Com$, ComNr, PortNr, Queue$
For ComNr = 1 To 20
Com$ = "COM" + Str(ComNr)
PortNr = OpenSerialPort(#PB_Any, Com$, 300, #PB_SerialPort_NoParity, 8, 1, #PB_SerialPort_NoHandshake, 1024, 1024)
If PortNr
Queue$ + Com$ + " "
CloseSerialPort(PortNr)
EndIf
Next
;Debug #DQUOTE$ + Trim(queeu$) + #DQUOTE$
ProcedureReturn Trim(Queue$)
EndProcedure
; jaPBe Version=3.8.6.707
; FoldLines=00080014
; Build=0
; FirstLine=0
; CursorPosition=1
; ExecutableFormat=Windows
; DontSaveDeclare
; EOF
;========== Ende Modul "RS232_Liste.PBI" ==========
;========== Begin Modul "Wort.PBI" ==========
;Modul Wort Version 1.14 vom 05.03.2013 (PB_V3.73)
#PB_Vers = "4.20"
; (Basis: THEOS-Modul SYSTEM.MODLIB.WORT V 3.03 vom 11.05.1997)
;
;Funktion: liefert erstes Wort in einem String und verkürzt Diesen entsprechend
; entspricht prinzipell der PB-Funktion "StringField()", benötigt jedoch
; keinen Wort-Index und erkennt Wort aufgrund diverser Trenn- / Klammerungs=
; zeichen. Außerdem wird die Wort-Basis (Eingangs-String-Parameter) wie
; eine Queue gehandhabt und nach FunktionsEnde ist das erkannte Wort am
; Anfang dieses Strings entfernt...
;
;Aufruf: Wort$ = Wort(@String$) - liefert nächstes Wort von String$ (bis Leerzeichen bzw. geklammert)
; wobei: String$ = Text-Variable !!!, in der ggf. mehrere Worte enthalten sind.
; Ein Wort ist:
; - alle Zeichen bis zum nächsten Blank(führende Blank´s werden ignoriert) oder
; - geklammert durch " (^34), ' (^39), ´(^180), " " (^160) oder ^255 oder
; - bis zum nächsten Zeichen lt. Global ´Wort_Ende$´ oder
; - geklammter durch Zeichen lt. Global ´Wort_Klammer$´
; Die Global´s Wort_Ende$ und Wort_Klammer$ sind nach Funktions-Rückkehr resetet
; (=leer!!), müßen also -sofern erforderlich- _vor jedem Aufruf_ dieser Funktion
; entsprechend gesetzt werden !!!!
;
; Diese Funktion liefert das 1. Wort im String (führende Leerzeichen werden ignoriert)
; und der String wird entsprechend verkürzt
; Beispiel:
; A$ = "hallo ´du da´ alles klar"
; B$ = Wort(@A$) ;1. Aufruf
; (--> B$ ist "hallo", A$ ist nun "´du da´ alles klar")
; B$ = Wort(@A$) ;2. Aufruf
; (--> B$ ist "du da", A$ ist nun "alles klar") (wg. ´´-Klammerung)
; B$ = Wort(@A$) ;3. Aufruf
; (--> B$ ist "alles", A$ ist nun "klar")
; B$ = Wort(@A$) ;4. Aufruf
; (--> B$ ist "klar", A$ ist nun leer)
;
Global Wort_Ende$ ;Zeichen(kette) für Wort-Ende, GROSS-/klein-Schrift egal
;!!! ist nach Funktionsausführung resettet (=leer) !!!
Global Wort_Klammer$ ;Klammerungs-Zeichen: alle Zeichen, die als Wort-Anfangs- oder Ende-Kennung
;beim folgenden Aufruf zulässig sein sollen
Global Wort_EndKz$ ;Rückgabe: gefundenes/benutztes Wort-Ende-Zeichen
;bzw. Zeichenkette bei Einsatz von Wort_Ende$
#Wort_BlankReplace = Chr(28);siehe Modul "WortForm()"...
;========== Begin Modul "CharChg.PBI" ==========
;Modul CharChg Version 1.13 vom 27.11.2011
#PB_Vers = "4.20"
;
;Funktion: mehrfach-Austausch in einem String, in einem BasisString
; wird ein Suchbegriff (EinzelZeichen oder auch ZeichenKette)
; gesucht und durch einem Ersatzbegriff (leer, EinzelZeichen
; oder auch Zeichenkette) ersetzt, das ganze auch mehrfach
; (jedes Vorkommen des Suchbegriffes wird durch den Ersatz=
; begriff ersetzt), innerhalb des Ersatzbegriffes kann der
; Suchbegriff vorkommen, wird jedoch nicht verändert.
;
; Gegenüber der PureBasic-StandartFunktion ReplaceString(),
; die standartmäßig eingesetzt werden sollte, bestehen
; folgende Unterschiede:
; - bei der GROSS-/klein-Schrift-Suche werden auch deutsche
; Sonderzeichen (Ä, Ö, Ü, ß) korrekt gehandhabt
; - Wort-Austausch möglich (vor und nach Suchbegriff darf
; kein Buchstabe im Basis-String stehen)
; - es wird die Anzahl durchgeführter Tauschungen zurück=
; geliefert
; - Mehrfach-Austausch (z.Bsp. TrimAll: " "->" ") hier
; fehlerfrei (klappt nicht in ReplaceString of PB3.80)
; Für nähere Details siehe unten (Global´s)...
;
;
;Aufruf: newstring = CharChg(base$, such$, ersatz$ {, Mode}) -Zeichen(ketten)-Austausch
;wobei: base$ = Basis-String, in dem Teile ausgetauscht werden
; sollen
; such$ = Zeichen(-kette), die in base$ gesucht und ersetzt
; werden soll
; ersatz$ = Zeichen(-kette), die anstelle von such$ in base$
; eingesetzt werden soll
; Mode = Steuerungen (bitorientiert):
#CharChg_noCase = 1 ; = noCase (siehe Global "CharChg_noCase")
#CharChg_Word = 2 ; = Word (siehe Global "CharChg_Word")
; Sobald entweder die Steuerung aktiv ist _oder_ die
; entsprechende globale Variable, so wird die Funktion
; ausgeführt.
; Diese Mode-Steuerung ist zu bevorzugen, ggf. die alte,
; reduntante Global´s-Steuerung (siehe unten) entfernen !!!
;
Global CharChg_noCase ;!!!nicht mehr einsetzen !!! benutze #CharChg_noCase !!!
;wenn ungleich 0, so wird GROSS-/klein-Schrift
;ignoriert ("AnKe" wird in "TaNkEn" gefunden
;und ausgetauscht) !!! Variable ist nach
;FunktionsEnde resetet !!! (auf 0 gestellt)
Global CharChg_Word ;!!!nicht mehr einsetzen !!! benutze #CharChg_Word !!!
;wenn ungleich 0, so wird nur ausgetauscht, wenn
;vor und nach dem Suchbegriff kein Buchstabe und
;keine Ziffer steht ("anke" wird _nicht_ in
;"tanken" gefunden). Variable ist nach
;FunktionsEnde resetet !!! (auf 0 gestellt)
Global CharChg_Cnt ;liefert die Anzahl der durchgeführten Aus=
;tauschungen
#CharChg_WordChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789ÄÖÜabcdefghijklmnopqrstuwvxyzöäü"
;#jaPBeExt exit
Procedure.s CharChg(CC_Base$, CC_Such$, CC_Repl$, Mode = 0)
Protected Base$, pos.l, Such$
CharChg_Cnt = 0
If Mode & #CharChg_noCase : CharChg_noCase = 1 : EndIf
If Mode & #CharChg_Word : CharChg_Word = 1 : EndIf
If CC_Such$>""
charChg_suchen:
If CharChg_noCase
Base$ = CC_Base$ : Such$ = CC_Such$
pos = FindString(PeekS(CharLower_(Base$)), PeekS(CharLower_(Such$)), pos + 1)
Else : pos = FindString(CC_Base$, CC_Such$, pos + 1)
EndIf
If pos
If CharChg_Word
; Debug "WordSuch [" + CC_Such$ + "] in [" + CC_Base$ + "]"
; Debug "pre=[" + Mid(" " + CC_Base$, Pos, 1) + "], post=[" + Mid(CC_Base$ + " ", Pos + Len(CC_Such$), 1) + "]"
If FindString(#CharChg_WordChars, Mid(" " + CC_Base$, pos, 1), 1)Or FindString(#CharChg_WordChars, Mid(CC_Base$ + " ", pos + Len(CC_Such$), 1), 1)
pos + 1
Goto charChg_suchen
EndIf
EndIf
CC_Base$ = Left(CC_Base$, pos - 1) + CC_Repl$ + Mid(CC_Base$, pos + Len(CC_Such$), 99999)
CharChg_Cnt = CharChg_Cnt + 1
pos + Len(CC_Repl$) - Len(CC_Such$)
Goto charChg_suchen
EndIf
EndIf
CharChg_noCase = 0 : CharChg_Word = 0
ProcedureReturn CC_Base$
EndProcedure
;========== Ende Modul "CharChg.PBI" ==========
;#jaPBeExt exit
Procedure.s Wort(*Param)
Protected Param$, Wort$
If * Param>1
Param$ = LTrim(PeekS(*Param))
If Wort_Ende$ = ""
If Wort_Klammer$ = ""
Wort_Klammer$ = #DQUOTE$ + Chr(39) + Chr(180) + Chr(255) + Chr(160);", ', ´ oder ^255
EndIf
If FindString(Wort_Klammer$, Left(Param$, 1), 1)And Param$>""
Wort_Ende$ = Left(Param$, 1)
Param$ = Right(Param$, Len(Param$) - 1)
Else
Wort_Ende$ = " "
EndIf
EndIf
Wort_Ende$ = UCase(Wort_Ende$)
While UCase(Left(Param$, Len(Wort_Ende$)))<>Wort_Ende$ And Param$>""
Wort$ + Left(Param$, 1)
Param$ = Mid(Param$, 2)
Wend
Param$ = Mid(Param$, Len(Wort_Ende$))
Wort$ = LTrim(CharChg(Wort$, #Wort_BlankReplace, Chr(32)))
Wort_EndKz$ = Wort_Ende$
Wort_Ende$ = "" : Wort_Klammer$ = ""
PokeS(*Param, LTrim(Right(Param$, Len(Param$) - 1)))
EndIf
ProcedureReturn Wort$
EndProcedure
;{- Test-Routine
; Queue$ = "na, mal%LF sehen"
; Wort_Ende$ = "%lf"
; Debug "Queue = " + #DQUOTE$ + Queue$ + #DQUOTE$
; Debug "Wort_Ende$ = " + #DQUOTE$ + Wort_Ende$ + #DQUOTE$
; While Queue$>""
; Wort + 1
; Debug Str(Wort) + ". Wort = " + #DQUOTE$ + Wort(@Queue$) + #DQUOTE$
; Wend
;}
;========== Ende Modul "Wort.PBI" ==========
Procedure COM_setState(Signal, Mode);- Signal (RI, DCD, DSR oder CTS) ein/ausschalten
Debug "setzte " + #DQUOTE$ + Signal$(Signal) + #DQUOTE$ + " auf " + Str(Mode)
EscapeCommFunction_(RS232_Hdl, 2 + Signal * 2 - Mode)
; #SETRTS = 3 ;Sends the RTS (request-to-send) Signal.
; #CLRRTS = 4 ;Clears the RTS (request-to-send) Signal.
; #SETDTR =5 ;Sends the DTR (Data-terminal-ready) Signal.
; #CLRDTR = 6 ;Clears the DTR (Data-terminal-ready) Signal.
EndProcedure
Procedure COM_Open() ;- RS232-Port aufgrund Gadget-Daten öffnen / updaten
Protected Baud, Com$, dcb.DCB, Hand, Parity, Stop.d, word
If RS232_Hdl : CloseHandle_(RS232_Hdl): EndIf ;ggf. offenen Port zuerst mal schließen (=update)
Com$ = GetGadgetText(PortGad)
Baud = Val(GetGadgetText(BaudGad))
Parity = GetGadgetState(ParityGad)
word = Val(GetGadgetText(WordGad))
Stop = ValD(ReplaceString(GetGadgetText(StopGad), ",", "."))
Hand = GetGadgetState(HandGad)
Debug "open " + Com$ + ": Baud=" + Str(Baud) + ", Parity=" + Str(Parity) + ", Word=" + Str(word) + ", Stop=" + StrD(Stop, 1) + ", Hand=" + Str(Hand)
RS232_Hdl = CreateFile_(Com$, #GENERIC_READ | #GENERIC_WRITE, 0, #Null, #OPEN_EXISTING, #Null, #Null)
If RS232_Hdl = #INVALID_HANDLE_VALUE
RS232_Hdl = 0
For Baud = 1 To 2 : DisableGadget(GadNr(Baud), 1): Next ;ohne offenen Port: Signal-Statuse gesperrt
MessageRequester("Fehler serielle Schnittstelle !!!", "COM-Port " + #DQUOTE$ + Com$ + #DQUOTE$ + " ist nicht verfügbar !!!", #MB_ICONEXCLAMATION)
Else
dcb\DCBlength = SizeOf(DCB)
dcb\BaudRate = Baud
; BPCDD STOIENR AD2345678901234567
dcb\fbits = %00000100000001000000000000000000
dcb\wReserved = 0
dcb\XonLim = #BufferIn
dcb\XoffLim = #BufferOut
dcb\ByteSize = word
dcb\Parity = Parity
dcb\StopBits = Stop
SetCommState_(RS232_Hdl, @dcb)
COM_setState(2, 0);DTR aus
For Baud = 1 To 2 : DisableGadget(GadNr(Baud), 0): Next ;Port offen: Signal-Statuse nun schaltbar
EndIf
EndProcedure
Global x, y, breit
Procedure NewCombo(Queue$, StartOpt);- Aufbau ComboBox incl. Options-Füllung
Protected GadNr = ComboBoxGadget(#PB_Any, x, y, breit, 200): y + 25
Repeat : AddGadgetItem(GadNr, - 1, Wort(@Queue$)):Until Queue$ = ""
SetGadgetState(GadNr, StartOpt)
ProcedureReturn GadNr
EndProcedure
;****************************************************************
;** MainSource **
;****************************************************************
DisableExplicit
;{- der Fenster-Aufbau
WinNr = OpenWindow(#PB_Any, 0, 0, 200, 190, "RS232-Port: Signale", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CreateGadgetList(WindowID(WinNr))
breit = 70
For Signal = 1 To 2
GadNr(Signal) = CheckBoxGadget(#PB_Any, x, y, breit, 20, Signal$(Signal))
DisableGadget(GadNr(Signal), 1)
y + 25
Next
x + breit : y = 0 : breit = 40
Texte$ = "Port Baud Parity Data Stop Handshake" ;Prompt´s der Setup-Gadget´s
Repeat : TextGadget(#PB_Any, x, y, breit, 20, Wort(@Texte$)): y + 25 : Until Texte$ = ""
x + breit : y = 0 : breit = 70
;Texte$ = RegistryRead(#Prg_Name, "Status") ;get last Setup aus Registry (geREMt, weil´s mit RegistryHandyling zu gross wird...)0
PortGad = NewCombo(RS232_Liste(), Val(Wort(@Texte$)))
BaudGad = NewCombo("50 75 110 150 300 600 1200 1800 2400 4800 9600 19200 38400 57600 115200", Val(Wort(@Texte$)))
ParityGad = NewCombo("Keine Odd Even Mark Space", Val(Wort(@Texte$)))
WordGad = NewCombo("'7 Bit' '8 Bit", Val(Wort(@Texte$)))
StopGad = NewCombo("1 1,5 2", Val(Wort(@Texte$)));!!!! 1.5 klappt unter PB nicht !!!
HandGad = NewCombo("ohne 'ohne, RTS=1' RTS/CTS Xon/Xoff", Val(Wort(@Texte$)))
openSw = ButtonGadget(#PB_Any, x, y, 70, 30, "open")
;}
;{- die Steuer-Schleife
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case openSw
COM_Open()
If RS232_Hdl : SetGadgetText(openSw, "update"): EndIf
Default ;check Signal-CheckBoxes
For Signal = 1 To 2
If EventGadget() = GadNr(Signal)
COM_setState(Signal, GetGadgetState(GadNr(Signal)))
Break
EndIf
Next
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow ;}
;{- Nachlauf: COM-Setup speichern
Texte$ = Str(GetGadgetState(PortGad)) + " "
Texte$ + Str(GetGadgetState(BaudGad)) + " "
Texte$ + Str(GetGadgetState(ParityGad)) + " "
Texte$ + Str(GetGadgetState(WordGad)) + " "
Texte$ + Str(GetGadgetState(StopGad)) + " "
Texte$ + Str(GetGadgetState(HandGad))
;RegistryWrite(#Prg_Name, "Status", Texte$) ;save Setup in Registry (geREMt, weil´s mit RegistryHandyling zu gross wird...)
;}