AnGelBot-Portal²

AnGelBot-Portal² > Scripting > Anfragen > UniversalTicker: Your one and only Newsticker Script ;)
Normale Version: UniversalTicker: Your one and only Newsticker Script ;)
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Seiten: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

Sp33d

16.10.2004, 10:52 Uhr
!!DIESES SCRIPT IST IM BETA-STADIUM!!

Da ja viele Leute einen Newsticker für ihren Bot haben wollen und das für ständig verschiedene Seiten, manchmal Seiten von denen niemand anders die News interessieren würde (also die Scripts nur für eine Person von Nutzen sind), release ich mal meinen UniversalTicker.
Mit diesem Ticker könnt ihr ratz-fatz euren eigenen Newsticker erstellen ohne irgendnen Check vom Scripten haben zu müssen.
Als Vorbild galt ein Script für mIRC, mTicker oder so das mir ein User vor Ewigkeiten mal geschickt hatte.

Die Konfiguration ist leider etwas schwer, dies ist noch eine Betaversion und bei vielen Tickern die über dieses Script laufen kann es gut sein das der Bot sich mal schnell verabschiedet. Demnach vll. nur auf lokalen Bots laufen lassen wo man ihn schnell wieder restarten kann und nicht bei professionellen AnGel-Hostern.

Also ein paar Infos zur Konfiguration:
Es gibt einen neuen Befehl auf der Partyline mit dem ihr einzelne Ticker und globale Einstellungen ändern könnt: .UTICKER [<config>]

Wenn ihr den Parameter config weglasst, dann kommt ihr ins Hauptmenü. Hier könnt ihr ein paar globale Einstellungen vornehmen sowie die Ticker einstellen die aktiv seien sollen. Bei der Einstellung Nr. 6 ist darauf zu achten, dass immer alle Ticker angegeben werden müssen wenn ihr einen Ticker hinzufügen wollt.

Nun aber zur Konfiguration eines neuen Newstickers.
Hier eine Step-By-Step Anleitung für einen Newsticker für den Stern:
Wir erstellen erstmal die Config mittels ".uticker stern".
Bei Name geben wir "Stern" ein (Befehl: 1 Stern). Dieser wird dann nachher im Channel angezeigt, damit man weiß woher die News kommt.
Bei "Display URL" geben wir "www.stern.de" ein (Befehl: 2 http://www.stern.de).
Diese URL wird angezeigt damit Leute sich z.B. weitere Informationen zu einer News von der Seite holen können.
Nun die wichtigste Einstellung: Bei "Address" stellen wir "http://www.stern.de/alle_artikel.html" ein (Befehl: 3 http://www.stern.de/alle_artikel.html). Diese Seite wird abgerufen und auf dieser müssen sich auch die News befinden.

Bei der Einstellung "Seach For" gibt es nun zwei Möglichkeiten. Entweder man gibt den Bereich um die News an und ersetzt den Teil der News durch ein *, z.B. "<title>*</title>", dann wird nach <title> gesucht und der komplette Teil bis </title> als News erkannt. Ggf. vorhandene HTML Tags oder Zeilenumbrüche werden entfernt und HTML Codes konvertiert. Nun gibt es aber leider Seiten wo die News wo der schließende Tag in der nächsten Zeile steht oder so, deshalb geht auch eine Einstellung "<title>". Hierbei wird "<title>" gesucht und der Text bis zum Zeilenende als News erkannt.

Die Seite des Sterns die ich ausgewählt habe macht das Erkennen der News einfach. Die Einstellung für "Seach For" muss "&nv=hp_aa">*</a>" lauten. Wie man darauf kommt? Ihr geht auf die entsprechende Seite der News und schaut euch den HTML Quelltext an. Nun sucht ihr nach euer News und schaut euch den HTMl Code vorher und nachher an. Nun müsst ihr eine bis dahin einzigartige Zeichenfolge finden. In meinem Beispiel kommt ""&nv=hp_aa">" bis zur News im Quelltext noch nicht vor, und hinter dem * reicht ein einfach kleiner Code der hinter der News kommt damit nicht zuviel ausgeschnitten wird.

Falls eine Seite HTAccess gesichtert ist konnt ihr bei den folgenden 3 Menüpunkten die entsprechenden Werte eintragen.
Bei Channel tragt ihr den oder die Channel (mit Leerzeichen getrennt) ein, wo die News gepostet werden sollen.

Das Script wiederholt keine News, d.h. wenn das Script versucht neue News zu finden, diese aber die gleiche ist wie zuvor, dann wird sie nicht in den Channel gepostet. Diesen Vorgang könnt ihr mit der Einstellung "Repeat after" steuern. Hier tragt ihr den Wert in Minuten ein, nachdem die News wiederholt werden soll.

Bei Einstellung 10 könnt ihr ein Template für diese News eingeben, falls die News für unterschiedliche Ticker auch unterschiedlich aussehen sollen. Ansonsten wird das Template genommen was im Script-Quelltext als DefaultTemplate eingestellt ist.

Nachdem nur die Config für den Ticker fertig ist, müsst ihr dem Script nur noch mitteilen, dass es diese Config auch benutzen soll. Das macht ihr mittels .UTICKER und dann durhc das Verändern der Einstellung Nummer 6. Hier gebt ihr dann einfach den Namen des Tickers an, aber Achtung! Nicht den Namen den ihr bei der Config des Tickers angegeben habt (Einstellung 1) sondern das Wort was ihr nach .UTICKER geschrieben habt. Der Name der Config steht dann oben im Menü (in unserem Fall "Stern").

Einfach wieder aus dem Hauptmenü raus und das Script wird veränderte Ticker neuladen und diesem beim nächsten Durchlauf abrufen.


Viel Spaß und bei Fragen/Problemen einfach hier posten.
Bitte beachtet: Dieses Script ist im Beta-Stadium und extra hier gepostet worden, um getestet zu werden. Da die Sockets der aktuellen AnGelBot Version zu Instabilitäten desselbigen führen können, kann es sein das euer Bots sich bei mehreren, aber evtl. auch schon bei einem laufenden Ticker verabschiedet!

Sp33d

16.10.2004, 10:57 Uhr
Bitte die Teile zusammenkopieren und abspeichern.
(Ein Hoch auf phpBB :evilSmile

Code:
'================================================
'Erstellt mit [ABP]AVS 1.0.8
'AnGelBot Visual Scripting

'Visit us online @ http://www.AnGelBot-Portal.de/
'================================================
'(c) 2004 Laurens Stötzel
'================================================

Option Explicit

Const DebugIt = False
Const mConfig = "ut_main.ini"

Const MaxLineLength = 32

'Verfügbare Variablen:
' [$id      = ID der Config]
' $name    = Name der Config
' $display = Anzeigename
' $news    = Die empfangenen News
' $url     = URL der Seite von der die News stammt
Const DefaultTemplate = "($name - $display) $news"

'Wenn ihr mehr als 100 Ticker laden wollt, ändert in
'folgender Zeile die '100' in Höchstzahl von Tickern ab.
Dim Ticker(100, 4)  'Tickerstruktur
          'ID, 0 = Socket
          'ID, 1 = Config
          'ID, 2 = Buffer
          'ID, 3 = Last news
          'ID, 4 = Last news (time/date)

Sub Init()
  Script "UniversalTicker 1.0b by Sp33d"
  If Trim(DefaultTemplate) = vbNullString Then
    DontLoadScript "You MUST specify a default template!"
    Exit Sub
  End If

  Hook "Chan_Msg"
  Hook "Commands"
  AddCommand "uticker", CL_Mas, "+m", "2*** UTICKER [<config>]##  14Ruft das UniversalTicker Setup auf.##  14Wenn kein Configname angegeben wird,##  14so wird das Haupt-Setup angezeigt."
  ReloadTickers
  GetNews
End Sub

Sub Chan_Msg(Chan, Nick, RegUser, Line)
End Sub

Sub Commands(vSock, RegUser, Flags, Line)
  If LCase(Param(Line, 1)) = ".uticker" Then
    If Param(Line, 2) <> vbNullString Then
      GrabUser vSock, "UniversalTicker Setup", "TickerSetup"
      SetSockTag vSock, "MainMenu " & Param(Line, 2)
      TickerSetup vSock, RegUser, Flags, vbNullString
    Else
      GrabUser vSock, "UniversalTicker Setup", "TickerSetup"
      SetSockTag vSock, "MainMenu <none>"
      TickerSetup vSock, RegUser, Flags, vbNullString
    End If
    TickerSetup vSock, RegUser, Flags, vbNullString
  End If
End Sub

Sp33d

16.10.2004, 10:58 Uhr
Code:
Sub TickerSetup(vSock, RegUser, Flags, Line)
  Dim Menu, Config

  Menu   = Param(GetSockTag(vSock), 1)
  Config = Param(GetSockTag(vSock), 2)

  If LCase(Param(Line, 1)) = "rescue" Then
    TU vSock, "3*** Rescue signal received"
    ReleaseUser vSock
    Exit Sub
  ElseIf Param(Line, 1) = "0" And LCase(Menu) = "mainmenuoption" Then
    TU vSock, "10*** Reloading tickers... Have a nice day!"
    ReleaseUser vSock
    If Config = "<none>" Then ReloadTickers
    Exit Sub
  End If

  Select Case LCase(Menu)
    Case "mainmenu"
      TU vSock, " 11,0,%0,11%'12,11,%11,12%'2,12,%12,2%'1,2,%2,1%'1,1                     2,1'%1,2%,12,2'%2,12%,11,12'%12,11%,0,11'%11,0%,"
      TU vSock, "11,0,%0,11%'12,11,%11,12%'2,12,%12,2%'1,2,%2,1%'1,1 0,1 UniversalTicker Setup1,1 2,1'%1,2%,12,2'%2,12%,11,12'%12,11%,0,11'%11,0%,"
      TU vSock, " 11,0,%0,11%'12,11,%11,12%'2,12,%12,2%'1,2,%2,1%'1,1                     2,1'%1,2%,12,2'%2,12%,11,12'%12,11%,0,11'%11,0%,"
      TU vSock, " "
      TU vSock, "Welcome to the UniversalTicker Setup. Here are the current settings:"
      TU vSock, " "
      TU vSock, " Config14...: " & IIf(Config = "<none>", "14Main config", Config)
      TU vSock, " "

      If Config <> "<none>" Then
        TU vSock, " 021) Name14............: " & IIf(ReadConfig(Config, "Name") <> vbNullString, ReadConfig(Config, "Name"), "14<none>")
        TU vSock, " 022) Displayed URL14...: " & IIf(ReadConfig(Config, "Display") <> vbNullString, ReadConfig(Config, "Display"), "14<none>")
        TU vSock, " "
        TU vSock, " 023) Address14.........: " & IIf(ReadConfig(Config, "Address") <> vbNullString, ReadConfig(Config, "Address"), "14<none>")
        TU vSock, " 024) Search for14......: " & IIf(ReadConfig(Config, "SearchFor") <> vbNullString, ReadConfig(Config, "SearchFor"), "14<none>")
        TU vSock, " "
        TU vSock, " 025) Requires authentication: " & IIf(ReadConfig(Config, "HTAccess") = "1", "3YES", "4NO")
        TU vSock, " 026) Username14...............: " & IIf(ReadConfig(Config, "HTUser") <> vbNullString, ReadConfig(Config, "HTUser"), "14<none>")
        TU vSock, " 027) Password14...............: " & IIf(ReadConfig(Config, "HTPass") <> vbNullString, ReadConfig(Config, "HTPass"), "14<none>")
        TU vSock, " "
        TU vSock, " 028) Channels14........: " & IIf(ReadConfig(Config, "Channels") <> vbNullString, ReadConfig(Config, "Channels"), "14<none>")
        TU vSock, " 029) Repeat after14....: " & IIf(ReadConfig(Config, "Repeat") <> vbNullString, ReadConfig(Config, "Repeat") & " minutes", "14<do not repeat>")
        TU vSock, " "
        TU vSock, " 0210) Template14.......: " & IIf(ReadConfig(Config, "Template") <> vbNullString, ReadConfig(Config, "Template"), "14<use default>")
        TU vSock, " "
      Else
        TU vSock, " 021) Interval14.............: " & IIf(ReadConfig(mConfig, "Interval") <> vbNullString, IIf(ReadConfigNum(mConfig, "Interval") <= 0, "14<disabled>", ReadConfig(mConfig, "Interval")), "120")
        TU vSock, " 022) Strip colors on +c14...: " & IIf(ReadConfig(mConfig, "StripColors") = "1", "3YES", "4NO")
        TU vSock, " "
        TU vSock, " 023) Use HTTP Proxy14.......: " & IIf(ReadConfig(mConfig, "UseProxy") = "1", "3YES", "4NO")
        TU vSock, " 024) Proxy Host14...........: " & IIf(ReadConfig(mConfig, "ProxyHost") <> vbNullString, ReadConfig(mConfig, "ProxyHost"), "14<none>")
        TU vSock, " 025) Proxy Port14...........: " & IIf(ReadConfig(mConfig, "ProxyPort") <> vbNullString, ReadConfig(mConfig, "ProxyPort"), "14<none>")
        TU vSock, " "
        If ReadConfig(mConfig, "Active") <> vbNullString Then
          If Len(ReadConfig(mConfig, "Active")) <= MaxLineLength Then
            TU vSock, " 026) Active tickers14.......: " & IIf(ReadConfig(mConfig, "Active") <> vbNullString, ReadConfig(mConfig, "Active"), "14<none>")
          Else
            Dim cLine, i, Channels, Sent
            Sent = False
            Channels = ReadConfig(mConfig, "Active")
            For i = 1 To ParamCount(Channels)
              cLine = cLine & " " & Param(Channels, i)
              If Len(cLine) > MaxLineLength Then
                If Not Sent Then
                  TU vSock, " 026) Active tickers14.......: " & LTrim(cLine)
                  Sent = True
                Else
                  TU vSock, String(27, Chr(160)) & LTrim(cLine)
                End If
                cLine = vbNullString
              End If
            Next
            If cLine <> vbNullString Then TU vSock, String(27, Chr(160)) & LTrim(cLine)
          End If
        End If
      End If

      TU vSock, " "
      TU vSock, " Enter a setting number or enter '0' to leave the setup."
      SetSockTag vSock, "MainMenuOption " & Config

Sp33d

16.10.2004, 10:59 Uhr
Code:
Case "mainmenuoption"
      If Config = "<none>" Then
        Select Case Param(Line, 1)
          Case "1"
            If Param(Line, 2) = vbNullString Then
              TU vSock, "021) Interval"
              TU vSock, "  14  Enter an interval in seconds in which the"
              TU vSock, "  14  ticker should try to get the news."
              SetSockTag vSock, "submenu " & Config & " 1"
            Else
              If LCase(Param(Line, 2)) = "x" Then
                WriteINIString "Settings", "Interval", "0", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              ElseIf Param(Line, 2) = "0" Then
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Else
                If IsNumeric(Param(Line, 2)) Then
                  If Param(Line, 2) => 30 And Param(Line, 2) <= 600 Then
                    WriteINIString "Settings", "Interval", Param(Line, 2), mConfig
                    SetSockTag vSock, "MainMenu " & Config
                    TickerSetup vSock, RegUser, Flags, vbNullString
                  Else
                    TU vSock, "4*** Please enter an integer value between 30 and 600!"
                  End If
                Else
                  TU vSock, "4*** Please enter an integer value between 30 and 600!"
                End If
              End If
            End If
          Case "2"
            If Param(Line, 2) = vbNullString Then
              TU vSock, "022) Strip colors on +c"
              TU vSock, "  14  Strips any colors from the news when the"
              TU vSock, "  14  channel mode +c is set."
              SetSockTag vSock, "submenu " & Config & " 2"
            Else
              Select Case LCase(Param(Line, 2))
                Case "j", "ja", "yes", "y", "1"
                  WriteINIString "Settings", "StripColors", "1", mConfig
                  SetSockTag vSock, "MainMenu " & Config
                  TickerSetup vSock, RegUser, Flags, vbNullString
                Case "n", "nein", "no", "0", "x"
                  WriteINIString "Settings", "StripColors", "0", mConfig
                  SetSockTag vSock, "MainMenu " & Config
                  TickerSetup vSock, RegUser, Flags, vbNullString
                Case "0"
                  SetSockTag vSock, "MainMenu " & Config
                  TickerSetup vSock, RegUser, Flags, vbNullString
                Case Else
                  TU vSock, "4Please type either 'yes' or 'no'."
              End Select
            End If
          Case "3"
            If Param(Line, 2) = vbNullString Then
              TU vSock, "024) Use HTTP Proxy"
              TU vSock, "  14  Specifies whether the script shall connect"
              TU vSock, "  14  to the news site using a HTTP proxy."
              SetSockTag vSock, "submenu " & Config & " " & Param(Line, 1)
            Else
              Select Case LCase(Param(Line, 2))
                Case "j", "ja", "yes", "y", "1"
                  WriteINIString "Settings", "UseProxy", "1", mConfig
                  SetSockTag vSock, "MainMenu " & Config
                  TickerSetup vSock, RegUser, Flags, vbNullString
                Case "n", "nein", "no", "0", "x"
                  WriteINIString "Settings", "UseProxy", "0", mConfig
                  SetSockTag vSock, "MainMenu " & Config
                  TickerSetup vSock, RegUser, Flags, vbNullString
                Case "0"
                  SetSockTag vSock, "MainMenu " & Config
                  TickerSetup vSock, RegUser, Flags, vbNullString
                Case Else
                  TU vSock, "4Please type either 'yes' or 'no'."
              End Select
            End If
          Case "4"
            If Param(Line, 2) = vbNullString Then
              TU vSock, "024) Proxy Host"
              TU vSock, "  14  Specifies the hostname/IP of the proxy."
              SetSockTag vSock, "submenu " & Config & " " & Param(Line, 1)
            Else
              If LCase(Param(Line, 2)) = "x" Then
                DeleteINIString "Settings", "ProxyHost", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              ElseIf Param(Line, 2) = "0" Then
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Else
                WriteINIString "Settings", "ProxyHost", Param(Line, 2), mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              End If
            End If

Sp33d

16.10.2004, 11:00 Uhr
Code:
Case "5"
            If Param(Line, 2) = vbNullString Then
              TU vSock, "025) Proxy Port"
              TU vSock, "  14  Specifies the proxy port to connect to."
              SetSockTag vSock, "submenu " & Config & " " & Param(Line, 1)
            Else
              If LCase(Param(Line, 2)) = "x" Then
                DeleteINIString "Settings", "ProxyPort", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              ElseIf Param(Line, 2) = "0" Then
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Else
                If IsNumeric(Param(Line, 2)) Then
                  If Param(Line, 2) => 1 And Param(Line, 2) <= 65535 Then
                    WriteINIString "Settings", "ProxyPort", CLng(Param(Line, 2)), mConfig
                    SetSockTag vSock, "MainMenu " & Config
                    TickerSetup vSock, RegUser, Flags, vbNullString
                  Else
                    TU vSock, "4*** Please enter an value between 1 and 65535!"
                  End If
                Else
                  TU vSock, "4*** Please enter an integer value between 1 and 65535!"
                End If
              End If
            End If
          Case "6"
            If Param(Line, 2) = vbNullString Then
              TU vSock, "024) Active scripts"
              TU vSock, "  14  Specifies the tickers' names to load."
              SetSockTag vSock, "submenu " & Config & " " & Param(Line, 1)
            Else
              If LCase(Param(Line, 2)) = "x" Then
                DeleteINIString "Settings", "Active", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              ElseIf Param(Line, 2) = "0" Then
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Else
                If ParamCount(GetRest(Line, 2)) <= (UBound(Ticker) + 1) Then
                  WriteINIString "Settings", "Active", GetRest(Line, 2), mConfig
                  SetSockTag vSock, "MainMenu " & Config
                  TickerSetup vSock, RegUser, Flags, vbNullString
                Else
                  TU vSock, "4*** You can only specify " & (UBound(Ticker) + 1) & " tickers."
                End If
              End If
            End If
        End Select
      Else
        Select Case Param(Line, 1)
          Case "1"
            If Param(Line, 2) = vbNullString Then
              TU vSock, "021) Name"
              TU vSock, "  14  Specifies the name of this ticker."
              SetSockTag vSock, "submenu " & Config & " " & Param(Line, 1)
            Else
              If LCase(Param(Line, 2)) = "x" Then
                DeleteINIString Config & "_Settings", "Name", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              ElseIf Param(Line, 2) = "0" Then
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Else
                WriteINIString Config & "_Settings", "Name", GetRest(Line, 2), mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              End If
            End If
          Case "2"
            If Param(Line, 2) = vbNullString Then
              TU vSock, "022) Displayed URL"
              TU vSock, "  14  This URL will be displayed when the"
              TU vSock, "  14  news is posted to the channel."
              SetSockTag vSock, "submenu " & Config & " " & Param(Line, 1)
            Else
              If LCase(Param(Line, 2)) = "x" Then
                DeleteINIString Config & "_Settings", "Display", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              ElseIf Param(Line, 2) = "0" Then
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Else
                WriteINIString Config & "_Settings", "Display", Param(Line, 2), mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              End If
            End If
          Case "3"
            If Param(Line, 2) = vbNullString Then
              TU vSock, "023) Address"
              TU vSock, "  14  Specifies the address to take the news from."
              SetSockTag vSock, "submenu " & Config & " " & Param(Line, 1)
            Else
              If LCase(Param(Line, 2)) = "x" Then
                DeleteINIString Config & "_Settings", "Address", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              ElseIf Param(Line, 2) = "0" Then
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Else
                WriteINIString Config & "_Settings", "Address", GetRest(Line, 2), mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              End If
            End If

Sp33d

16.10.2004, 11:00 Uhr
Code:
Case "4"
            If Param(Line, 2) = vbNullString Then
              TU vSock, "024) Search for"
              TU vSock, "  14  Specifies the string mask to search for."
              SetSockTag vSock, "submenu " & Config & " " & Param(Line, 1)
            Else
              If LCase(Param(Line, 2)) = "x" Then
                DeleteINIString Config & "_Settings", "SearchFor", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              ElseIf Param(Line, 2) = "0" Then
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Else
                WriteINIString Config & "_Settings", "SearchFor", GetRest(Line, 2), mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              End If
            End If
          Case "5"
            If Param(Line, 2) = vbNullString Then
              TU vSock, "025) Requires authentication"
              TU vSock, "  14  Specifies, whether the bot needs a basic"
              TU vSock, "  14  authentication (HTAcess) to access the address."
              SetSockTag vSock, "submenu " & Config & " " & Param(Line, 1)
            Else
              Select Case LCase(Param(Line, 2))
                Case "j", "ja", "yes", "y", "1"
                  WriteINIString Config & "_Settings", "HTAccess", "1", mConfig
                  SetSockTag vSock, "MainMenu " & Config
                  TickerSetup vSock, RegUser, Flags, vbNullString
                Case "n", "nein", "no", "0", "x"
                  WriteINIString Config & "_Settings", "HTAccess", "0", mConfig
                  SetSockTag vSock, "MainMenu " & Config
                  TickerSetup vSock, RegUser, Flags, vbNullString
                Case "0"
                  SetSockTag vSock, "MainMenu " & Config
                  TickerSetup vSock, RegUser, Flags, vbNullString
                Case Else
                  TU vSock, "4Please type either 'yes' or 'no'."
              End Select
            End If
          Case "6"
            If Param(Line, 2) = vbNullString Then
              TU vSock, "022) Username"
              TU vSock, "  14  Specifies the username that is needed for the"
              TU vSock, "  14  HTAccess basic authentication."
              SetSockTag vSock, "submenu " & Config & " " & Param(Line, 1)
            Else
              If LCase(Param(Line, 2)) = "x" Then
                DeleteINIString Config & "_Settings", "HTUser", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              ElseIf Param(Line, 2) = "0" Then
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Else
                WriteINIString Config & "_Settings", "HTUser", Param(Line, 2), mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              End If
            End If
          Case "7"
            If Param(Line, 2) = vbNullString Then
              TU vSock, "022) Password"
              TU vSock, "  14  Specifies the password that is needed for the"
              TU vSock, "  14  HTAccess basic authentication."
              SetSockTag vSock, "submenu " & Config & " " & Param(Line, 1)
            Else
              If LCase(Param(Line, 2)) = "x" Then
                DeleteINIString Config & "_Settings", "HTPass", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              ElseIf Param(Line, 2) = "0" Then
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Else
                WriteINIString Config & "_Settings", "HTPass", Param(Line, 2), mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              End If
            End If
          Case "8"
            If Param(Line, 2) = vbNullString Then
              TU vSock, "022) Channels"
              TU vSock, "  14  Specifies the channels the news are send to."
              TU vSock, "  14  Please use a single space to seperate multiple channels."
              SetSockTag vSock, "submenu " & Config & " " & Param(Line, 1)
            Else
              If LCase(Param(Line, 2)) = "x" Then
                DeleteINIString Config & "_Settings", "Channels", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              ElseIf Param(Line, 2) = "0" Then
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Else
                WriteINIString Config & "_Settings", "Channels", GetRest(Line, 2), mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              End If
            End If
          Case "9"
            If Param(Line, 2) = vbNullString Then
              TU vSock, "025) Repeat after"
              TU vSock, "  14  Specifies after which timespan w/out new news"
              TU vSock, "  14  the last one will be repeated."
              SetSockTag vSock, "submenu " & Config & " " & Param(Line, 1)
            Else
              If LCase(Param(Line, 2)) = "x" Then
                DeleteINIString Config & "_Settings", "Repeat", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              ElseIf Param(Line, 2) = "0" Then
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Else
                If IsNumeric(Param(Line, 2)) Then
                  If Param(Line, 2) => 5 And Param(Line, 2) <= 360 Then
                    WriteINIString Config & "_Settings", "Repeat", CLng(Param(Line, 2)), mConfig
                    SetSockTag vSock, "MainMenu " & Config
                    TickerSetup vSock, RegUser, Flags, vbNullString
                  Else
                    TU vSock, "4*** Please enter an value between 5 and 360 minutes!"
                  End If
                Else
                  TU vSock, "4*** Please enter an value between 5 and 360 minutes!"
                End If
              End If
            End If

Sp33d

16.10.2004, 11:01 Uhr
Code:
Case "10"
            If Param(Line, 2) = vbNullString Then
              TU vSock, "022) Template"
              TU vSock, "  14  Specifies the individual template for this config."
              SetSockTag vSock, "submenu " & Config & " " & Param(Line, 1)
            Else
              If LCase(Param(Line, 2)) = "x" Then
                DeleteINIString Config & "_Settings", "Template", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              ElseIf Param(Line, 2) = "0" Then
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Else
                WriteINIString Config & "_Settings", "Template", GetRest(Line, 2), mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              End If
            End If
        End Select
      End If
    Case "submenu"
      If Config = "<none>" Then
        Select Case Param(GetSockTag(vSock), 3)
          Case "1"
            If LCase(Param(Line, 1)) = "x" Then
              WriteINIString "Settings", "Interval", "0", mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            ElseIf Param(Line, 1) = "0" Then
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            Else
              If IsNumeric(Param(Line, 1)) Then
                If Param(Line, 1) => 30 And Param(Line, 1) <= 600 Then
                  WriteINIString "Settings", "Interval", Param(Line, 1), mConfig
                  SetSockTag vSock, "MainMenu " & Config
                  TickerSetup vSock, RegUser, Flags, vbNullString
                Else
                  TU vSock, "4*** Please enter an integer value between 30 and 600!"
                End If
              Else
                TU vSock, "4*** Please enter an integer value between 30 and 600!"
              End If
            End If
          Case "2"
            Select Case LCase(Param(Line, 1))
              Case "j", "ja", "yes", "y", "1"
                WriteINIString "Settings", "StripColors", "1", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Case "n", "nein", "no", "0", "x"
                WriteINIString "Settings", "StripColors", "0", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Case "0"
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Case Else
                TU vSock, "4Please type either 'yes' or 'no'."
            End Select
          Case "3"
            Select Case LCase(Param(Line, 1))
              Case "j", "ja", "yes", "y", "1"
                WriteINIString "Settings", "UseProxy", "1", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Case "n", "nein", "no", "0", "x"
                WriteINIString "Settings", "UseProxy", "0", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Case "0"
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Case Else
                TU vSock, "4Please type either 'yes' or 'no'."
            End Select
          Case "4"
            If LCase(Param(Line, 1)) = "x" Then
              DeleteINIString "Settings", "ProxyHost", mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            ElseIf Param(Line, 1) = "0" Then
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            Else
              WriteINIString "Settings", "ProxyHost", Param(Line, 1), mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            End If
          Case "5"
            If LCase(Param(Line, 1)) = "x" Then
              DeleteINIString "Settings", "ProxyPort", mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            ElseIf Param(Line, 1) = "0" Then
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            Else
              If IsNumeric(Param(Line, 1)) Then
                If Param(Line, 1) => 1 And Param(Line, 1) <= 65535 Then
                  WriteINIString "Settings", "ProxyPort", Param(Line, 1), mConfig
                  SetSockTag vSock, "MainMenu " & Config
                  TickerSetup vSock, RegUser, Flags, vbNullString
                Else
                  TU vSock, "4*** Please enter an integer value between 1 and 65535!"
                End If
              Else
                TU vSock, "4*** Please enter an integer value between 1 and 65535!"
              End If
            End If
          Case "6"
            If LCase(Param(Line, 1)) = "x" Then
              DeleteINIString "Settings", "Active", mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            ElseIf Param(Line, 1) = "0" Then
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            Else
              If ParamCount(Line) <= (UBound(Ticker) + 1) Then
                WriteINIString "Settings", "Active", Line, mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Else
                TU vSock, "4*** You can only specify " & (UBound(Ticker) + 1) & " tickers."
              End If
            End If
        End Select
      Else
        Select Case Param(GetSockTag(vSock), 3)
          Case "1"
            If LCase(Param(Line, 1)) = "x" Then
              DeleteINIString Config & "_Settings", "Name", mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            ElseIf Param(Line, 1) = "0" Then
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            Else
              WriteINIString Config & "_Settings", "Name", Line, mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            End If
          Case "2"
            If LCase(Param(Line, 1)) = "x" Then
              DeleteINIString Config & "_Settings", "Display", mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            ElseIf Param(Line, 1) = "0" Then
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            Else
              WriteINIString Config & "_Settings", "Display", Param(Line, 1), mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            End If
          Case "3"
            If LCase(Param(Line, 1)) = "x" Then
              DeleteINIString Config & "_Settings", "Address", mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            ElseIf Param(Line, 1) = "0" Then
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            Else
              WriteINIString Config & "_Settings", "Address", Param(Line, 1), mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            End If
          Case "4"
            If LCase(Param(Line, 1)) = "x" Then
              DeleteINIString Config & "_Settings", "SearchFor", mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            ElseIf Param(Line, 1) = "0" Then
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            Else
              WriteINIString Config & "_Settings", "SearchFor", Line, mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            End If
          Case "5"
            Select Case LCase(Param(Line, 1))
              Case "j", "ja", "yes", "y", "1"
                WriteINIString Config & "_Settings", "HTAccess", "1", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Case "n", "nein", "no", "0", "x"
                WriteINIString Config & "_Settings", "HTAccess", "0", mConfig
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Case "0"
                SetSockTag vSock, "MainMenu " & Config
                TickerSetup vSock, RegUser, Flags, vbNullString
              Case Else
                TU vSock, "4Please type either 'yes' or 'no'."
            End Select
          Case "6"
            If LCase(Param(Line, 1)) = "x" Then
              DeleteINIString Config & "_Settings", "HTUser", mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            ElseIf Param(Line, 1) = "0" Then
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            Else
              WriteINIString Config & "_Settings", "HTUser", Param(Line, 1), mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            End If
          Case "7"
            If LCase(Param(Line, 1)) = "x" Then
              DeleteINIString Config & "_Settings", "HTPass", mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            ElseIf Param(Line, 1) = "0" Then
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            Else
              WriteINIString Config & "_Settings", "HTPass", Line, mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            End If
          Case "8"
            If LCase(Param(Line, 1)) = "x" Then
              DeleteINIString Config & "_Settings", "Channels", mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            ElseIf Param(Line, 1) = "0" Then
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            Else
              WriteINIString Config & "_Settings", "Channels", Line, mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            End If
          Case "9"
            If LCase(Param(Line, 1)) = "x" Then
              DeleteINIString Config & "_Settings", "Repeat", mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            ElseIf Param(Line, 1) = "0" Then
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            Else
              If IsNumeric(Param(Line, 1)) Then
                If Param(Line, 1) => 5 And Param(Line, 1) <= 360 Then
                  WriteINIString Config & "_Settings", "Repeat", Param(Line, 1), mConfig
                  SetSockTag vSock, "MainMenu " & Config
                  TickerSetup vSock, RegUser, Flags, vbNullString
                Else
                  TU vSock, "4*** Please enter an integer value between 5 and 360 minutes!"
                End If
              Else
                TU vSock, "4*** Please enter an integer value between 5 and 360 minutes!"
              End If
            End If
          Case "10"
            If LCase(Param(Line, 1)) = "x" Then
              DeleteINIString Config & "_Settings", "Template", mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            ElseIf Param(Line, 1) = "0" Then
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            Else
              WriteINIString Config & "_Settings", "Template", Line, mConfig
              SetSockTag vSock, "MainMenu " & Config
              TickerSetup vSock, RegUser, Flags, vbNullString
            End If
        End Select
      End If
  End Select
End Sub

Sp33d

16.10.2004, 11:04 Uhr
Code:
Function ReadConfig(Name, Field)
  If Name <> mConfig Then
    ReadConfig = ReadINIString(Name & "_Settings", Field, vbNullString, mConfig)
  Else
    ReadConfig = ReadINIString("Settings", Field, vbNullString, mConfig)
  End If
End Function

Function ReadConfigNum(Name, Field)
  If Name <> mConfig Then
    ReadConfigNum = CLng(ReadINIString(Name & "_Settings", Field, "0", mConfig))
  Else
    ReadConfigNum = CLng(ReadINIString("Settings", Field, "0", mConfig))
  End If
End Function


Function IsValidConfig(File)
  IsValidConfig = True

  If ReadConfig(File, "Name") = vbNullString Then IsValidConfig = False
  If ReadConfig(File, "Display") = vbNullString Then IsValidConfig = False
  If ReadConfig(File, "Address") = vbNullString Then IsValidConfig = False
  If ReadConfig(File, "SearchFor") = vbNullString Then IsValidConfig = False

  If ReadConfig(File, "HTAccess") = "1" Then
    If ReadConfig(File, "HTUser") = vbNullString Then IsValidConfig = False
    If ReadConfig(File, "HTPass") = vbNullString Then IsValidConfig = False
  End If

  If ReadConfig(File, "Channels") = vbNullString Then IsValidConfig = False
End Function

Sub GetNews()
  Dim vSock, ActiveConfigs, i, ServerHost

  For i = LBound(Ticker) To UBound(Ticker)
    If Ticker(i, 1) <> vbNullString Then
      If IsValidConfig(Ticker(i, 1)) Then
        ServerHost = ExtractServer(ReadConfig(Ticker(i, 1), "Address"))

        vSock = SockConnect(ServerHost, 80, "TickerSocket")
        If vSock <= 0 Then
          SpreadFlagMessage 0, "+m", "4*** Couldn't create socket to " & ServerHost & "!"
          Silent True
          SockClose vSock
          Silent False
        Else
          Ticker(i, 0) = vSock
        End If
      End If
    End If
  Next

  If ReadConfig(mConfig, "Interval") <> vbNullString And IsNumeric(ReadConfig(mConfig, "Interval")) Then
    If ReadConfig(mConfig, "Interval") >= 30 And ReadConfig(mConfig, "Interval") <= 600 Then
      TimedCommand "GetNews", ReadConfig(mConfig, "Interval")
    End If
  End If
End Sub

Function ExtractServer(URL)
  Dim tURL

  tURL = URL
  If LCase(Left(tURL, 7)) = "http://" Then tURL = Mid(tURL, 8)
  If InStr(1, tURL, "/") Then tURL = Mid(tURL, 1, InStr(1, tURL, "/") - 1)

  ExtractServer = tURL
End Function

Function ExtractPath(URL)
  Dim tURL

  tURL = URL
  If LCase(Left(tURL, 7)) = "http://" Then tURL = Mid(tURL, 8)
  If InStr(1, tURL, "/") Then tURL = Mid(tURL, InStr(1, tURL, "/"))
  If Trim(tURL) = vbNullString Then tURL = "/"

  ExtractPath = Trim(tURL)
End Function

Sub TickerSocket(vSock, SEvent, SData)
  Dim tID, pHeader, i

  tID = -1
  For i = LBound(Ticker) To UBound(Ticker)
    If Ticker(i, 0) = vSock Then
      tID = i
      Exit For
    End If
  Next

  If tID = -1 Then
    Silent True
    SockClose vSock
    Silent False
    Exit Sub
  End If

  Select Case SEvent
    Case SE_ConnectFailed
      If DebugIt Then SpreadFlagMessage 0, "+m", "5*** UniversalTicker: Connection to " & ExtractServer(ReadConfig(Ticker(tID, 1), "Address")) & ":80 failed"
    Case SE_Connected
      If ReadConfig(mConfig, "UseProxy") <> "1" Then
        pHeader = "GET " & ExtractPath(ReadConfig(Ticker(tID, 1), "Address")) & " HTTP/1.0"
      Else
        Header = "GET " & ReadConfig(Ticker(tID, 1), "Address") & " HTTP/1.0"
      End If

      If ReadConfig(Ticker(tID, 1), "HTAccess") = "1" And ReadConfig(Ticker(tID, 1), "HTUser") <> vbNullString And ReadConfig(Ticker(tID, 1), "HTPass") <> vbNullString Then
        pHeader = pHeader & vbCrLf & "Authorization: Basic " & Base64Encode(ReadConfig(Ticker(tID, 1), "HTUser") & ":" & ReadConfig(Ticker(tID, 1), "HTPass")) & vbCrLf
      End If

      SockWrite vSock, pHeader & vbCrLf & _
                       "Accept: */*"  & vbCrLf & _
                       "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)" & vbCrLf & _
                       "Host: " & ExtractServer(ReadConfig(Ticker(tID, 1), "Address")) & vbCrLf & _
                       "Pragma: no-cache" & vbCrLf & _
                       "Connection: close" & vbCrLf & vbCrLf
    Case SE_Read
      Ticker(tID, 2) = Ticker(tID, 2) & SData
    Case SE_Closed
      Dim iPos, iPos2, News, Chans, Template

      News = vbNullString

      If InStr(1, ReadConfig(Ticker(tID, 1), "SearchFor"), "*") > 0 Then
        If DebugIt Then SpreadFlagMessage 0, "+m", "Searching for news by supplied wildcard..."
        News = GetNewsByWildcard(ReadConfig(Ticker(tID, 1), "SearchFor"), Ticker(tID, 2))
      Else
        If DebugIt Then SpreadFlagMessage 0, "+m", "Searching for news by line end"
        If DebugIt Then SpreadFlagMessage 0, "+m", "tag: " & ReadConfig(Ticker(tID, 1), "SearchFor")
        News = GetNewsByTagLine(ReadConfig(Ticker(tID, 1), "SearchFor"), Ticker(tID, 2))
      End If

      Ticker(tID, 0) = -1
      Ticker(tID, 2) = vbNullString

      News = StripUnnecessarySpaces(ReplaceHTMLCodes(StripTags(CutLine(News))))
      If News = vbNullString Then Exit Sub

      Template = IIf(ReadConfig(Ticker(tID, 1), "Template") <> vbNullString, ReadConfig(Ticker(tID, 1), "Template"), DefaultTemplate)
      News = Replace(Replace(Replace(Replace(Template, "$news", News, vbTextCompare), "$display", ReadConfig(Ticker(tID, 1), "Display"), vbTextCompare), "$name", ReadConfig(Ticker(tID, 1), "Name"), vbTextCompare), "$url", ReadConfig(Ticker(tID, 1), "Address"), vbTextCompare)

      If News <> Ticker(tID, 3) Then
        'SpreadFlagMessage 0, "+m", News
        Ticker(tID, 3) = News
        Ticker(tID, 4) = Now
        Chans = Replace(ReadConfig(Ticker(tID, 1), "Channels"), " ", ",")
        If Chans <> vbNullString Then SendLine "PRIVMSG " & Chans & " :" & News, 2
      Else
        If IsNumeric(ReadConfig(Ticker(tID, 1), "Repeat")) Then
          If DateDiff("n", Ticker(tID, 4), Now) >= CInt(ReadConfig(Ticker(tID, 1), "Repeat")) Then
            Chans = Replace(ReadConfig(Ticker(tID, 1), "Channels"), " ", ",")
            If Chans <> vbNullString Then SendLine "PRIVMSG " & Chans & " :" & News, 2
            Ticker(tID, 4) = Now
          End If
        End If
      End If
  End Select
End Sub

Sp33d

16.10.2004, 11:05 Uhr
Code:
Function StripTags(HTML)
  Dim mStartPos, mEndPos, mString

  mStartPos = InStr(HTML, "<")
  mEndPos = InStr(HTML, ">")

  Do While mStartPos > 0
    If mStartPos < mEndPos Then
      'gültigen Tag gefunden
      HTML = Mid(HTML, 1, mStartPos - 1) & Mid(HTML, mEndPos + 1)
    Else
      If mEndPos > 0 Then
        'Start und Endtag, aber nicht richtige Reihenfolge
        HTML = Mid(HTML, mEndPos + 1)
      Else
        'Start aber kein Endtag
        HTML = Mid(HTML, 1, mStartPos - 1)
      End If
    End If
    mStartPos = InStr(HTML, "<")
    mEndPos = InStr(HTML, ">")
  Loop

  If mStartPos = 0 And mEndPos > 0 Then
    'kein Start- aber ein Endtag
    HTML = Mid(HTML, mEndPos + 1)
  End If

  StripTags = Trim(HTML)
End Function

Function CutLine(Line)
  If InStr(Line, vbCr) Then Line = Mid(Line, 1, InStr(Line, vbCr) - 1)
  If InStr(Line, vbLf) Then Line = Mid(Line, 1, InStr(Line, vbLf) - 1)
  CutLine = Line
End Function

Function ReplaceHTMLCodes(HTML)
  Dim iPos, iPos2
  Dim sAns, sInput, pTag

  iPos = 1
  Do While InStr(iPos, HTML, "&") > 0
    iPos = InStr(iPos, HTML, "&") + 1
    If InStr(1, Mid(HTML, iPos, 7), ";") > 0 Then

      iPos2 = InStr(1, Mid(HTML, iPos, 7), ";")

      pTag = Mid(HTML, iPos, iPos2 - 1)
      If Left(pTag, 1) = "#" Then
        sInput = Mid(pTag, 2)
      Else
        sInput = pTag
      End If

      If IsNumeric(sInput) Then
        If sInput <= 255 Then sAns = Chr(sInput)
      Else
        Select Case sInput
          Case "quot"
            sAns = """"
          Case "amp"
            sAns = "&"
          Case "lt"
            sAns = "<"
          Case "gt"
            sAns = ">"
          Case "nbsp"
            'eigentlich Chr(160)
            sAns = " "
          Case "auml"
            sAns = "ä"
          Case "Auml"
            sAns = "Ä"
          Case "ouml"
            sAns = "ö"
          Case "Ouml"
            sAns = "Ö"
          Case "uuml"
            sAns = "ü"
          Case "Uuml"
            sAns = "Ü"
          Case "ndash"
            sAns = "-"
          Case "iexcl"
            sAns = Chr(161)
          Case "cent"
            sAns = Chr(162)
          Case "pound"
            sAns = Chr(163)
          Case "curren"
            sAns = Chr(164)
          Case "yen"
            sAns = Chr(165)
          Case "brvbar"
            sAns = Chr(166)
          Case "sect"
            sAns = Chr(167)
          Case "uml"
            sAns = Chr(168)
          Case "copy"
            sAns = Chr(169)
          Case "ordf"
            sAns = Chr(170)
          Case "laquo"
            sAns = Chr(171)
          Case "not"
            sAns = Chr(172)
          Case "shy"
            sAns = Chr(173)
          Case "reg"
            sAns = Chr(174)
          Case "macr"
            sAns = Chr(175)
          Case "deg"
            sAns = Chr(176)
          Case "plusmn"
            sAns = Chr(177)
          Case "sup2"
            sAns = Chr(178)
          Case "sup3"
            sAns = Chr(179)
          Case "acute"
            sAns = Chr(180)
          Case "micro"
            sAns = Chr(181)
          Case "para"
            sAns = Chr(182)
          Case "middot"
            sAns = Chr(183)
          Case "cedil"
            sAns = Chr(184)
          Case "supl"
            sAns = Chr(185)
          Case "ordm"
            sAns = Chr(186)
          Case "raquo"
            sAns = Chr(187)
          Case "frac14"
            sAns = Chr(188)
          Case "frac12"
            sAns = Chr(189)
          Case "frac34"
            sAns = Chr(190)
          Case "iquest"
            sAns = Chr(191)
          Case "times"
            sAns = Chr(215)
          Case "szlig"
            sAns = Chr(223)
          Case "divide"
            sAns = Chr(247)
          Case "yuml"
            sAns = Chr(255)
        End Select
      End If
      HTML = Replace(HTML, "&" & pTag & ";", sAns)
    End If
  Loop

  ReplaceHTMLCodes = HTML
End Function

Sub ReloadTickers()
  Dim Valid, ActiveConfigs, i, Unchanged
  ActiveConfigs = ReadConfig(mConfig, "Active")

  Valid = 0
  UnChanged = 0
  For i = 1 To ParamCount(ActiveConfigs)
    If IsValidConfig(Param(ActiveConfigs, i)) Then
      If Ticker(Valid, 1) <> Param(ActiveConfigs, i) Then
        Ticker(Valid, 0) = -1
        Ticker(Valid, 1) = Param(ActiveConfigs, i)
        Ticker(Valid, 2) = vbNullString
        Ticker(Valid, 3) = vbNullString
        Ticker(Valid, 4) = "01.01.1970 00:00:00"
        If Valid > UBound(Ticker) Then Exit For
      Else
        UnChanged = UnChanged + 1
      End If
      Valid = Valid + 1
    End If
  Next

  SpreadFlagMessage 0, "+m", "3*** UniversalTicker: Loaded " & Valid & " ticker(s). " & UnChanged & " active tickers were left untouched..."
End Sub

Function GetNewsByWildcard(Tag, HTML)
  GetNewsByWildcard = vbNullString

  HTML = Replace(HTML, vbCrLf, vbNullString)
  HTML = Replace(HTML, vbCr, vbNullString)
  HTML = Replace(HTML, vbLf, vbNullString)

  If InStr(1, Tag, "*") Then
    Dim LeftTag, RightTag
    Dim iPos, iPos2

    LeftTag = Mid(Tag, 1, InStr(1, Tag, "*") - 1)
    RightTag = Mid(Tag, InStr(1, Tag, "*") + 1)

    'If DebugIt Then SpreadFlagMessage 0, "+m", "LeftTag: " & LeftTag
    'If DebugIt Then SpreadFlagMessage 0, "+m", "RightTag: " & RightTag

    If InStr(1, HTML, LeftTag, vbTextCompare) > 0 Then
      iPos = InStr(1, HTML, LeftTag, vbTextCompare) + Len(LeftTag)
      If DebugIt Then SpreadFlagMessage 0, "+m", "iPos: " & iPos
      If InStr(iPos, HTML, RightTag, vbTextCompare) > 0 Then
        iPos2 = InStr(iPos, HTML, RightTag, vbTextCompare)
        If DebugIt Then SpreadFlagMessage 0, "+m", "iPos2: " & iPos2
        GetNewsByWildcard = StripTags(Mid(HTML, iPos, iPos2 - iPos))
        'If DebugIt Then SpreadFlagMessage 0, "+m", "unstripped news: " & Mid(HTML, iPos, iPos2 - iPos)
      End If
    End If
  End If
End Function

Function GetNewsByTagLine(Tag, HTML)
  Dim iPos, iPos2, iPos3, News

  iPos = InStr(1, HTML, Tag, vbTextCompare)
  If DebugIt Then SpreadFlagMessage 0, "+m", "ipos: " & ipos
  If iPos > 0 Then
    iPos = iPos + Len(Tag)

    iPos2 = InStr(iPos + 1, HTML, vbCr)
    iPos3 = InStr(iPos + 1, HTML, vbLf)
    If iPos3 < iPos2 Or iPos2 = 0 Then iPos2 = iPos3

    If DebugIt Then SpreadFlagMessage 0, "+m", "ipos2: " & ipos2
    If DebugIt Then SpreadFlagMessage 0, "+m", "ipos3: " & ipos3
    If iPos2 > 0 Then
      News = Mid(HTML, iPos, iPos2 - iPos)
    ElseIf iPos2 = 0 And iPos3 = 0 Then
      News = Mid(HTML, iPos)
    End If

    If DebugIt Then SpreadFlagMessage 0, "+m", "news: " & news
  End If
  GetNewsByTagLine = StripTags(News)
End Function

Function GetNewsByWildcardedLine(Line, HTML)
  Dim Lines, i

  GetNewsByWildcardedLine = vbNullString
  Lines = Split(HTML, vbLf)

  For i = LBound(Lines) To UBound(Lines)
    If IsLike(LCase(Lines(i)), LCase("*" & Line & "*")) Then
      If DebugIt Then SpreadFlagMessage 0, "+m", "Found matching line: " & CStr(Lines(i))
      GetNewsByWildcardedLine = GetNewsByWildcard(Line, CStr(Lines(i)))
      Exit Function
    End If
  Next
  If DebugIt Then SpreadFlagMessage 0, "+m", "no matches found"
End Function

Sp33d

16.10.2004, 11:05 Uhr
Code:
',------------------------------------------------------------
'| Zhanbo Sun <zhanbos@microsoft.com>
'| http://www.winnetmag.com/Article/ArticleID/7995/7995.html
'`------------------------------------------------------------
Function IsLike(strText, match)
  Dim i, str, spec, temp, token, nPos, aInput

  str = LCase(strText)
  spec = LCase(match)

  aInput = Split(spec, "*")

  i = 0
  For Each token In aInput

    If i = 0 Then
      temp = Left(str, Len(token))
      If temp <> token Then
        IsLike = False
        Exit Function
      End If
      str = Right(str, Len(str) - Len(token))
    Else
      temp = str
      nPos = InStr(1, temp, token)
      If nPos = 0 Then
        IsLike = False
        Exit Function
      End If
      str = Right(str, Len(str) - nPos + 1 - Len(token))
    End If

    i = i + 1
  Next
  If str = vbNullString Or aInput(UBound(aInput)) = vbNullString Then
    IsLike = True
  Else
    IsLike = False
  End If
End Function

Function StripUnnecessarySpaces(Line)
  StripUnnecessarySpaces = Trim(Replace(Replace(Replace(Line, "   ", " "), "  ", " "), vbTab, " "))
End Function

  'rfc1521
  '2001 Antonin Foller, PSTRUH Software, http://pstruh.cz

Function Base64Encode(inData)
  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Dim cOut, sOut, I

  'For each group of 3 bytes
  For I = 1 To Len(inData) Step 3
    Dim nGroup, pOut, sGroup

    'Create one long from this 3 bytes.
    nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
      &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))

    'Oct splits the long To 8 groups with 3 bits
    nGroup = Oct(nGroup)

    'Add leading zeros
    nGroup = String(8 - Len(nGroup), "0") & nGroup

    'Convert To base64
    pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)

    'Add the part To OutPut string
    sOut = sOut + pOut

    'Add a new line For Each 76 chars In dest (76*3/4 = 57)
    'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
  Next
  Select Case Len(inData) Mod 3
    Case 1: '8 bit final
      sOut = Left(sOut, Len(sOut) - 2) + "=="
    Case 2: '16 bit final
      sOut = Left(sOut, Len(sOut) - 1) + "="
  End Select
  Base64Encode = sOut
End Function

Function MyASC(OneChar)
  If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function
Seiten: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
AnGelBot-Portal² > Scripting > Anfragen > UniversalTicker: Your one and only Newsticker Script ;)
Referenz-URLs