Speicherüberlauf in VB

Computer: Software & Programmierung Visual Basic
#1

Hallo,

vor geraumer zeit hatten wir mal das Thema gehabt, das der Arbeitsspeicher unter VB voll wird und wie man den leert.
Bisher dachte ich das VB das selbst gut verwaltet, jedoch pustekuchen wars.

Folgende Sub

Public Sub OpenTabellen()
 On Error Resume Next
 Dim aRS As New ADODB.Recordset
 
 For i = 0 To 6
 Select Case i
 Case 0: xTabelle = "SELECT \* FROM tblFilme ORDER BY Film\_Titel": GoSub RecordÖffnen: Set Rs.Filme = aRS: Set aRS = Nothing
 Case 1: xTabelle = "SELECT \* FROM tblFilmDarsteller ORDER BY Film\_Id ": GoSub RecordÖffnen: Set Rs.Combi = aRS: Set aRS = Nothing
 Case 2: xTabelle = "SELECT \* FROM tblSchauspieler ORDER BY SchauspielerNachname, SchauspielerVorname": GoSub RecordÖffnen: Set Rs.Mitwirkende = aRS: Set aRS = Nothing
 Case 3: xTabelle = "SELECT \* FROM Genre ORDER BY Art": GoSub RecordÖffnen: Set Rs.Art = aRS: Set aRS = Nothing
 Case 4: xTabelle = "SELECT \*FROM tblSchauspieler INNER JOIN tblFilmDarsteller ON tblSchauspieler.Schauspieler\_Id = tblFilmDarsteller.Schauspieler\_Id ORDER By Film\_Id, Funktion,SchauspielerNachname, SchauspielerVorname;": GoSub RecordÖffnen: Set Rs.Dusty = aRS: Set aRS = Nothing
 Case 5: xTabelle = "SELECT \* FROM (tblFilme INNER JOIN tblFilmDarsteller ON tblFilme.Film\_Id = tblFilmDarsteller.Film\_Id) INNER JOIN tblSchauspieler ON tblFilmDarsteller.Schauspieler\_Id = tblSchauspieler.Schauspieler\_Id ORDER BY Film\_Titel;": GoSub RecordÖffnen: Set Rs.Quincy = aRS: Set aRS = Nothing
 Case 6: xTabelle = "SELECT Nr,Film\_Titel FROM tblFilme ORDER BY Nr ": GoSub RecordÖffnen: Set Rs.Printen = aRS: Set aRS = Nothing

 End Select
 Next i
 Exit Sub

RecordÖffnen:
 aRS.CursorLocation = adUseClient
 Do While aRS.State 1 And z 1 Then
 MsgBox "Die Tabelle " & xTabelle & vbCr & "konnte nicht gefunden oder geöffnet werden.!"
 End If
 aRS.MarshalOptions = adMarshalModifiedOnly
 Return
End Sub

Wenn ich diese Sub etliche male aufrufe, Bekomme ich auch die Fehlermeldung.
Dieser Sache binsch nun mal auf dem Grund gegangen!

Goto und Gosub stammen aus der Basic Steinziet als es noch keine Proceduren gab

Mit Goto und Gosub sollte man niemals Aus Schleifen Springen (wie ich in meiner For -Next)
Dabei wird die Rücksprung Adresse nicht aus dem Addressspeicher gelöscht. Das braucht man nur genügend oft machen dann ereichst du ganz schnell ein
Error Out-Off Memory

Vielleicht war dies sein Problem?

MFG Alex

#2

Hi Alex,
danke für den Tipp! Mein letztes ‚Gosub‘ ist schon 'ne Weile her, aber das wird sicher mal bei einer Fehlersuche helfen, die alten Programme laufen noch. :wink:
Gruß, Rainer

#3

Hi Alex,
danke für den Tipp! Mein letztes ‚Gosub‘ ist schon 'ne Weile
her, aber das wird sicher mal bei einer Fehlersuche helfen,
die alten Programme laufen noch. :wink:
Gruß, Rainer

Hallo Rainer,

nunja man lernt nie aus. ich bin fast verzweifelt eh ich darauf gekommen bin. Anstatt Gosub einfach ein Function oder Procedure und schon hat man das problem umgegangen :smile:

MFG Alex

#4

Hallo, allerseits!

nunja man lernt nie aus. ich bin fast verzweifelt eh ich
darauf gekommen bin. Anstatt Gosub einfach ein Function oder
Procedure und schon hat man das problem umgegangen :smile:

*Hüstel* Die einzig „erlaubte“ Verwendung von Goto ist im Zusammengang mit der On Error Goto-Anweisung.

Alle anderen Gotos, Gosubs und Exits und sonstige „Sprünge“ zeugen von schlechtem Stil, machen den Code unübersichtlich und fehleranfällig (siehe Topic). All diese komischen Konstrukte lassen sich einfachst umgehen (Auslagerung in Funktionen/Prozeduren, Abfrage mittels If/Select Case).

Man tue sich einen Gefallen und verzichte auf den Schrott.

:wink:

Gruß, Manfred

#5

Hallo Manfred,

Man tue sich einen Gefallen und verzichte auf den Schrott.

Machen wir doch. :wink: Irgendwann habe ich aber mal angefangen.
Das hat so ausgesehen, daß ich Karstadt einen Besuch abgestattet habe, DM 300,- auf den Tisch geblättert und dann zu Hause versucht, damit etwas anzufangen. Zwei Monate später habe ich damit Programme für die Produktion geschrieben, die heute noch laufen. :wink:
Wenn ich die heute sehe, sträuben sich mir die Nackenhaare.
So ist das eben, wenn man sich langsam verbessert. Dazu haben wir doch w-w-w.

Gruß, Rainer

#6

Hi, Rainer!

zu Hause versucht, damit etwas anzufangen. Zwei Monate später
habe ich damit Programme für die Produktion geschrieben, die
heute noch laufen. :wink:
Wenn ich die heute sehe, sträuben sich mir die Nackenhaare.

„Haben Sie manchmal Deja-vus, Mrs. Lancaster?“ Das kenne ich doch woher…

Gruß, Manfred

#7

Hi Manfred,

zu Hause versucht, damit etwas anzufangen. Zwei Monate später
habe ich damit Programme für die Produktion geschrieben, die
heute noch laufen. :wink:
Wenn ich die heute sehe, sträuben sich mir die Nackenhaare.

„Haben Sie manchmal Deja-vus, Mrs. Lancaster?“ Das kenne ich
doch woher…

hab ich das schon mal erzählt? Sorry, dann werde ich wohl doch langsam alt, wenn ich schon anfange, mich zu wiederholen. :wink:

Gruß, Rainer

#8

OT: Speicherüberlauf in VB
Hi, Rainer!

zu Hause versucht, damit etwas anzufangen. Zwei Monate später
habe ich damit Programme für die Produktion geschrieben, die
heute noch laufen. :wink:
Wenn ich die heute sehe, sträuben sich mir die Nackenhaare.

„Haben Sie manchmal Deja-vus, Mrs. Lancaster?“ Das kenne ich
doch woher…

hab ich das schon mal erzählt? Sorry, dann werde ich wohl doch
langsam alt, wenn ich schon anfange, mich zu wiederholen. :wink:

Ich dachte da nicht an Dich… Aber gut zu hören, dass das Phänomen ein wenig weiter verbreitet ist…

Gruß, Manfred

#9

Hallo, allerseits!

Hallo,

nunja man lernt nie aus. ich bin fast verzweifelt eh ich
darauf gekommen bin. Anstatt Gosub einfach ein Function oder
Procedure und schon hat man das problem umgegangen :smile:

*Hüstel* Die einzig „erlaubte“ Verwendung von Goto ist im
Zusammengang mit der On Error Goto-Anweisung.

Hmm, verboten ist es ganz sicherlich nicht!
In manchen Faellen bietet es sich nach wievor an. Vielleicht nicht Goto sondern Gosub!
Auslagern in eine Function oder Procedure geht schon, Nur ist es in manchen Faellen ein arger aufwand, wo man sich fragt ob es sich lohnt!

Alle anderen Gotos, Gosubs und Exits und sonstige „Sprünge“
zeugen von schlechtem Stil, machen den Code unübersichtlich
und fehleranfällig (siehe Topic). All diese komischen
Konstrukte lassen sich einfachst umgehen (Auslagerung in
Funktionen/Prozeduren, Abfrage mittels If/Select Case).

Ich könnt dir mal einen Ausschnitt posten, wo ich dir eine Sub poste die ca. 200 Zeilen hat, wo es nicht anders ging, dort kommt der Befehl gosub einmal vor. In dieser Situation laesst sich nichts mit if, select case etc machen *zwinker*. Ein Aufruf einer procedure / Sub würde dort den rahmen sprengen.

Man tue sich einen Gefallen und verzichte auf den Schrott.

Was ist wenn es nicht anders geht? Soll man zusaetzlich 10 oder gar 20 zeilen schreiben, wenn es eine tut? ist dann ne Frage der Performance…

:wink:

Gruß, Manfred

Gruß Alex

PS: 2 kleine Bsp. aus einem sehr alten Projekt von mir :smile:, wo ich noch goto verwendet habe, aber in dem falle ging es da ich kein Return brauchte. Die Programme laufen heute noch , Fehlerfrei!
Selbst wenn du ein Programm hast wo du ca 200 - 300 Functionen & Sub’s hast, bist du froh ueber jede Function / Sub die du sparen kannst, weil du so eher den Durchblick behaelst.

Ist net Bees gemeint :smile:

Private Sub Picture3\_Click()
On Error Resume Next
Dim msg$, empfänger$, hlp$
Dim pos As Long, pos1 As Long, oldpos As Long
Dim found As Boolean
Dim rs1 As Recordset
If Trim(Text2.text) = "" Then Exit Sub
If Combo1.ListIndex \> 0 And TabAktiv = 1 Then 'Ist der öffentliche main aktiv oder privates fenster?
 msg = "/flüstern " + Combo1.text + " " + Text2.text
Else
 msg = Text2.text
 If Left(Text2.text, 1) = "/" Then
 'es handelt sich um einen Befehl
 pos = InStr(1, Text2.text, " ", vbTextCompare) + 1
 hlp = Text2.text
 Select Case Trim(UCase(Text2.text)) 'Wenn nur /befehl eingegeben wird, wird geprueft ob es sich um eine handlung handelt
 Case "/ZURUECK", "/ZURÜCK", "/BACK", "/AFK", "/AWAY", "/WEG"
 hlp = Text2.text + " Hilfsargument"
 End Select
 If BefehlsEingabeOK(hlp) Then
 'Sub muss verlassen werden...
 Text2.text = ""
 Text2.SetFocus
 Exit Sub
 Else
 'Sub muss weiter ausgefuehrt werden ...
 msg = Text2.text 'Text wird in der Funktion geändert...
 GoTo bearbeite
 End If
 End If
End If
If TabAktiv \> 1 Then ' Im privaten Tab?
 msg = "/flüstern " + TabStrip1.Tabs(TabAktiv).Caption + " " + Text2.text
End If
bearbeite:
If Config(0).sleep And Left(msg, 1) "/" Then ' Wenn User schläft und nachricht im Main schreiben mag
 Text2.text = ""
 Text2.SetFocus
 Exit Sub
End If
If UCase(Left(msg, Len("/flüstern "))) = "/FLÜSTERN " Then
 empfänger = Mid(msg, 11, InStr(11, msg, " ", 1) - InStr(1, msg, " ", 1) - 1)
 msg = Mid(msg, InStr(Len("/Flüstern ") + 1, msg, " ", 1) + 1, 255)
 Select Case Module1.AufIgnoListe(0, empfänger)
 Case 0
 'kein Igno vorhanden
 Case 1, 2
 'du hast ein m oder w ignoriert
 ShowMessage "Moment mal! " & Config(0).user & ", das kannst du nicht wenn du " & empfänger & " ignoriert hast. Erst mußt du " & empfänger & " von der Ignorierliste mit dem Kommando /EntfernIgnorier " & empfänger & " entfernen", 13, "System", "System", True, False
 GoTo clear
 Case 3
 'du wurdest ignoriert
 ShowMessage "Sorry " & Config(0).user & ", aber niemand im Chat heißt " & empfänger & ".", 13, "system", "System", True, False
 GoTo clear
 End Select
 If Config(0).Scrollrichtung Then Call CheckSpelling(Text2)
Else
 empfänger = "Main"
 If Config(0).Scrollrichtung Then Call CheckSpelling(Text2)
End If
'abschicken der nachricht an den Clienten
If UCase(empfänger) = "MAIN" Then
 If Config(0).geschlecht Then
 MsgToAll "TEXT:" + Config(0).user + ":" + empfänger + ":False:True:2:" + msg
 Else
 MsgToAll "TEXT:" + Config(0).user + ":" + empfänger + ":False:False:2:" + msg
 End If
Else
 'Msg an eine einzelne Person
 found = False
 For pos = 0 To wsckchat.count - 1
 If UCase(Trim(wsckchat(pos).Tag)) = UCase(empfänger) Then
 found = True
 Exit For
 End If
 Next pos
 If found Then
 'empfänger wurde gefunden und nachricht senden
 If Config(0).geschlecht Then
 Senden wsckchat(pos), "TEXT:" + Config(0).user + ":" + empfänger + ":False:True:9:" + msg
 Else
 Senden wsckchat(pos), "TEXT:" + Config(0).user + ":" + empfänger + ":False:False:9:" + msg
 End If
 GoTo Anzeigen
 Else
 'empfänger wurde nicht gefunden, Lastlogin ermitteln & Meldung senden
 pos1 = Findedatensatz(empfänger)
 If pos1 \> -1 Then
 Set rs1 = db.OpenRecordset("SELECT \*from Daten")
 rs1.MoveLast
 rs1.AbsolutePosition = pos
 End If
 found = False
 For pos = 0 To wsckchat.count - 1
 If UCase(Trim(wsckchat(pos).Tag)) = UCase(Trim(Config(0).user)) Then
 found = True
 Exit For
 End If
 Next pos
 If Not found Then Exit Sub 'Absender ist offline
 If Config(0).geschlecht Then
 If pos1 = -1 Then
 ShowMessage "Der Chatter " + empfänger + " ist nicht in diesem Chat registriert!", 13, "System", Config(0).user, Config(0).geschlecht, False
 Else
 ShowMessage "Der Chatter " + empfänger + " ist zur Zeit nicht Online. Er wurde zum letzten mal am " + Str(rs1!LastLogin) + " gesehen.", 13, "System", Config(0).user, Config(0).geschlecht, False
 End If
 Else
 If pos = -1 Then
 ShowMessage "Der Chatter " + empfänger + " ist nicht in diesem Chat registriert!", 13, "System", Config(0).user, Config(0).geschlecht, False
 Else
 ShowMessage "Der Chatter " + empfänger + " ist zur Zeit nicht Online. Er wurde zum letzten mal am " + rs1!LastLogin + " gesehen.", 13, "System", Config(0).user, Config(0).geschlecht, False
 End If
 End If
 End If
 Text2.text = ""
 Text2.SetFocus
 Exit Sub
End If
Anzeigen:
LastKeyPress = Now 'es wurde eine taste gedrueckt, zaehlerzeit neu setzen
DatenRefresh Config(0).user, msg, empfänger, 1
hlp = empfänger
ShowMessage msg, 2, Config(0).user, empfänger, Config(0).geschlecht, True
empfänger = hlp
If FindeKlasse(empfänger, pos) Then
 If Config(pos).sleep Then
 oldpos = rs1.AbsolutePosition
 pos1 = Findedatensatz(empfänger)
 If pos1 = -1 Then
 msg = "Ich bin zur Zeit nicht anwesend! Deine Nachrichten werden für mich gespeichert!"
 Else
 rs1.AbsolutePosition = pos1
 msg = rs1!Awayautommsg
 End If
 'Awaymessage ermittelt ... anzeigen der nachricht und das wars dann
 ShowMessage msg, 13, empfänger, Config(0).user, Config(0).geschlecht, False
 End If
End If
clear:
Text2.text = ""
Text2.SetFocus
End Sub

Bsp. 2

Public Sub ShowMessage(msg As String, fw As Byte, user As String, Fenster As String, geschlecht As Boolean, Gesendet As Boolean, Optional Bild As Byte = 1)
On Error GoTo fehler
Dim X() As String
Dim i As Integer
Dim Fett As Boolean, Kursiv As Boolean, underline As Boolean
Dim fettwert As Byte, kursivwert As Byte, underlinewert As Byte
Dim s As String
Dim schreibe As Boolean
Dim pos As Byte
Dim BefehlOK As Boolean
Dim smiley As Byte
Dim kw As Boolean
Dim p As Recordset
Dim farbwert As Long
Dim denke As Boolean
Dim ich As Boolean
Dim schlaf As Boolean
Dim sing As Boolean
Dim lieb As Boolean
Dim schrei As Boolean
Dim c As RichTextBox
Dim fensterfound As Integer
Dim position As Long
 If (LCase(user) = "system" Or LCase(Fenster) = "system") Then
 If Not (Config(0).Kapitaensnachrichten) Then Exit Sub
 Fenster = "Main"
 user = "System"
 Select Case Bild
 Case 1
 msg = "(Kapitän) " + msg
 Case 2
 msg = "(Technobabe) " + msg
 Case 3
 msg = "(Ratte) " + msg
 Case 4
 msg = "(Matrose) " + msg
 Case 5
 msg = "(Papagei) " + msg
 Case 6
 msg = "(Barkeeper) " + msg
 Case 7
 msg = "(Seemann) " + msg
 Case 8
 msg = "(Freak) " + msg
 Case 9
 msg = "(Marcus) " + msg
 Case 10
 msg = "(Schatz) " + msg
 End Select
 Else
 If FindeKlasse(user, position) And AufIgnoListe(position, user) \> 0 Then Exit Sub 'User ist auf der Ignoliste
 End If
 If UCase(Fenster) = "MAIN" Then
 Set c = Hauptfenster.textbox(0)
 If Not (Gesendet) Then Hauptfenster.TabStrip1.Tabs(1).HighLighted = True
 Else
 fensterfound = -1
 For i = 1 To Hauptfenster.TabStrip1.Tabs.count
 If (UCase(Hauptfenster.TabStrip1.Tabs(i).Caption) = UCase(Fenster) And Gesendet) Or (UCase(Hauptfenster.TabStrip1.Tabs(i).Caption) = UCase(user) And Not (Gesendet)) Then
 fensterfound = i
 Exit For
 End If
 Next i
 If fensterfound -1 Then
 Set c = Hauptfenster.textbox(i - 1) '-1 weil die tabstrips bei 1 anfangen zu zaehlen
 If Not (Gesendet) Then Hauptfenster.TabStrip1.Tabs(i).HighLighted = True
 Hauptfenster.Image1.Visible = True
 Else
 With Hauptfenster
 If Gesendet Then
 .TabStrip1.Tabs.Add .TabStrip1.Tabs.count + 1, Fenster, Fenster
 .TabStrip1.Tabs(.TabStrip1.Tabs.count).Tag = .TabStrip1.Tabs.count - 1
 .Image1.Visible = True
 Else
 .TabStrip1.Tabs.Add .TabStrip1.Tabs.count + 1, user, user
 .TabStrip1.Tabs(.TabStrip1.Tabs.count).Tag = .TabStrip1.Tabs.count - 1
 .Image1.Visible = True
 End If
 Load .textbox(.TabStrip1.Tabs.count - 1)
 .textbox(.TabStrip1.Tabs.count - 1).text = ""
 .textbox(.TabStrip1.Tabs.count - 1).SelFontName = .textbox(0).Font.Name
 .textbox(.TabStrip1.Tabs.count - 1).SelFontSize = .textbox(0).Font.Size
 .textbox(.TabStrip1.Tabs.count - 1).Visible = False
 Hauptfenster.Image1.Visible = True
 Set c = .textbox(.TabStrip1.Tabs.count - 1) '-1 weil die tabstrips bei 1 anfangen zu zaehlen
 If Not (Gesendet) Then .TabStrip1.Tabs(.TabStrip1.Tabs.count).HighLighted = True
 End With
 End If
 End If
 c.SelStart = Len(c)
 If (SendMessage(c.hWnd, &HBA, 0, 0&amp:wink: - 1) = Config(0).History Then c.text = "" 'Textfeld löschen
 s = msg
 kw = keyword(s, user)
 If LCase(user) = "system" Then kw = True
 If Config(0).sleep And Not (kw) And UCase(Fenster) = "MAIN" Then Exit Sub 'User ist im Schlafmodus und eine Message ist angekommen aber ohne hervorgehobene Worte -\> Keine Anzeige
 denke = False: ich = False: schlaf = False: schrei = False: lieb = False: sing = False
 If (Left(s, 1) = ":") And (Config(0).Effekte) Then
 'Aktion Ich wird eingeleitet
 ich = True
 fw = 3
 s = Right(s, Len(s) - 1)
 ElseIf (InStr(1, UCase(s), "/ICH ", 1) = 1) And (Config(0).Effekte) Then
 ich = True
 fw = 3
 s = Right(s, Len(s) - 4)
 ElseIf (Left(s, 1) = ";") And (Config(0).Effekte) Then
 'aktion denke wird eingeleitet
 denke = True
 fw = 8
 s = Right(s, Len(s) - 1)
 ElseIf (InStr(1, UCase(s), "/DENK ", 1) = 1) And (Config(0).Effekte) Then
 denke = True
 fw = 8
 s = Right(s, Len(s) - 6)
 ElseIf (InStr(1, UCase(s), "/DENKE ", 1) = 1) And (Config(0).Effekte) Then
 denke = True
 fw = 8
 s = Right(s, Len(s) - 7)
End If
 If (InStr(1, UCase(s), "/SCHLAF ", 1) = 1) And (Config(0).Effekte) Then
 'es handelt sich um die handlung schlaf
 schlaf = True
 fw = 4
 s = Right(s, Len(s) - 8)
 ElseIf (InStr(1, UCase(s), "/LIEB ", 1) = 1) And (Config(0).Effekte) Then
 'es handelt sich um die handlung lieb
 lieb = True
 fw = 5
 s = Right(s, Len(s) - 6)
 ElseIf (InStr(1, UCase(s), "/SING ", 1) = 1) And (Config(0).Effekte) Then
 'es handelt sich um die handlung sing
 sing = True
 fw = 12
 s = Right(s, Len(s) - 6)
 ElseIf (InStr(1, UCase(s), "/SCHREI ", 1) = 1) And (Config(0).Effekte) Then
 schrei = True
 fw = 6
 s = Right(s, Len(s) - 8)
 End If
 If kw And Not (Gesendet) And UCase(Config(0).user) UCase(user) Then s = "[" + s + "]"
 If UCase(Fenster) = "MAIN" And LCase(user) "system" Then
 If ich Then
 s = user + s
 ElseIf denke Then
 s = user + " (denkeauf)" + s + "(denkezu)"
 ElseIf lieb Then
 s = user + " (liebauf)" + s + "(liebzu)"
 ElseIf schlaf Then
 s = user + " (schlafauf)" + s + "(schlafzu)"
 ElseIf sing Then
 s = user + " (singauf)" + s + "(Singzu)"
 ElseIf schrei Then
 s = user + " (schreiauf)" + UCase(s) + "(schreizu)"
 Else
 'Normale Nachricht
 'Ausfiltern on Handlung... wenn ja dann kein Usernamen davorsetzen...
 If fw = 1 Then
 'Handlung
 ElseIf fw = 0 Then
 'Eingang / Ausgang
 s = user + " " + s
 ElseIf fw = 13 Then
 s = user + ": " + s
 Else
 s = user + ": " + s
 If Not (Gesendet) And geschlecht Then
 fw = 10
 ElseIf Not (Gesendet) And Not (geschlecht) Then
 fw = 11
 End If
 End If
 End If
 ElseIf LCase(user) "system" Then
 'Private Nachricht....
 fw = 2
 If Config(0).sleep Then
 s = "( " + Format(Now, "hh:mm:ss") + " ) " + user + ": " + s
 Else
 s = user + ": " + s
 End If
 End If
 'Zuweisung des Farbwertes....
 If Not (Getwerte(p, Config(0).user)) Then farbwert = vbWhite
 Select Case fw
 Case 0 'Ein / Ausgang
 farbwert = p!Farbeeingang
 Case 1 'Handlung
 farbwert = p!Farbehandlungen
 Case 2 'Normal
 farbwert = p!Farbenormalertext ' Private Nachrichten, Text den man selber schreibt
 Case 3 'Ich
 farbwert = p!Farbeich
 Case 4 'Schlafen
 farbwert = p!Farbeschlafen
 Case 5 'Lieb
 farbwert = p!Farbelieb
 Case 6 'Schrei
 farbwert = p!Farbeschrei
 Case 7 'Fade
 farbwert = p!Farbefade
 Case 8 'Denke
 farbwert = p!Farbedenke
 Case 9 'flüstern
 farbwert = p!Farbefluestern
 Case 10 'Jungs
 farbwert = p!Farbejungs
 Case 11 'Mädels
 farbwert = p!Farbemaedels
 Case 12 'Sing
 farbwert = p!Farbesing
 Case 13 'Standartfarbe Kapitänsnachrichten
 farbwert = p!Farbenormalertext
 End Select
schreiben:
 If Trim(s) = "" Then Exit Sub
 ReDim X(Len(s))
 For i = 1 To Len(s)
 BefehlOK = False
 Select Case Mid(s, i, 1)
 Case "["
 If Not (Fett) And InStr(i, s, "]", 1) 0 Then
 Fett = True: fettwert = 1
 End If
 Case "]"
 If Fett And Not (kw) Then
 Fett = False: fettwert = 0
 If i = Len(s) Then fettwert = 1
 End If
 Case "{"
 If Not (Kursiv) And InStr(i, s, "}", 1) 0 Then
 Kursiv = True: kursivwert = 2
 End If
 Case "}"
 If Kursiv Then
 Kursiv = False: kursivwert = 0
 If i = Len(s) Then kursivwert = 1
 End If
 Case "\_"
 If Not (underline) And InStr(i, s, "\_", 1) 0 Then
 underline = True: underlinewert = 4
 Else
 underline = False: underlinewert = 0
 If i = Len(s) Then underlinewert = 1
 End If
 Case "("
 pos = InStr(i, s, ")", 1)
 If pos 0 Then
 'es wurde ein gültiger befehl in Klammern gefunden
 If BefehlGültig(Mid(s, i + 1, pos - i - 1), smiley) Then
 i = pos
 BefehlOK = True
 End If
 End If
 'Befehl auswerten -\> Anzeige wenn kein gültiger befehl
 'Wenn gültiger befehl dann i incremedieren
 Case ":", ";", "\*", "8", "&", ")"
 pos = InListSmiley(Mid(s, i, 255), smiley)
 If pos 0 Then
 i = i + pos - 1
 BefehlOK = True
 End If
 End Select
 If Not (BefehlOK) Then
 X(i) = Mid(s, i, 1) + Str(fettwert + kursivwert + underlinewert)
 Else
 X(i) = Val(smiley) & "8" 'es handelt sich um ein Befehl - Smiley
 End If
 Next i
 c.Locked = False ' Textbox Schreibschutz entfernen
 For i = 1 To UBound(X)
 s = Mid(X(i), 1, 1)
 If (s = "[") Or (s = "]") Or (s = "{") Or (s = "}") Or (s = "\_") Then
 schreibe = False
 Else
 schreibe = True
 End If
 If Val(Right(X(i), Len(X(i)) - 1)) \> 7 Then schreibe = False
 Select Case Val(Right(X(i), Len(X(i)) - 1))
 Case 0
 If schreibe Then AddText c, s, farbwert, False, False, False
 Case 1
 If schreibe Then AddText c, s, farbwert, True, False, False
 Case 2
 If schreibe Then AddText c, s, farbwert, False, True, False
 Case 3
 If schreibe Then AddText c, s, farbwert, True, True, False
 Case 4
 If schreibe Then AddText c, s, farbwert, False, False, True
 Case 5
 If schreibe Then AddText c, s, farbwert, True, False, True
 Case 6
 If schreibe Then AddText c, s, farbwert, False, True, True
 Case 7
 If schreibe Then AddText c, s, farbwert, True, True, True
 Case Else
 If Not (schreibe) Then
 AddPicture c, Val(Left(X(i), Len(X(i)) - 1))
 End If
 End Select
 Next i
 With c
 If Len(.text) = 0 Then
 .SelStart = 0
 Else
 .SelStart = NicknamePos(user, c) - 1
 End If
 .SelLength = Len(user) + 1
 If UCase(Mid(.text, .SelStart - 19, 15)) "PRIVATNACHRICHT" Then
 If geschlecht Then
 .SelColor = &HFF0000
 Else
 .SelColor = &HC0&
 End If
 End If
 .SelStart = Len(.text)
 End With
 AddText c, vbNewLine, 0, False, False, False 'Zeilenumbruch senden
 If UCase(Fenster) "MAIN" Then
 c.Locked = True
 Set c = Hauptfenster.textbox(0)
 farbwert = p!Farbefluestern
 If Left(msg, 1) = ":" Then msg = Right(msg, Len(msg) - 1)
 If Left(msg, 1) = ";" Then msg = Right(msg, Len(msg) - 1)
 If Left(msg, 1) = "/" Then msg = Right(msg, Len(msg) - InStr(1, msg, " ", 1))
 If Config(0).sleep Then
 If Gesendet Then
 s = "( " + Format(Now, "hh:mm:ss") + " Du erzählst " + Fenster + " ) " + msg
 Else
 s = "( " + Format(Now, "hh:mm:ss") + " Privatnachricht von " + user + " ) " + msg
 End If
 Else
 If Gesendet Then
 s = "(Du erzählst " + Fenster + ") " + msg
 Else
 s = "(Privatnachricht von " + user + ") " + msg
 End If
 End If
 Fenster = "MAIN"
 GoTo schreiben
 End If
 c.Locked = True
 Hauptfenster.Text2.SetFocus
Exit Sub
fehler:
 Exit Sub
End Sub
#10

Hallo, Alex!

nunja man lernt nie aus. ich bin fast verzweifelt eh ich
darauf gekommen bin. Anstatt Gosub einfach ein Function oder
Procedure und schon hat man das problem umgegangen :smile:

*Hüstel* Die einzig „erlaubte“ Verwendung von Goto ist im
Zusammengang mit der On Error Goto-Anweisung.

Hmm, verboten ist es ganz sicherlich nicht!

Daher die " um das „erlaubt“. Dieses „verboten/erlaubt“ ist bei mir Einstellungssache. Es ist auch nicht verboten, sein Gesicht in einen laufenden Ventilator zu stecken. (Ich glaube, da war mal was bei Alf oder so:wink:

In manchen Faellen bietet es sich nach wievor an. Vielleicht
nicht Goto sondern Gosub!

Ich behaupte immer noch: nein. Ich hatte halt einen Infolehrer der alten Schule. Der hat uns wenigstens noch Programmieren beigebracht. Nicht nur das Erstellen von Programmen in einer Programmiersprache.

Auslagern in eine Function oder Procedure geht schon, Nur ist
es in manchen Faellen ein arger aufwand, wo man sich fragt ob
es sich lohnt!

Aufwand? Wo und wieso? Ich stelle fest, dass im Extremfall selbst ausgelagerte Einzeiler den Code übersichtlicher machen. Für den Entwickler vielleicht nicht, aber für seinen Nachfolger.

Alle anderen Gotos, Gosubs und Exits und sonstige „Sprünge“
zeugen von schlechtem Stil, machen den Code unübersichtlich
und fehleranfällig (siehe Topic). All diese komischen
Konstrukte lassen sich einfachst umgehen (Auslagerung in
Funktionen/Prozeduren, Abfrage mittels If/Select Case).

Ich könnt dir mal einen Ausschnitt posten, wo ich dir eine Sub
poste die ca. 200 Zeilen hat, wo es nicht anders ging, dort
kommt der Befehl gosub einmal vor. In dieser Situation laesst
sich nichts mit if, select case etc machen *zwinker*.

Lässt sich doch. Totsicher. :wink:

Ein Aufruf einer procedure / Sub würde dort den rahmen sprengen.

Ob ich schreibe „Gosub MachWas“ oder „Call MachWas“ ist doch irgendwie gleich, oder nicht?

Man tue sich einen Gefallen und verzichte auf den Schrott.

Was ist wenn es nicht anders geht?

Dann nehme man Goto. Aber man zeige mir die Stelle, an der es wirklich nicht anders geht.

Soll man zusaetzlich 10
oder gar 20 zeilen schreiben, wenn es eine tut?

Was ist das für eine Zeile, die 10 oder 20 andere Zeilen erforderlich macht?

ist dann ne Frage der Performance…

„Make it work before you make it fast.“ Oder wie die „1st rule of optimization“ sagt: „Don’t do it.“ Die „2nd rule of optimization (for professionals only)“: „Don’t do it yet.“

Und wir kommen zu einem weiteren Lieblingsspruch: Wenn Du viele Zeilen Code aus Laufzeitgründen derart optimierst, dass der Code in wenige Zeilen passt, erweitere die Kommentare, so dass die Gesamtzahl an Codezeilen konstant bleibt.

PS: 2 kleine Bsp. aus einem sehr alten Projekt von mir :smile:, wo
ich noch goto verwendet habe, aber in dem falle ging es da ich
kein Return brauchte. Die Programme laufen heute noch ,
Fehlerfrei!

Dann sei froh. Aber siehe das Problem dieses Threads: Man weiß nie genau, wie lange das gut geht.

Selbst wenn du ein Programm hast wo du ca 200 - 300 Functionen
& Sub’s hast, bist du froh ueber jede Function / Sub die du
sparen kannst, weil du so eher den Durchblick behaelst.

Diese 200 bis 300 Funktionen sind schon fast in meiner normalen Vorlage für jedes Projekt enthalten. Wenn Du das ganze sauber strukturierst, hast Du mit mehr Funktionen eher den Überblick als mit 200 Funktionalitäten versteckt in 10 Funktionen.

Ist net Bees gemeint :smile:

Das sowieso nicht. Eher eine akademische Diskussion. Und da ich irgendwann oben aufgehört habe, Smilies zu malen: Jeder mag in Gedanken Smilies setzen, wo es ihm sinnvoll erscheint.

Private Sub Picture3_Click()
On Error Resume Next
…

Da kämen wir schon mal zum Präzedenzfall: Ich sehe nicht wirklich schnell, um was es geht. Es fehlen Kommentare…

Und nur der Schnelle halber:

bearbeite:
If Config(0).sleep And Left(msg, 1) „/“ Then ’ Wenn
User schläft und nachricht im Main schreiben mag
Text2.text = „“
Text2.SetFocus
Exit Sub
End If
If UCase(Left(msg, Len("/flüstern "))) = "/FLÜSTERN " Then
…

Warum dieses Exit Sub? Kann ohne eine einzige Mehrzeile weggelassen werden (statt Exit Sub ein Else).

Zum Thema Exits:

For pos = 0 To wsckchat.count - 1
If UCase(Trim(wsckchat(pos).Tag)) =
UCase(Trim(Config(0).user)) Then
found = True
Exit For
End If
Next pos

Ich behaupte einfach, wenn ich aus einer For-Schleife mit Exit ausbrechen will, ist For nicht die geeignete Schleife. Dafür gibt’s die Dinger mit Do… Wenn ich mir das als außenstehender anschaue oder mal debuggen will, sehe ich zuerst mal For… den Rumpf zwischendrin schaue ich mir nicht an. Ich gehe davon aus, dass für alle Elemente der definierten Schleife etwas ausgeführt wird. Wenn ich ein Do…Loop sehe, weiß ich auf den ersten Blick, dass noch zusätzliche Bedingungen die Schleife im Vorfeld abbrechen lassen können.

Und irgendwie bilde ich mir ein, dass ich beim Schreiben einer Do-Schleife eher die (geistige) Kontrolle über Ein- und Ausgangsbedingungen der Schleife habe als bei einer mit Exit abgebrochenen For-Schleife.

Hier hin wirst Du, wenn ich das in aller Schnelle korrekt überflogen habe, niemals „normal“, d. h. ohne Sprungbefehl kommen:

Anzeigen:
LastKeyPress = Now 'es wurde eine taste gedrueckt, zaehlerzeit
neu setzen …

Warum dann nicht auslagern? Wenn ich wieder aus Außenstehender/Nachfolger des Entwicklers die/eine Stelle suche, an der was angezeigt wird, warum muss ich dann in „Picture3_Click“ suchen? Ich wäre zunächst alle Funktionen durchgegangen und hätte dort nach einem entsprechenden Namen mit „Anzeigen“ gesucht…

Bsp. 2
…
Hauptfenster.Text2.SetFocus
Exit Sub
fehler:
Exit Sub
End Sub

Was ist der Sinn dieser zwei Exit Subs? Eigentlich sind die überflüssig. Wenn die Codeausführung an diese Stelle kommt, passiert doch eh nix mehr.

Und Du wirst mir vielleicht Recht geben: Ist der Code irgendwie übersichtlich? Mach mal zwei Jahre nix mehr damit, und versuche dann, etwas neues einzubauen.

So, genug diskutiert. Zwei Anmerkungen noch zum Schluss: „Funktion“ habe ich aus Faulheit und der Übersicht halber oben auch als Stellvertreter für „Prozedur“ benutzt, wohl wissend, dass es Unterschiede gibt.

Außerdem sind, wie schon erwähnt, Smilies gerne zu verteilen; nix ist als Angriff auf irgendwen, weder fachlich, persönlich schon gar nicht gemeint. Man kann immer was dazu lernen, und wie das mit den Deja-Vus von Mrs Lancaster war: Wenn ich mir meinen alten Code anschaue, weiß ich: Ich darf den niemals an einen Nachfolger geben; der würde mich erschießen wollen. Das will ich ja teilweise schon…

Nichts desto trotz: Bringt mal wieder Spaß, über Grundsätzliches zu diskutieren.

Gruß, Manfred

1 Like