Zu den Aufzeichnungen der tutorials.de-Live-Workshops
ERLEDIGT
NEIN
ANTWORTEN
12
ZUGRIFFE
1648
EMPFEHLEN
  • An Twitter übertragen
  • An Facebook übertragen
AUF DIESES THEMA
ANTWORTEN
  1. #1
    Acriss Acriss ist offline Mitglied Platin
    Registriert seit
    Jun 2007
    Ort
    Lingen (Niedersachsen, zZ in Istanbul)
    Beiträge
    685
    Hihi,

    ich habe mir jetzt mal einen richtig schweren Brocken vorgenommen

    Ich möchte ein Programm schreiben, mit dem man sich quasi unterhalten kann.

    Natürlich gibt es jede Menge Hürden, die ich gerne mit euch besprechen möchte


    Programmieren möchte ich das ganze in C++.

    Hürden:
    1. Der PC muss verstehen
    2. Der Bot muss antworten
    3. Wortschatz ist zu klein

    Ideen:
    Ich möchte Textdateien anlegen,
    die in etwa so aufgebaut sind:

    Name: Begrüssung.txt
    Enthält alle Begrüssungen.
    Zeile 1: Hallo
    Zeile 2: Guten Tag
    usw...

    Name: Hobbies.txt
    Enthält Hobbies
    Zeile 1: Fussball | true | Was sind deine Hobbies?| Was machst du so? | Was machst du in der Freizeit
    Erklärung: Der erste Begriff stellt das Hobby dar, der zweite, das der Bot Fussball spielt. Die anderen stehen für Fragen, auf dem mit dem Begriff geantwortet werden kann.
    Zeile 2: Klavierspielen | true | Spielst du ein Instrument? | Was sind deine Hobbys | Was machst du so| Machst du Musik?

    usw....


    So stelle ich mir das in etwa vor.

    Weiteres Problem wäre dann, das der Wortschatz viel zu gering ist.

    Deswegen habe ich vor, einen Lernmodus zu integrieren.
    bei Tastendruck, werden alle Textdateien angezeigt, und man waehlt dann eine Datei, die dazu passt, oder legt ggf eine neue an.
    Der Eintrag sieht dann wie folgt aus:
    Beispiel: Schachspielen soll hinzugefügt werden.
    Eingabe:
    Schachspielen | false | Spielst du Schach?
    Natürlich muss das immer weiter ausgearbeitet werden, damit der Bot eigenständig Sätze bilden kann.

    Dazu müsste man zu den *.txt Dateien eigentlich noch Subjekt/Prädikat/Objekt usw dazu schreiben, und andere Struckturen.

    Manch einer mag jetzt lachen, oder mich für bescheuert/blöd erklären, aber ich finde das ganze interessant, auch wenn es sicher viel Zeit in Anspruch nimmt.

    Eure Meinung, Ideen, konstruktive Kritik usw würde mich interessieren
     

  2. #2
    Registriert seit
    Jul 2001
    Ort
    Bayern
    Beiträge
    969
    Direkt helfen kann ich dir nicht, aber vielleicht Stichworte geben: http://www.google.com/search?hl=de&c...hatbot&spell=1
     

  3. #3
    Avatar von chmee
    chmee chmee ist offline mod | media
    tutorials.de Moderator
    Registriert seit
    Apr 2004
    Ort
    Berlin bei Potsdam
    Beiträge
    7.528
    Blog-Einträge
    4
    Nimm Dir als Verständnisbasis vielleicht Eliza. Quasi der bestandene Turingtest . Ich habe Letztens für eine Slotcar-Anlage (Carrera) eine Sprachausgabe geschrieben, die soweit recht einfach war, weil sie nur etwa 5 Begriffe und die Zahlen kannte. Zusätzlich waren die Zahlen noch im Abklang (Satzende) als Samples da.

    Wenn Interesse, stelle ich von dem Teil noch was rein..
    mfg chmee
     
    Mein Blog - VideoFAQ - FotoFAQ - bei Flickr - DSLR Kleinanzeigen
    Benutzt den DANKE-Knopf oder bewertet den Beitrag

    "GEHT NICHT" HILFT NICHT, TESTET EURE CODES ONLINE UND GEBT KLARE INFOS!
    -> Regexp <- -> php <- -> Javascript <-

  4. #4
    Acriss Acriss ist offline Mitglied Platin
    Registriert seit
    Jun 2007
    Ort
    Lingen (Niedersachsen, zZ in Istanbul)
    Beiträge
    685
    Vllt sollte ich das ganze anders Formulieren, sry

    Es geht dann mehr in Rİchtung "Chatbot", also nicht sprecen sondern schreiben
     

  5. #5
    Acriss Acriss ist offline Mitglied Platin
    Registriert seit
    Jun 2007
    Ort
    Lingen (Niedersachsen, zZ in Istanbul)
    Beiträge
    685
    Zitat Zitat von Wolfsbein Beitrag anzeigen
    Direkt helfen kann ich dir nicht, aber vielleicht Stichworte geben: http://www.google.com/search?hl=de&c...hatbot&spell=1
    Danke das hat mir schon sehr viel weiter geholfen,

    womit ich zu meiner nächsten Frage komme

    Würdet ihr eher eine Datenbank nehmen, oder txt bzw andere Dateien.

    Sollte ich das ganze dann überhaupt noch in C++ schreiben?
     

  6. #6
    Avatar von Flex
    Flex Flex ist offline (aka Felix Jacobi)
    tutorials.de Moderator
    Registriert seit
    Nov 2001
    Ort
    Wuppertal
    Beiträge
    5.295
    Blog-Einträge
    65
    Datenbank (Geschwindigkeit).

    Die Frage ist natürlich, wen willst du mit diesem Programm erreichen?
    Leute die das mal eben so zum Spaß ausprobieren wollen, werden selten mal eben schnell eine .exe Datei herunterladen oder gar eine Software ausprobieren. Da würde sich eine Sprache anbieten, die in Webseiten integriert werden kann (mit C/C++ kann natürlich auch eine Webseite dynamisch erstellt werden).
    Ich würde auf PHP/ASP.NET/Java tippen. Bequemsten Möglichkeiten.
     
    KIDS Kinderbetreuungsdienst
    Xing

    "When you play the game of thrones, you win or you die. There is no middle ground."
    by Cersei Lannister in "A Game Of Thrones"

  7. #7
    Acriss Acriss ist offline Mitglied Platin
    Registriert seit
    Jun 2007
    Ort
    Lingen (Niedersachsen, zZ in Istanbul)
    Beiträge
    685
    Java will ich erst noch anfangn zu lernen, ASP.NET hab ich null Plan von.

    Werd wohl php nehmen

    Was sagt ihr zu den Ideen?
     

  8. #8
    Avatar von chmee
    chmee chmee ist offline mod | media
    tutorials.de Moderator
    Registriert seit
    Apr 2004
    Ort
    Berlin bei Potsdam
    Beiträge
    7.528
    Blog-Einträge
    4
    Gib mal in eliza bot irc ein..

    zB http://www.abenteuermedien.de/jabberwock/faq_de.html

    mfg chmee
    Geändert von chmee (01.11.07 um 10:44 Uhr)
     
    Mein Blog - VideoFAQ - FotoFAQ - bei Flickr - DSLR Kleinanzeigen
    Benutzt den DANKE-Knopf oder bewertet den Beitrag

    "GEHT NICHT" HILFT NICHT, TESTET EURE CODES ONLINE UND GEBT KLARE INFOS!
    -> Regexp <- -> php <- -> Javascript <-

  9. #9
    Acriss Acriss ist offline Mitglied Platin
    Registriert seit
    Jun 2007
    Ort
    Lingen (Niedersachsen, zZ in Istanbul)
    Beiträge
    685
    War ich schon,
    ich habe ne Website gefunden - adresse weiss ich nicht mehr - da waren 4 oder 5 Botadressen, auch ausprobiert


    Aber zum Aufbau hat jetzt immer noch keiner was gesagt
     

  10. #10
    Avatar von chmee
    chmee chmee ist offline mod | media
    tutorials.de Moderator
    Registriert seit
    Apr 2004
    Ort
    Berlin bei Potsdam
    Beiträge
    7.528
    Blog-Einträge
    4
    Ich kann mich erinnern, dass ich völlig fasziniert an einem Eliza-Programm vor dem C64 saß, es war in Basic.

    Auf http://en.wikipedia.org/wiki/ELIZA hast Du unten in den Implementations so einige Source-Links.
    Hilft Dir das weiter oder wartest Du eher auf Meinungen zu Deinen Ideen ?

    mfg chmee

    Nebenbei, einen Link zu einer kaputten Seite zu setzen ist kein gutes Zeichen
    Geändert von chmee (01.11.07 um 10:52 Uhr)
     
    Mein Blog - VideoFAQ - FotoFAQ - bei Flickr - DSLR Kleinanzeigen
    Benutzt den DANKE-Knopf oder bewertet den Beitrag

    "GEHT NICHT" HILFT NICHT, TESTET EURE CODES ONLINE UND GEBT KLARE INFOS!
    -> Regexp <- -> php <- -> Javascript <-

  11. #11
    Acriss Acriss ist offline Mitglied Platin
    Registriert seit
    Jun 2007
    Ort
    Lingen (Niedersachsen, zZ in Istanbul)
    Beiträge
    685
    Genau das meine ich

    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

    Dazu, nicht mehr zu dem C++ ding, hätte ich gerne Kommentare, Verbesserungvorschläge und Kritki - konstruktive
    Geändert von Acriss (01.11.07 um 11:08 Uhr)
     

  12. #12
    Amun-Re Tutorials.de Gastzugang
    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
    419
    420
    421
    422
    423
    424
    425
    426
    427
    428
    429
    430
    431
    432
    433
    434
    435
    436
    437
    438
    439
    440
    441
    442
    443
    444
    445
    446
    447
    448
    449
    450
    451
    452
    453
    454
    455
    456
    457
    458
    459
    460
    461
    462
    463
    464
    465
    466
    467
    468
    469
    470
    471
    472
    473
    474
    475
    476
    477
    478
    479
    480
    481
    482
    483
    484
    485
    486
    487
    488
    489
    490
    491
    492
    493
    494
    495
    496
    497
    498
    499
    500
    501
    502
    503
    504
    505
    506
    507
    508
    509
    510
    511
    512
    513
    514
    515
    516
    517
    518
    519
    520
    521
    522
    523
    524
    525
    526
    527
    528
    
    '#############################
    '# 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 #
    '###############
    Geändert von chmee (20.05.10 um 19:19 Uhr) Grund: code code
     

  13. #13
    Amun-Ra Tutorials.de Gastzugang
    Ja oder so gehts auch:
    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    
    '#############################
    '# 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
    '#########################################################################################
    Geändert von chmee (20.05.10 um 19:20 Uhr) Grund: code code