SprachBot

Genau das meine ich :D

Aber die Bots sind schon klasse :)

Nur der Themawechsel ist manchmal blöd ^ ^


edit:
So, ich bin jetzt ja auf php umgestiegen, und Manage das mit MySQL

*Verschiedene Tabelleni wie Smalltalk usw, ähnlich den Textdateien
*Temporäre Tabelle, die die letzten Nachrichten für kurze Zeit speichert
*Bestimmte User dürfen die Tabelle updaten -> grösserer Wortschatz,

Soweit der Plan :D

Dazu, nicht mehr zu dem C++ ding, hätte ich gerne Kommentare, Verbesserungvorschläge und Kritki - konstruktive^^
 
Zuletzt bearbeitet:
Code:
'#############################
'# Anubis - Bot              #
'# Versuchsmuster 01.0       #
'# mit Unbekannt-Speicher    #
'# © by Amun-Re  19.10.2009  #
'#############################

'Es handelt sich bei diesem Bot um ein Versuchsmuster.
'Es dient als Grundmodell zum experimentieren.
'In Verbindung mit den beigelegten txt-Dateien haben
'Sie schon ein funktionierenden Chat-Bot.
'Dieses Versuchsmuster ist Freeware.
'Das Copyright darf nicht entfernt werden !Urheberrechtsschutz!.

'Dateien öffnen
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
        "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
         ByVal lpFile As String, ByVal lpParameters As String, ByVal _
         lpDirectory As String, ByVal nShowCmd As Long) As Long
         
Option Explicit
Dim LetzterPost As String     'Letzter-User-Post Temp-Speicher
Dim LetzterBotPost As String  'Letzter-Bot-Post Temp-Speicher

'Speicher Button Unbeantwortet.txt öffnen
Private Sub Speicher_Click()
         ShellExecute hwnd, "", App.Path & "\Bot\Unbeantwortet.txt", "", App.Path, 1
         Eingabe.SetFocus
End Sub
 'Button Speichern an/aus Unbekannte Usereingaben in (Unbeantwortet.txt)
Private Sub Command1_Click()
     
         If Command1.Caption = "ein" Then
          
            Command1.Caption = "aus"
          Command1.BackColor = &HC0C0FF  'blass rot
              Timer1.Enabled = False 'Speichern aus
              Eingabe.SetFocus
         Else
             Command1.Caption = "aus"
        
            Command1.Caption = "ein"
          Command1.BackColor = &HC0FFC0 'blass grün
              Timer1.Enabled = True 'Speichern an
              Eingabe.SetFocus
       End If
End Sub
'BotOrdner Button Gesamten Bot-Ordner öffnen
Private Sub BotOrdner_Click()
        ShellExecute hwnd, "", App.Path & "\Bot\", "", App.Path, 1
        Eingabe.SetFocus
End Sub
'Info Button Bedien-info.txt öffnen
Private Sub Info_Click()
        ShellExecute hwnd, "", App.Path & "\Bot\Bedien-Info.txt", "", App.Path, 1
        Eingabe.SetFocus
End Sub
'Gedächnis Button Gedächnis.txt öffnen
Private Sub Gedächnis_Click()
        ShellExecute hwnd, "", App.Path & "\Bot\Gedächnis.txt", "", App.Path, 1
        Eingabe.SetFocus
End Sub
Private Sub Form_Load()
          'Variable beim Programmstart füllen, damit sie nicht leer ist
          LetzterBotPost = "noch leer"
End Sub
'CommandButton Senden, oder Entertaste gedrückt
Sub Senden_Click()
  Dim Antwort As String
     Antwort = BotAnubis.Ausgabe1(Eingabe.Text)
Ausgabe.Text = Ausgabe.Text & "     Du : " & Eingabe.Text & vbNewLine & "Anubis: " & Antwort & vbNewLine
  Ausgabe.SelStart = Len(Ausgabe.Text)
      Eingabe.Text = ""
  Eingabe.SetFocus

End Sub

 'Satzerkennung und die Antwortauswahl
Public Function Ausgabe1(ByVal Eingabe As String) As String

 'Text3 ist auf Visible False eingestellt, es dient nur dem Programm als Vergleich
 'und wird deshalb bei der Programmausführung auf der Form nicht angezeigt
 
  'Text3 bereinigen von Satzzeichen
   Text3 = Bereinigen(BotAnubis.Eingabe.Text)
'Usereingabe in Großbuchstaben umwandeln um sie zu vergleichen mit der Gedächnis.txt
   Text3 = UCase(Text3)
   
 'hat der User eine Leerzeile eingegeben, dann
If Text3 = "" Then
  'Zufallszeile aus der Leer.txt Datei ausgeben
   Dim leer  As String
   leer = App.Path & "\Bot\Leer.txt"
   Ausgabe1 = GetLine(leer)
        
     'User-Post-Wiederholungen feststellen
ElseIf LetzterPost = Text3 Then
      'sollte der Post der selbe sein wie zuvor, wird aus der Wiederholung.txt
      'eine Zufalls-Zeile ausgegeben
      Dim SpPath  As String
          SpPath = App.Path & "\Bot\Wiederholung.txt"
        Ausgabe1 = GetLine(SpPath)
       
     'wen sich der User nicht wiederholt gehts weiter
Else
     'User-Post in Globale-Variable speichern für den nächsten Wiederholungs-Vergleich
      LetzterPost = Text3
    
   'suchen der Usereingabe auf übereinstimmung in der Gedächnis.txt
   'in welcher Zeile steht der Suchtext (Usereingabe)
   'zuerst mal die erste Zeile der Gedächnis.txt feststellen
    Dim ZeileNr As String
    ZeileNr = ShowLine(App.Path & "\Bot\Gedächnis.txt", "|")
    
Do 'Vergleichsschleife Anfang (Gedächnis.txt)
    Dim AusgabeZeile As String
    'Text der ersten Gedächnis Zeile-Nr feststellen
    AusgabeZeile = ReadLine(App.Path & "\Bot\Gedächnis.txt", ZeileNr)
   
    'wen der String leer ist Vergleichsschleife verlassen
   If AusgabeZeile = "" Then Exit Do
   
    'Ausgabe am senkrechten Strich trennen, linker Teil gleich AusgabeZeile
     AusgabeZeile = Left(AusgabeZeile, InStr(1, AusgabeZeile, "|") - 1)
  
    'alle vorhandenen Pluszeichen gegen Platzhalter austauschen
     AusgabeZeile = Replace(AusgabeZeile, "+", "*")
    
DoEvents 'wärend der Schleifendurchläufe anderen Programmen die Möglichkeit
         'geben auf Eingaben zu reagieren um Windows nicht zu blockieren
    
         'sind in dieser Zeile die Usereingabe Worte vorhanden
         If Text3 Like AusgabeZeile Then
            Exit Do  'Vergleichsschleife verlassen
         Else  ' ansonsten
            'Zeilennummer um 1 erhöhen und Schleife erneut durchlaufen
             ZeileNr = (ZeileNr + 1)
         End If
              
'die Schleife wird verlassen wen ein Treffer stattfindet, oder die Zeile leer ist
Loop 'Vergleichsschleife Ende (Gedächnis.txt)
    
     'ist die User-Eingabe in der Gedächnis.txt vorhanden?
    If Text3.Text Like AusgabeZeile Then
      'in welcher Zeile steht der Suchtext
      Dim Gefunden1 As String
      Gefunden1 = ReadLine(App.Path & "\Bot\Gedächnis.txt", ZeileNr)
      'Der senkrechte Strich trennt die Eingabe von der Antwort
      Dim Pos As String
      Pos = InStr(Gefunden1, "|")
      'wen gefunden alles hinter dem senkrechten Strich Ausgeben
      AusgabeZeile = Mid(Gefunden1, Pos + 1)
      Ausgabe1 = AusgabeZeile
    
          'steht in dieser Zeile eine txt Datei z.B "$Gruß.txt"
        If AusgabeZeile Like "$*.txt" Then
          'Name von txt Datei feststellen
          Dim Name_txt As String
          Dim lPos As Long
          lPos = InStr(AusgabeZeile, "$")
          Name_txt = Mid(AusgabeZeile, lPos + 1)
          'Zufallszeile aus dieser txt Datei ausgeben
          Dim sPath  As String
          sPath = App.Path & "\Bot\" & Name_txt
          Ausgabe1 = GetLine(sPath)
          GoTo Ende
         End If
     'ist die Ausgabe1 leer das heißt die Gedächnis.txt enthält keine
     'Zeile, die genauso wie die User-Eingabe ist gehts weiter im Programm
     Else
 
    'Unbeantwotet.txt-Datei(Speicher)auf übereinstimmung prüfen
    'gibt es in der Datei eine Zeile mit einen sekrechten Strich
    Dim UnbekanntZeileNr As String
    UnbekanntZeileNr = ShowLine(App.Path & "\Bot\Unbeantwortet.txt", "|")
    
 Do 'Vergleichsschleife Anfang (Speicher) der Unbeantwortet.txt-Datei

  Dim StringX As String
 'Text der ersten UnbeantwortetZeileNr feststellen
  StringX = ReadLine(App.Path & "\Bot\Unbeantwortet.txt", UnbekanntZeileNr)
  
      'wen der String leer ist Vergleichsschleife verlassen
      If StringX = "" Then Exit Do
      
      'StringX am senkrechten Strich trennen, linker Teil gleich neuer StringX
      StringX = Left(StringX, InStr(1, StringX, "|") - 1)
   
  DoEvents 'wärend der Schleifendurchläufe anderen Programmen die Möglichkeit
           'geben auf Eingaben zu reagieren um Windows nicht zu blockieren
         
          'sind in der Unbeantwortet.txt schon die Usereingabe Worte vorhanden
       If Text3 Like StringX Then
          Exit Do  'Vergleichsschleife verlassen
       Else  ' ansonsten
             'Zeilennummer um 1 erhöhen und Schleife erneut durchlaufen
             UnbekanntZeileNr = (UnbekanntZeileNr + 1)
       End If
     
 Loop 'Vergleichsschleife Ende (Speicher) der Unbekannt.txt-Datei
 
    'Like filtert die Zeilen der Unbeantwortet.txt ob die Usereingabe
    'schon beantwortet ist, die Antwort steht hinter dem senkrechten Strich
     If StringX Like Text3 Then
        'in welcher Zeile steht der Suchtext
        Dim Gefunden As String
        Gefunden = ReadLine(App.Path & "\Bot\Unbeantwortet.txt", UnbekanntZeileNr)
        'Der senkrechte Strich trennt die Eingabe von der Antwort
        Dim pos1 As String
        pos1 = InStr(Gefunden, "|")
        'wen gefunden alles hinter dem senkrechten Strich Ausgeben
        Ausgabe1 = Mid(Gefunden, pos1 + 1)
        GoTo Ende
         
     Else 'wen bis jetzt keine Antwort gefunden wurde gehts weiter
    
   '########### Baustelle  Auswertung Anfang Temp-Speicher #########################
   'nach ein paar Posts befinden sich im Temp-Speicher Userantworten auf die Botpost
   'diese sind aber um eine Zeile versetzt, da der User meistens passende Antwoten
   'macht kann sie der Bot für sich verwenden, wen der User eine Eingabe macht, die
   'der Bot schon mal als Antwort ausgegeben hat. Vorrang hat aber die Gedächnis.txt
   'und dann die Unbeantwortet.txt, erst um Schluß wird der Temp-Speicher ausgewertet.
   
   'TempSpeicher.txt-Datei (Sitzungs-Speicher)auf übereinstimmung prüfen
    'gibt es in der Datei eine Zeile mit einen sekrechten Strich
    Dim TempZeileNr As String
    TempZeileNr = ShowLine(App.Path & "\Bot\TempSpeicher.txt", "|")
   
Do 'Vergleichsschleife Anfang Sitzungs-Speicher (Temp-Speicher) txt-Datei

     'beim ersten Durchlauf ist der TempSpeicher leer, es kann also kein Text
     'festgestellt werden, deshalb muß die Zeile "Text der ersten TempZeileNr
     'feststellen" übersprungen werden
     On Error Resume Next
     Dim StringTemp As String
     'Text der ersten TempZeileNr feststellen
     StringTemp = ReadLine(App.Path & "\Bot\TempSpeicher.txt", TempZeileNr)
  
     'wen der StringTemp leer ist 'Vergleichsschleife verlassen
     If StringTemp = "" Then Exit Do
  
          'Worte nur hinter dem senkrechten Strich auswerten
           Dim pos2 As String
           pos2 = InStr(StringTemp, "|")
           'wen gefunden ist das der neue StringTemp
           StringTemp = Mid(StringTemp, pos2 + 1)
           'in Kleinbuchstaben umwandel für den Vergleich
           StringTemp = LCase(StringTemp)
           
DoEvents 'wärend der Schleifendurchläufe anderen Programmen die Möglichkeit
         'geben auf Eingaben zu reagieren um Windows nicht zu blockieren
           
       'sind in dem TempString die Usereingabe Worte vorhanden
       If StringTemp Like Eingabe Then 'die Eingabe ist schon in Kleinbuchstaben vorhanden
          Exit Do  'Vergleichsschleife verlassen
       Else  ' ansonsten
             'Zeilennummer um 1 erhöhen und Schleife erneut durchlaufen
             TempZeileNr = (TempZeileNr + 1)
       End If
              
Loop 'Vergleichsschleife Ende Sitzungs-Speicher (Temp-Speicher)
   
     'Like filtert die Zeilen der Temp-Speicher.txt ob die Usereingabe
     'schon dort drin steht, die Antwort steht in der nächsten Zeile
     'eine Zeile tiefer unter der TempZeileNr deshalb TempZeileNr + 1
     If StringTemp Like Eingabe Then
       Dim Vorhanden As String
       Vorhanden = ReadLine(App.Path & "\Bot\TempSpeicher.txt", TempZeileNr + 1)
     
       'Position des senkrechten Strichs feststellen
        Dim Pos3 As Long
        Pos3 = InStr(Vorhanden, "|")
        'alles vor dem senkrechten Strich ausgeben
        Ausgabe1 = Mid(Vorhanden, 1, (Pos3 - 1))
        GoTo Ende
     '############ Baustelle Sitzungs Speicher Auswertung Ende ############
     Else
       'wen gar nichts zugetroffen hat,
       'dann wird eine Zufallszeile aus dem Unknown.txt Ordner ausgegeben
       Dim sPath1  As String
       sPath1 = App.Path & "\Bot\Unknown.txt"
       'Zufällige Zeile:
       Ausgabe1 = GetLine(sPath1)
    
Ende: 'Sprung Marke für die GoTo Anweisungen

    'der Timer1 bestimmt ob die Usereingabe in der Unbeantwortet.txt gespeichert wird
            If Timer1.Enabled = True Then
       
'Speichern der Eingabe auf die Anubis keine Antwort hat um sie manuell einzupflegen
'+++ Achtung räumen Sie die Unbeantwortet.txt Datei ständig auf +++
               Dim App1 As String, fFile As Integer
               fFile = FreeFile
               'Speicher-Datei bekannt geben
               App1 = App.Path & "\Bot\Unbeantwortet.txt"
               'Datei zum "Anhängen" von Daten öffnen
               Open App1 For Append As #fFile
               'und neue Textzeile anfügen
               Print #fFile, Text3
               Close #fFile
            End If
          
'wen die Bot-Antwort, die selbe wie bei dem vorherigen BotPost ist
              If Ausgabe1 = LetzterBotPost Then
                Dim sPath2 As String
                sPath2 = App.Path & "\Bot\BotWiederholung.txt"
     'dann eine Zufällige Zeile aus BotWiederholung, plus der Ausgabe1 ausgeben
                Ausgabe1 = GetLine(sPath2) & Ausgabe1
              End If
  
       End If
    End If
  End If
End If
  
    '############ Baustelle Sitzungs Speicher füllen ##################################
    'der TempSpeicher soll dem Bot diehnlich sein Wissen vom derzeitigen User zu
    'übernehmen beim schließen des Bot-Programms wird der TempSpeicher wieder gelöscht
    
    'Temporären Sitzungs-Speicher füllen
    Dim AppTemp As String
      fFile = FreeFile
     'Temporäre-Sitzungs-Speicher-Datei bekannt geben
     AppTemp = App.Path & "\Bot\TempSpeicher.txt"
    'Datei zum "Anhängen" von Daten öffnen
     Open AppTemp For Append As #fFile
       'und neue Textzeile anfügen
        Print #fFile, Eingabe & "|" & Ausgabe1
      Close #fFile
   '############ Baustelle Sitzungs Speicher füllen Ende ###########################
   
   'Letzten-Botpost in globale Variable speichern für den nächsten BotPostvergleich
    LetzterBotPost = Ausgabe1
     
End Function

'Zeilennummer des Suchtextes in einer Textdatei feststellen
Private Function ShowLine(ByVal xFile As String, ByVal xSuchText As String) As String
Dim fFile As Integer
Dim xBuf As String
Dim xPos As Long
Dim xZeile As String

fFile = FreeFile
    Open xFile For Binary As fFile
        xBuf = Space(LOF(fFile))
        Get fFile, 1, xBuf
    Close fFile

xPos = InStr(1, xBuf, xSuchText, vbTextCompare)
    If xPos = 0 Then
        ShowLine = xSuchText & " nicht gefunden!"
        Exit Function
    End If

xZeile = UBound(Split(Left$(xBuf, xPos), vbCr)) + 1
'Zeilennummer
ShowLine = xZeile

End Function

' Lesen einer bestimmten Zeile aus einer Textdatei
Public Function ReadLine(ByVal sFile As String, _
  Optional ByVal nLine As Long = 1) As String

  Dim sLines() As String
  Dim oFSO As Object
  Dim oFile As Object
  
  ' Fehlerbehandlung aktivieren
  On Error GoTo ErrHandler
  
  ' Verweis auf das FileSystemObject erstellen
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  
  ' Existiert die Datei überhaupt?
  If oFSO.FileExists(sFile) Then
    ' Datei öffnen
    Set oFile = oFSO.OpenTextFile(sFile)
    ' Alles lesen und in Array zerlegen
    sLines = Split(oFile.ReadAll, vbCrLf)
    ' Datei schließen
    oFile.Close
    
    Select Case Sgn(nLine)
        ' (nLine > 0)
      Case 1
        ' n-te Zeile von vorne beginnend
        ReadLine = sLines(nLine - 1)
        ' (nLine < 0)
      Case -1
        ' n-te Zeile von hinten beginnend
        ReadLine = sLines(UBound(sLines) + nLine + 1)
    End Select
  End If
  
ErrHandler:
  ' Objekte zerstören
  Set oFile = Nothing
  Set oFSO = Nothing
End Function

 'Zufallszeile aus einer Text Datei ausgeben
Private Function GetLine(ByVal FileName As String) As String
    Dim Count As Long
    Dim sRows() As String
    Dim fFile As Integer
        fFile = FreeFile
    Randomize Timer
     Count = 0
     ReDim sRows(Count)
   Open FileName For Input As #fFile
      Do While (Not (EOF(fFile)))
        Count = Count + 1
        ReDim Preserve sRows(Count)
        Line Input #fFile, sRows(Count)
      Loop
   Close #fFile
   
 'GetLine = Zufällige Zeile
  GetLine = sRows(Int(Rnd * Count))
End Function

'Text Datei bereinigen von Satzzeichen
Private Function Bereinigen(ByVal Text As String) As String
  Dim i As Long
  Const Satzzeichen As String = ",;:.!?_" 'diese Satzzeichen werden entfernt
    Text = Replace(Text, "ß", "ss")       'ß wird in doppel s umgewandelt
   For i = 1 To Len(Satzzeichen)          'den gesamten Text durchsuchen
    Text = Replace(Text, Mid$(Satzzeichen, i, 1), "") 'ersetzen mit Nichts
   Next
  Bereinigen = LCase$(Trim$(Text))  'Text vorn und hinten Leerstellen entfernen
End Function
 
'####### Baustelle ########################################
'Temporäre-Sitzungs-Speicher-Datei beim schließen "Löschen"
Private Sub Form_Unload(Cancel As Integer)

   Dim AppTemp As String, HinweisDatei As String, fFile As Integer
   fFile = FreeFile
   'Temporäre-Sitzungs-Speicher-Datei bekannt geben
   AppTemp = App.Path & "\Bot\TempSpeicher.txt"
   'Datei zum "Löschen" von Daten öffnen
   Open AppTemp For Output As #fFile
   Close #fFile
   'Text-Block Hinweis-Datei
  HinweisDatei = _
"#################################################################################" & vbNewLine & _
"# Der TempSpeicher soll dem Bot diehnlich sein Wissen vom derzeitig chattenden  #" & vbNewLine & _
"# User zu übernehmen beim schließen des Bot-Programms wird der TempSpeicher     #" & vbNewLine & _
"# wieder gelöscht. Je länger der User mit dem Bot chattet, desto mehr nimmt der #" & vbNewLine & _
"# Bot seine Worte auf und passt sich an. Nach ein paar Posts befinden sich im   #" & vbNewLine & _
"# Temp-Speicher Userantworten auf die Botpost diese sind aber um eine Zeile     #" & vbNewLine & _
"# versetzt, da der User meistens passende Antwoten macht kann sie der Bot für   #" & vbNewLine & _
"# sich verwenden, wen der User eine Eingabe macht, die der Bot schon mal als    #" & vbNewLine & _
"# Antwort ausgegeben hat. Vorrang hat aber die Gedächnis.txt und dann die       #" & vbNewLine & _
"# Unbeantwortet.txt, erst um Schluß wird der Temp-Speicher ausgewertet. Das ist #" & vbNewLine & _
"# aber noch im Versuchsstadium.                                                 #" & vbNewLine & _
"#################################################################################"
   'nach dem Löschen die Hinweis-Datei wieder einfügen
   Open AppTemp For Append As #fFile
        Print #fFile, HinweisDatei
   Close #fFile

End Sub

'#################################################################################
'Es verblüfft wie mann in VISUAL BASIC 6 mit ein paar Zeilen Code und
'txt-Dateien ein funktionierenden Chatbot erstellen kann, der auf jede
'Eingabe eine Antwort parat hat.

'Wie Intelligent Ihr damit erstellter Chatbot sein wird bestimmen Sie, und das
'ganz ohne Programmier-Kenntnisse. Dazu schauen Sie sich die Datei "Gedächnis.txt"
'genau an. Dort stehen Worte in Grossbuchstaben, und dahinter ein senkrechter
'Strich und dann die Antwort die der Bot ausgeben wird. Wen dort eine
'txt-Datei steht, wird der Bot aus dieser eine Zufallszeile ausgeben. Findet er
'keinen passenden Satz in der "Gedächnis.txt" gibt er einfach eine Zufallszeile
'aus der txt-Datei "Unknown" aus und speichert die unbekannte Eingabe.

'Mit Plusverkettungen können Sie auch ungenaue, oder einfach Worte im Satz
'erkennen lassen. z.B. WELCHE+SCHULE+GEHST+, kommen diese Worte in der
'Usereingabe vor erkennt sie der Bot. z.B. "In welche schule gehst du zur zeit."
'Achten Sie darauf das die zu erkennenden Worte in der Gedächnis.txt immer
'groß geschrieben werden, die Antworten können geschrieben sein wie sie wollen,
'aber nicht durchgehend in Großbuchstaben. Wen der Bot gar nicht antwortet haben
'Sie sich im Zeilenwust vertan.

'Beispiel: Usereingabe "Hallo" ,der Bot soll "Hallo" erkennen und eine Begrüssung
'ausgeben. Dann muß in der "Gedächnis.txt" Hallo in Grosbuchstaben geschrieben
'stehen "HALLO". Und dann ein senkrechter Strich | und dann die Antwort.
'entweder nur ein Wort z.B. "Tach" oder eine vorhandene txt-Datei z.B."$Grus.txt"
'oder ein ganzer Satz. Auf diese Art und Weise können Sie jede Eingabe erkennen
'lassen und mit guten ausgesuchten Textzeilen, die zu alles passen in der
'txt-Datei "Unknown" wird Ihr Chatbot unschlagbar. Achtung die txt-Dateien
'müssen sich im Ordner "Bot" befinden, der im selben Ordner wie Anubis-Bot ist.
'
'Die Unbeantwortet.txt ist der Speicher für Unbeantwortete Usereingaben.
'Besonderheiten des Unbekannt-Speichers
'#########################################################################
'# In dieser Datei landen alle Usereingaben auf die der Chatbot momentan #
'# keine Antwort parat hat. Sie ist zweigeteilt in schon beantwortete    #
'# Fragen oben und unbeantwortete Fragen unten. Die Leerzeile zwischen   #
'# beiden Teilen ist ganz wichtig für das funktionieren des Programms    #
'# fehlt sie muß der Chatbot die gesammte Datei abarbeiten, was bei      #
'# anschellender Größe der selben zu immer langsameren Progamm-Ablauf    #
'# führt. Dieser Speicher Unbeantworteter Usereingaben ist eigentlich    #
'# das Auffangbecken um die Gedächnis.txt zu erweitern, der obere Teil   #
'# ist nur ein zusätzliches Fjutscher, so eine Art schnelle Notlösung,   #
'# die später dann mal in die Gedächnis.txt eingepflegt werden muß.      #
'# Da dort die besseren Möglichkeiten der Erkennug stattfinden, den in   #
'# der Unbeantwortet.txt geht nur eine Antwort und die Usereingabe muß   #
'# auch noch Textgleich sein um erkannt zu werden.                       #
'#########################################################################
' +++ Achtung räumen Sie diese txt Datei ständig auf.+++
'Entweder Sie Löschen die Zeilen im unteren Bereich oder schreiben einen senkrechten
'Strich und eine intelligente Antwort dahinter, setzen Sie die Zeile dann in den
'oberen Teil der Datei, damit sie der Chatbot Anubis beim nächsten mal erkennt.
'Pflegen der Datei nicht vergessen sie bläht sich im laufe der Zeit gewaltig auf.
'
'Bei den mit Baustelle bezeichneten Stellen im Code handelt es sich um eine
'Temporäre-Sitzungs-Speicher-Datei Namens "TempSpeicher.txt". Der TempSpeicher soll
'dem Bot diehnlich sein Wissen vom derzeitig chattenden User zu übernehmen beim
'schließen des Bot-Programms wird der TempSpeicher wieder gelöscht. Je länger der
'User mit dem Bot chattet, desto mehr nimmt der Bot seine Worte auf und passt sich
'an. Das ist aber noch im Versuchsstadium.
'###############------------------------------------------------------------------
'# mfg Amun-Re #
'###############
 
Zuletzt bearbeitet von einem Moderator:
Ja oder so gehts auch:
Code:
'#############################
'# Nofi - Bot                #
'# Versuchsmuster 0.01       #
'# © by Amun-Re  7.10.2008   #
'#############################
'Es handelt sich bei diesem Bot um ein Versuchsmuster, es ist bewußt einfach gehalten
'damit es überschaubar bleibt. Es diehnt als Grundmodell zum experimentieren.
'In Verbindung mit den beigelegten txt-Dateien haben Sie schon ein funktionierendes
'Bot. Dieses Versuchsmuster ist Freeware, das Copyright " © by Amun-Re" darf nicht
'entfernt werden. !Urheberrechtsschutz!

'Auf der Form sind 4 Textboxen, 1 Label und 1 Button das sieht dann so aus:

'+++++++++++++++++++++++++++++++++++++++++++++++++
'++++       Text 3              ++ © by Amun-Re ++ Textbox 3 Eigenschaft Visible = False
'+++++++++++++++++++++++++++++++++++++++++++++++++ Copyright = Label1
'++++                                       ++++++
'++++                                       ++++++
'++++                                       ++++++
'++++       Ausgabe                         ++++++ Textbox Ausgabe Eigenschaft:
'++++                                       ++++++                 MultiLine = True
'++++                                       ++++++                 ScrollBars = 2-Vertikal
'++++                                +Text4 ++++++ Textbox 4 Eigenschaft Visible = False
'+++++++++++++++++++++++++++++++++++++++++++++++++
'++++      Eingabe                  +++ Senden +++  Senden = CommandButton
'+++++++++++++++++++++++++++++++++++++++++++++++++  Textbox Eingabe Eigenschaft:
                                                                   'MultiLine = True
Option Explicit

'CommandButton Senden
Sub Senden_Click()
 Dim Antwort As String
     Antwort = BotNofi.Ausgabe1(Eingabe.Text)
Ausgabe.Text = Ausgabe.Text & " Du : " & Eingabe.Text & vbNewLine & "Nofi : " & Antwort & vbNewLine
Ausgabe.SelStart = Len(Ausgabe.Text)
    Eingabe.Text = ""
    Eingabe.SetFocus

End Sub

'Satzerkennung und die Antwortauswahl aus der Fragen1.txt
Public Function Ausgabe1(ByVal Eingabe As String) As String

 'Usereingabe in Großbuchstaben umwandeln um sie zu vergleichen mit der Fragen1.txt
  BotNofi.Text3 = UCase(BotNofi.Eingabe.Text) 'Text3 ist auf Visible False eingestellt
                        'und wird deshalb bei der Programmausführung nicht angezeigt
                            
  'Ist Entertaste bzw. Senden gedrückt dann auswerten
   Dim KeyAscii As Integer
If KeyAscii <> 13 Then
   
   'Text3 auf Eingabe von Leerzeilen prüfen
   If Text3 = "" Then
          'Zufallszeile aus der Leer.txt Datei ausgeben
          Dim leer  As String
          leer = App.Path & "\Bot\Leer.txt"
      Ausgabe1 = GetLine(leer)
      
  'Text3 auf NameInfo, Datum, UhrZeit, Ester Egg und Rechenaufgabe prüfen
   ElseIf Text3 Like "WIE IST DEIN NAME" Or Text3 Like "INFO" Or Text3 Like "WIE HEIßT DU" Then
      Ausgabe1 = "Mein Name ist Nofi. Meine KI stammt von Amun-Re."
   
   ElseIf Text3 Like "WELCHES DATUM IST HEUTE" Or Text3 Like "WELCHES DATUM HABEN WIR" Then
      Ausgabe1 = "Heute ist " & WeekdayName(Weekday(Date)) & " der " & Date & "."
  
   ElseIf Text3 Like "WIE SPÄT IST ES" Or Text3 Like "SAG DIE UHRZEIT" Then
      Ausgabe1 = "Es ist jetzt " & TimeValue(Time) & "."
     
    'Ester Egg (engl. für „Osterei“)
    ElseIf Text3 Like "**" Or Text3 Like "* PO" Or Text3 Like "*POPO" Or Text3 Like "*NACKIG*" Then
      Popo.Show 'die zweite Form wird angezeigt die Form heißt "Popo"
      Ausgabe1 = "Meinst du sowas?"
      
    'falls sich Zahlen im Text befinden auf Rechenaufgabe prüfen
    ElseIf Text3 Like "*0*" Or Text3 Like "*1*" Or Text3 Like "*2*" Or Text3 Like "*3*" Or Text3 Like "*4*" _
    Or Text3 Like "*5*" Or Text3 Like "*6*" Or Text3 Like "*7*" Or Text3 Like "*8*" Or Text3 Like "*9*" Then
    
       'sind Berechnungsoperatoten im Text
       If Text3 Like "*+*" Or Text3 Like "*-*" Or Text3 Like "*/*" Or Text3 Like "*" _
       Or Text3 Like "*^*" Or Text3 Like "*(*" Or Text3 Like "*)*" Then

       'Index für Function "ZahlWort bestimmen, die Leerzeichen im Text werden gezählt
       'hinter jeden Wort muß ja ein Leerzeichen stehen im Text z.B.: wieviel ist 1+1
        Dim Index1() As String, Index As String 'oder: berechne mal die Aufgabe 1+1
        
        Index1 = Split(Text3.Text, " ", , vbTextCompare) 'Leerzeichen als Trennzeichen
        
        'Index = Anzahl der Worte im Text vor der Rechenaufgabe
        'wen vor der Rechenaufgabe kein Text steht, ist der Index = 0
         Index = UBound(Index1())
     
      'die Function "ZahlWort" bestimmt die Rechenaufgabe im Text und übergibt sie
      'an die Function "Lösen", das funktioniert aber nur wen hinter der Rechenaufgabe
      'kein Text und kein Leerzeichen mehr steht, was ja meistens der Fall sein wird
      
       Lösen ZahlWort(Text3, (Index))
       
      'das Rechen-Ergebnis = Text4
       Ausgabe1 = "Das macht " & Text4 'Text4 ist auf Visible False gestellt
                                       'und wird bei der Programmausführung
       End If                          'auf der Form nicht angezeigt
   '---------------------------------------------------------------------------------
       'Fragen1.txt einlesen
      Dim FNr As Integer, fName As String, fInhalt As String
        fName = App.Path & "\Bot\Fragen1.txt"
          FNr = FreeFile
      fInhalt = Space(FileLen(fName))
      Open fName For Binary As FNr
        Get FNr, , fInhalt
      Close FNr
  
   Else
  'suchen der Usereingabe auf Übereinstimmung in Fragen1.txt
  'in welcher Zeile steht der Suchtext
    Dim Zeile_Nr As String, AusgabeZeile As String, TextZeile As String
    
  'Zeile_Nr = Zeilennummer
   Zeile_Nr = ShowLine(App.Path & "\Bot\Fragen1.txt", BotNofi.Text3)
   
   On Error Resume Next 'nicht entfernen sonst Crasht es !
   
  'TextZeile = der Text der gefunden wurde, wen nicht greift die Error-Routine
   TextZeile = ReadLine(App.Path & "\Bot\Fragen1.txt", (Zeile_Nr))
   
  If Text3 = TextZeile Then 'ist der User-Eingabetext = dem gefundenen Text
  
     'wen gefunden dann nächste drauf folgende Zeile ausgeben
     AusgabeZeile = ReadLine(App.Path & "\Bot\Fragen1.txt", (Zeile_Nr + 1))
  
     Ausgabe1 = AusgabeZeile ' das heißt wen der User-Eingabetext in der Fragen1.txt
     'genau so in Großbuchstaben in irgend einer Zeile steht wird die Nächste darauf
     'folgende Zeile ausgegeben und das Programm endet hier. Leider ist es meistens
     'nicht so und deshalb geht es jetzt erst richtig los.

     'steht in dieser Zeile ein txt Ordner z.B "$Gruß.txt"
     'wobei das "$" Zeichen dem Programm als Erkennung diehnt
     'die zu erkennende Datei heißt also in diesen Fall "Gruß.txt"
        If Ausgabe1 Like "$*" Then
    
    'Name vom txt Ordner feststellen
     Dim Name_txt As String, lPos As Long
     
    'das "$" ist auch gleichzeitig die Positionsmarke um den Namen auszuschneiden
         lPos = InStr(Ausgabe1, "$")
     Name_txt = Mid(Ausgabe1, lPos + 1)
 
    'Zufallszeile aus dem txt Ordner ausgeben
     Dim sPath  As String
        sPath = App.Path & "\Bot\" & Name_txt
     Ausgabe1 = GetLine(sPath)
  
        End If
'------------------------------------------------------------------------------------
  Else
  'Haben Sie sich mal gefragt was passiert wen der Eingabesatz nicht genau so in der
  'Fragen1.txt steht. Für diesen Fall sind in der Fragen1.txt Plusverkettungen
  'vorgesehen. z.B. WIE+DEIN+INTELLIGENZ+QUOTIENT, somit können auch Sätze die diese
  'Worte enthalten nachfolgend erkannt werden. UserEingabe "Wie ist dein beschissener
  'Intelligenz Quotient" enthält die mit + verketteten Worte und wird somit erkannt.
  'Achtung die PlusverkettungsZeilen immer am Schluß der Fragen1.txt setzen.
  
     Dim ZeileNr As String, Zeile0 As String
     
  'auf + Zeichen den Fragen1.txt Ordner prüfen
  'erste Zeilennummer feststellen wo steht ein  Pluszeichen in der Fragen1.txt
     ZeileNr = ShowLine(App.Path & "\Bot\Fragen1.txt", "+")
   
    On Error Resume Next 'nur für den Fall der Fälle, man weiß ja nie.
    
  'Zeilen in den ein + Zeichen enthalten ist vergleichen mit UserEingabe Text3
Do 'Begin der StringArrayvergleichs-Schleife

  'Zeile0 = Text der gefundenen PlusverkettungsZeile
   Zeile0 = ReadLine(App.Path & "\Bot\Fragen1.txt", (ZeileNr))
    
'Prüfen ob der Inhalt der PlusverkettungsZeile in der UserEingabe Text3 enthalten ist
     Dim sArray() As String, sArray1() As String
     
  'PlusverkettungsZeile0 und Text3 in StringArray einlesen
  sArray = Split(Zeile0, "+", , vbTextCompare)      ' Pluszeichen als Trennzeichen
  sArray1 = Split(Text3.Text, " ", , vbTextCompare) ' Leerzeichen als Trennzeichen
  
  'StringArrayvergleich
     Dim i1 As Long, i2 As Long, x As Long
     
    For i2 = LBound(sArray) To UBound(sArray)
        For i1 = LBound(sArray1) To UBound(sArray1)
            If (sArray(i2) = sArray1(i1)) Then
                    'Schleifendurchläufe zählen
                        x = x + 1
            End If
         Next i1
     Next i2
           If i2 <> x Then             'ist sArray nicht in sArray1 enthalten
              ZeileNr = (ZeileNr + 2)  'Zeilennummer um die Zahl 2 erhöhen
                    x = 0              'Zählschleifen auf Null setzen
                    
DoEvents 'Programmausführung kurz stoppen damit andere Programme auch zum Zug kommen
  On Error Resume Next 'nur für den Fall der Fälle
 
        Do 'Innere Schleife prüft ob die um die Zahl 2 erhöhte Zeile überhaupt
           'ein Pluszeichen enthält, da der StringArrayvergleich Zeitaufwändig ist.
             Dim Zeile2 As String
             Zeile2 = ReadLine(App.Path & "\Bot\Fragen1.txt", (ZeileNr))
        
          If Zeile2 Like "*+*" Then     'ist ein Pluszeichen vorhanden
               Exit Do                  'Innere Schleife verlassen
               Else                     'ansonsten die Zeilennummer um zwei erhöhen
               ZeileNr = (ZeileNr + 2)  'und Innereschleife nochmal durchlaufen
              
              If Zeile2 Like "|Ende|" Then 'ist das Ende der Fragen1.txt erreicht
               Exit Do                     'Innere Schleife verlassen
              End If
          End If
    'das läuft solange bis eine Pluszeichenkette gefunden wird, oder die
    'Fragen1.txt am |Ende| ist deshalb Plusverkettungen nie am Anfang setzen.
           
        Loop 'gehört zur Inneren Schleife

            End If 'gehört zu ist sArray nicht in sArray1 enthalten
           
              If Zeile2 Like "|Ende|" Then 'ist das Ende der Fragen1.txt erreicht
                Exit Do                 'StringArrayvergleichs-Schleife verlassen
              End If
                 If i2 = x Then   'ist sArray in sArray1 enthalten dann
                   Exit Do        'StringArrayvergleichs-Schleife verlassen
                 End If
             
Loop 'gehört zur StringArrayvergleichs-Schleife
           
                  If i2 = x Then   'ist sArray in sArray1 enthalten dann
           
'ist Pluszeichenkette in Text3 enthalten, dann nächste drauf folgende Zeile ausgeben
     Ausgabe1 = ReadLine(App.Path & "\Bot\Fragen1.txt", (ZeileNr + 1))
     
    'steht in dieser Zeile ein txt Ordner z.B "$Gruß.txt"
       If Ausgabe1 Like "$*" Then
    
    'Name von txt Ordner feststellen
     Dim Name_tx As String, lPoss As Long
     
         lPoss = InStr(Ausgabe1, "$")
       Name_tx = Mid(Ausgabe1, lPoss + 1)

    'Zufallszeile aus dem txt Ordner ausgeben
     Dim sPat  As String
     sPat = App.Path & "\Bot\" & Name_tx
     Ausgabe1 = GetLine(sPat)
    
                  End If
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 'Was machen wen gar nichts gefunden wird? ja dafür gibt es die Unkonown.txt Datei
 'und da schreiben wir Zeilen rein die unverfänglich sind und deshalb zu jeden Post
 'passen. Also wen Nichts gefunden dann:
 
  Else
 'Zufallszeile aus der Unknown.txt Datei ausgeben
     Dim sPath1  As String
         sPath1 = App.Path & "\Bot\Unknown.txt"
       Ausgabe1 = GetLine(sPath1)
        End If
       End If
  End If
End If
End Function

'MS-Script löst die Rechenaufgabe
Private Function Lösen(Aufgabe As String) As Double
        Dim ScriptCtrl As Object
        ' Verweis auf das MSScriptControl erstellen
        Set ScriptCtrl = CreateObject("MSScriptControl.scriptcontrol")
        'welche Scriptsprache soll verwendet werden
        ScriptCtrl.Language = "VBScript"
        'ausrechnen der Aufgabe
                 Lösen = CDbl(ScriptCtrl.Eval(Aufgabe))
        'Objekt zerstören
        Set ScriptCtrl = Nothing
                 Text4 = Lösen
End Function

 'Rechenaufgabe im Text feststellen
Public Function ZahlWort(ByVal Text As String, ByVal Index As Long) As String
     Dim i As Long
     Dim Wortzähler As Long
  
   For i = 1 To Len(Text)
      If Mid$(Text, i, 1) = " " Then
        If Mid$(Text, i + 1, 1) <> """" Then Wortzähler = Wortzähler + 1

      ElseIf Mid$(Text, i, 1) = """" Then
        If i > 1 Then Wortzähler = Wortzähler + 1
      
      Else
        If Wortzähler = Index Then ZahlWort = ZahlWort & Mid$(Text, i, 1)
      End If

   Next i
End Function

 'Zufallszeile aus einer Text Datei ausgeben
Private Function GetLine(ByVal FileName As String) As String
    Dim Count As Long
    Dim sRows() As String
    Dim FNr As Integer
        FNr = FreeFile
    Randomize Timer
     Count = 0
     ReDim sRows(Count)
   Open FileName For Input As #FNr
      Do While (Not (EOF(FNr)))
        Count = Count + 1
        ReDim Preserve sRows(Count)
        Line Input #FNr, sRows(Count)
      Loop
   Close #FNr
   
 'GetLine = Zufällige Zeile
  GetLine = sRows(Int(Rnd * Count))
End Function

'Zeilennummer des Suchtextes in einer Textdatei feststellen
Private Function ShowLine(ByVal xFile As String, ByVal xSuchText As String) As String
    Dim FNr As Integer
    Dim xBuf As String
    Dim xPos As Long

  FNr = FreeFile
      Open xFile For Binary As FNr
          xBuf = Space(LOF(FNr))
          Get FNr, 1, xBuf
      Close FNr

  xPos = InStr(1, xBuf, xSuchText, vbTextCompare)
   On Error Resume Next
  'ShowLine = Suchtext-Zeilen-Nummer
   ShowLine = UBound(Split(Left$(xBuf, xPos), vbCr)) + 1
 
End Function

 'Bestimmte Zeile aus einer Textdatei auslesen
Public Function ReadLine(ByVal sFile As String, _
  ByVal nLine As Long) As String
 
  Dim sLines() As String
  Dim oFSO As Object
  Dim oFile As Object
 
  'Verweis auf das FileSystemObject erstellen
  Set oFSO = CreateObject("Scripting.FileSystemObject")
 
  If oFSO.FileExists(sFile) Then 'ist die Datei existent?
 
    Set oFile = oFSO.OpenTextFile(sFile)  'öffnen
    sLines = Split(oFile.ReadAll, vbCrLf) 'splitten
    oFile.Close                           'schließen
 
    ReadLine = sLines(nLine - 1)
  End If
End Function

'#########################################################################################
'Es verblüfft wie man in VISUAL BASIC 6 mit ein paar Zeilen Code und txt-Dateien ein
'funktionierenden Chatbot erstellen kann, der auf jede Eingabe eine Antwort parat hat.
'
'Wie Intelligend Ihr damit erstellter Chatbot sein wird bestimmen Sie, und das ganz ohne
'Programmier-Kenntnisse. Dazu schauen Sie sich die txt-Datei "Fragen1.txt" genau an.
'Dort stehen Sätze in Grossbuchstaben, und in der nächsten darauf folgenden Zeile steht
'die Antwort die der Bot ausgeben wird.
'
'Beispiel: Usereingabe "Hallo" ,der Bot soll "Hallo" erkennen und eine Begrüssung ausgeben.
'Dann muß in der "Fragen1.txt" Hallo in Grosbuchstaben geschrieben stehen "HALLO".
'Und in der darauf folgenden Zeile muss die Antwort stehen, entweder ein Wort oder Satz
'z.B."Tach" oder eine vorhandene txt-Datei z.B. "$Grus.txt", aus der wird dann eine
'Zufallszeile ausgegeben. Wen der Eingabesatz nicht genau so in der Fragen1.txt steht.
'Für diesen Fall sind Plusverkettungen vorgesehen.
'z.B. WIE+DEIN+INTELLIGENZ+QUOTIENT, somit können auch Sätze die diese Worte enthalten
'erkannt werden. Auf diese Art und Weise können Sie jede Eingabe erkennen lassen und
'mit guten ausgesuchten Textzeilen, die zu alles passen in der txt-Datei "Unknown" wird
'Ihr Chatbot unschlagbar. Achtung die txt-Dateien "Fragen1.txt", "Unknown.txt", "Gruß.txt",
'Bay.txt", usw. also alle txt-Dateien die erkannt werden sollen müssen sich im Ordner
'"Bot" befinden, der im selben Ordner ist wie das Programm Nofi-Bot.
'
'Das Ende der Fragen1.txt muß immer Markiert werden, deshalb Letzte Zeile: |Ende|
'
'Der Bot kann auch rechnen, entweder geben Sie die Rechenaufgabe direkt ein oder mit
'vorran gestellten Text z.B.: 2+4 oder: Bitte rechne mal 10/2 oder: was macht 3-1 oder:
'wieviel ist 24*2. Es darf aber hinter der Rechenaufgabe kein Text oder Leerzeichen stehen.
'
'Hier mal ein Paar Beispielzeilen: was der Bot noch drauf hat.
'
'  Du : wie heißt du
'Nofi : Mein Name ist Nofi. Meine KI stammt von Amun-Re.
'  Du : wie spät ist es
'Nofi : Es ist jetzt 18:54:00.
'  Du : welches datum ist heute
'Nofi : Heute ist Montag der 26.10.2008.
'  Du : berechne mir mal folgende Aufgabe (((2*4)^2)-(3+4))/2
'Nofi : Das macht 28,5
'                                                                mfg Amun-Re
'#########################################################################################
 
Zuletzt bearbeitet von einem Moderator:

Neue Beiträge

Zurück