Simuloi irc kanavaa. Sisältää joinit, quitit, potkut ja viestit, käyttää xml-tiedostoa tai array:ita.
Koodi on aika huonoa ja käytää threadeja (säikeitä)
Hyödyllinen koodi, mitä se on?
Module 1
Imports System.IO
Module Module1
Dim a As String
Public topic As String
Dim Threada As System.Threading.Thread
Dim Threadb As System.Threading.Thread
Dim Threadc As System.Threading.Thread
Dim Threadd As System.Threading.Thread
Dim Threade As System.Threading.Thread
Public file As System.IO.StreamWriter
Public data_file As System.IO.StreamReader
Sub Main()
logit = False
tulosta("Tervetuloa!")
tulosta("Voit sulkea simulaattorin seuraavasti:")
tulosta("Heitä koneesi järveen")
tulosta("Tai lyö näppäimistösi enter nappia kirveelle")
tulosta("Sorsa Media ei korvaa hajonneita koneita - tai näppäimistöjä")
tulosta("Luetaan nickit,viestit sun muut")
tulosta("Haluatko logitus tilaan? (k/e) ", 0)
Do
logi = Console.ReadLine '' Otetaan vastaus
Loop While Not logi = "k" And Not logi = "e"
If logi = "k" Then
tulosta("Anna tiedoston nimi: ")
logi = Environment.CurrentDirectory + "\" & Console.ReadLine & ".log"
logit = True
End If
If Right(Environment.CommandLine(), 8) = "-xml=off" Then
tulosta("Käytetään sisäisiä tietoja")
alusta()
xml = False
ElseIf Right(Environment.CommandLine(), 7) = "-xml=on" Then
tulosta("Käytetään data.xml tiedostoa")
Alusta_xml()
xml = True
Else
tulosta("Käytetään data.xml tiedostoa")
Alusta_xml()
xml = True
End If
arvo_tilat()
topic = RandomTopic()
tulosta("* Now Talking in #sorsa-media")
tulosta_tilat()
tulosta("* Topic is '" + topic + "'")
Threada = New System.Threading.Thread(AddressOf thread) '' Annetaan säikeille ali ohjelmat
Threadb = New System.Threading.Thread(AddressOf thread2)
Threadc = New System.Threading.Thread(AddressOf thread3)
Threadd = New System.Threading.Thread(AddressOf thread4)
Threade = New System.Threading.Thread(AddressOf thread5)
Threada.Start()
Threadb.Start() '' Käynnistetään säikeet
Threadc.Start()
Threadd.Start()
Threade.Start()
End Sub
Sub thread()
Do
Randomize()
Dim temp(2) As String
temp = RandomNick()
If (temp(2) = 1) Then
Dim msgtemp As String = RandomMsg(temp(0))
If Not msgtemp = "" Then
tulosta("<" & temp(1) & temp(0) & "> " & msgtemp)
End If
End If
Threada.Sleep(Int((3000 - 0 + 1) * Rnd() + 1)) '' Odotetaan seuraavaan viestiin
Loop
End Sub
Sub thread2()
Do
Randomize()
Threadb.Sleep(Int((40000 - 0 + 1) * Rnd() + 1)) '' Odotetaan seuraavaan vaihtoon eikä vaihdeta heti
Dim temp(2) As String
temp = RandomNick()
If (temp(2) = 1) Then '' Vaihdetaan vain jos on paikalla
If (temp(1) = "@") Or (temp(1) = "%") Then '' Ja on op lisää aikaa vaihtojen välillä
tulosta("* " + temp(1) + temp(0) + " changes topic to '" + RandomTopic() + "'")
End If
End If
Loop
End Sub
Sub thread3()
Do
a = Console.ReadLine
If a = "/quit" Then '' Halutaan lopettaa
tulosta("* Disconnected")
database.AcceptChanges() '' Hyväksytään muutoksen
Dim rs As New System.IO.FileStream(Environment.CurrentDirectory + "\data.xml", System.IO.FileMode.Open)
database.WriteXml(rs) '' Tallennetaan tietokantaan (miksi ihmeessä)?
tulosta("*** Quiting")
End
ElseIf a = "/names" Then '' Näytetään kanavalla olijat
tulosta_tilat()
ElseIf a = "/topic" Then '' Näytetään topic
tulosta("* Topic is '" + topic + "'")
End If
Loop
End Sub
Sub thread4()
Do
Randomize()
If xml = False Then
Dim num As Integer
num = Int((UBound(nicks) - LBound(nicks) + 1) * Rnd() + LBound(nicks))
Threadd.Sleep(Int((50000 - 0 + 1) * Rnd() + 1))
If (nicks(num, 2) = 0) Then '' Liittyy tai poistuu kanavalta
nicks(num, 2) = 1
nicks(num, 1) = ""
tulosta("* " + nicks(num, 0) + " has joined #sorsa-media")
Else
nicks(num, 2) = 0
nicks(num, 1) = ""
Dim quitmess As String
quitmess = nicks(num, 0) ' Oma nick
tulosta("* " + nicks(num, 0) + " has quit irc (" + quitmess + ")")
End If
Else '' Xml
Dim num As Integer
num = Int(((database.Tables("nick").Rows.Count - 1) - 0 + 1) * Rnd() + 0)
Threadd.Sleep(Int((50000 - 0 + 1) * Rnd() + 1)) ' Odotetaan
If (database.Tables("nick").Rows(num).Item("paikalla") = 0) Then '' Liittyy tai poistuu kanavalta
database.Tables("nick").Rows(num).Item("paikalla") = 1
database.Tables("nick").Rows(num).Item("tila") = tilat(0)
tulosta("* " + database.Tables("nick").Rows(num).Item("nickname") + " has joined #sorsa-media")
Else
database.Tables("nick").Rows(num).Item("paikalla") = 0
database.Tables("nick").Rows(num).Item("tila") = tilat(0)
Dim quitmess As String
quitmess = database.Tables("nick").Rows(num).Item("nickname") '' Oma nick
tulosta("* " + database.Tables("nick").Rows(num).Item("nickname") + " has quit irc (" + quitmess + ")")
End If
End If
database.AcceptChanges() '' Tallennetaan taas kun on tilat vaihtunut jos on
Dim rs As New System.IO.FileStream(Environment.CurrentDirectory + "\data.xml", System.IO.FileMode.Open)
database.WriteXml(rs)
rs.Close()
Loop
End Sub
Sub thread5()
Do
If xml = False Then '' Ei xml
Randomize()
Threadb.Sleep(Int((66000 - 0 + 1) * Rnd() + 1))
Dim temp(2) As String
Dim num As Integer = Int((UBound(nicks) - LBound(nicks) + 1) * Rnd() + LBound(nicks))
temp = RandomNick()
If (temp(2) = 1) Then
If (temp(1) = "@") Or (temp(1) = "%") Then
tulosta("* " & nicks(num, 0) & " was kicked by " & temp(0) & " (" & "" & ")")
nicks(num, 1) = ""
nicks(num, 2) = 0
End If
End If
Else '' Xml
Randomize()
Threadb.Sleep(Int((66000 - 0 + 1) * Rnd() + 1))
Dim temp(2) As String
Dim num As Integer = Int(((database.Tables("nick").Rows.Count - 1) - 0 + 1) * Rnd() + 0) '' Tarvitan id
temp = RandomNick() '' Otetaan potkasija
If (temp(2) = 1) Then
If (temp(1) = "@") Or (temp(1) = "%") Then
tulosta("* " & database.Tables("nick").Rows(num).Item("nickname") & " was kicked by " & temp(0) & " (" & temp(0) & ")")
database.Tables("nick").Rows(num).Item("tila") = " "
database.Tables("nick").Rows(num).Item("paikalla") = 0
End If
End If
End If
Loop
End Sub
End ModuleModule 2
Module Module2
Public database As New DataSet("Database") '' Uusi dataset Database
Public topics(0) As String
Public nicks(0, 2) As String '' Jos haluat käyttää ei xml ei tartte muokata
Public msgs(0) As String
Public tilat(3) As String
Public logi As String
Public logit As Boolean
Public xml As Boolean
Sub alusta() '' Normaali alustus
tilat(0) = " " ' Mahdolliset tilat
tilat(1) = "+"
tilat(2) = "%"
tilat(3) = "@"
topics(0) = "käytä xml tilaa"
nicks(0, 0) = "käytä xml tilaa"
msgs(0) = "käytä xml tilaa" '' Tähän voi lisätä
End Sub
Sub Alusta_xml() '' Xml alustus
tulosta("Luetaan... data.xml")
tilat(0) = " "
tilat(1) = "+"
tilat(2) = "%"
tilat(3) = "@"
If System.IO.File.Exists(Environment.CurrentDirectory + "\data.xml") Then
Dim rs As New System.IO.FileStream(Environment.CurrentDirectory + "\data.xml", System.IO.FileMode.Open)
Dim xml_reader_database As New System.Xml.XmlTextReader(rs)
database.ReadXml(xml_reader_database) '' Luetaan
tulosta("data.xml luettu")
xml_reader_database.Close() '' Suljetaan xml lukija
tulosta("Käsitellään...")
Else
tulosta("data.xml ei löytynyt", False)
Console.ReadLine() '' Jotta näkee virheen
End
End If
End Sub
Function RandomTopic()
Randomize()
If xml = False Then
Return topics(Int((UBound(topics) - LBound(topics) + 1) * Rnd() + LBound(topics)))
Else
Return database.Tables("aiheet").Rows(((Int(((database.Tables("aiheet").Rows.Count - 1) - 0 + 1) * Rnd() + 0)))).Item(0)
End If
End Function
Function RandomNick()
Randomize()
If xml = False Then '' Ei xml
Dim temp(2) As String
Dim num As Integer
num = Int((UBound(nicks) - LBound(nicks) + 1) * Rnd() + LBound(nicks))
temp(0) = nicks(num, 0)
temp(1) = nicks(num, 1)
temp(2) = nicks(num, 2)
Return temp
Else '' Xml
Dim temp(2) As String
Dim num As Integer
num = Int(((database.Tables("nick").Rows.Count - 1) - 0 + 1) * Rnd())
temp(0) = database.Tables("nick").Rows(num).Item(0)
temp(1) = database.Tables("nick").Rows(num).Item(1)
temp(2) = database.Tables("nick").Rows(num).Item(2)
Return temp
End If
End Function
Function RandomMsg(ByVal msgnick As String)
Randomize()
If xml = False Then '' Ei xml
Dim temp As String = msgs(Int((UBound(msgs) - LBound(msgs) + 1) * Rnd() + LBound(msgs)))
Return temp
Else '' Xml
Dim temp As String
Dim temp2 As String
Dim num As Integer '' Ainut ero ei xml versioon jokaisella voi olla omat viestit (0 = kaikkien)
num = Int(((database.Tables("viestit").Rows.Count - 1) - 0 + 1) * Rnd())
temp = database.Tables("viestit").Rows(num).Item("nickname")
If temp = msgnick Or temp = "0" Then '' Vain jos on oma tai kaikkien (hidastaa)
Return database.Tables("viestit").Rows(num).Item("viesti")
End If
End If
End Function
Function TimeStamp() As String
Return "[" + TimeString + "] " ' Annetaan timestamp
End Function
Function tulosta(ByVal viesti As String, Optional ByVal vaihda_rivi As Boolean = 1, Optional ByVal ts As Boolean = 1)
If vaihda_rivi = False Then
If ts = False Then
Console.Write(viesti) '' Ei TimeStamppia tai rivin vaihtoa
Else
Console.Write(TimeStamp() & viesti) '' Time stamp ei rivi vaihtoa
End If
Else
If ts = False Then
Console.WriteLine(viesti) '' Rivi vaihto ei timestamp
Else
Console.WriteLine(TimeStamp() & viesti) '' Rivi vaihto ja TimeStamp oletus
End If
End If
If logit = True Then
file = New System.IO.StreamWriter(logi, True) '' Avataan
file.WriteLine(TimeStamp() & viesti) '' Kirjoitetaan tiedostoon
file.Close() '' Tallennetaan ja suljetaan jotta näkyisi muutokset heti
End If
End Function
Function arvo_tilat()
If xml = False Then
Dim i As Integer
For i = LBound(nicks) To UBound(nicks)
Randomize()
nicks(i, 1) = tilat(Int((UBound(tilat) - LBound(tilat) + 1) * Rnd() + LBound(tilat)))
Randomize()
nicks(i, 2) = (Int((1 - 0 + 1) * Rnd() + 0))
Next
Else
Dim i As Integer
For i = 0 To database.Tables("nick").Rows.Count - 1
Randomize()
database.Tables("nick").Rows(i).Item("tila") = tilat(Int((UBound(tilat) - LBound(tilat) + 1) * Rnd() + LBound(tilat)))
database.Tables("nick").Rows(i).Item("paikalla") = (Int((1 - 0 + 1) * Rnd() + 0))
Next
End If
End Function
Function tulosta_tilat()
Dim i As Integer
tulosta("#sorsa-media ", 0)
For i = LBound(nicks) To UBound(nicks) Step 4
On Error Resume Next
If (nicks(i, 2) = 1) Then
Console.Write(nicks(i, 1) & nicks(i, 0))
End If
If (nicks(i + 1, 2) = 1) Then
Console.Write(" " & nicks(i + 1, 1) & nicks(i + 1, 0))
End If
If (nicks(i + 2, 2) = 1) Then
Console.Write(" " & nicks(i + 2, 1) & nicks(i + 2, 0))
End If
If (nicks(i + 3, 2) = 1) Then
Console.Write(" " & nicks(i + 3, 1) & nicks(i + 3, 0))
End If
Console.Write(vbNewLine & TimeStamp() & " ")
Next
tulosta(vbNewLine & TimeStamp() & "#sorsa-media End of NAMES list.", , 0)
End Function
End Moduledata.xml
<ircsimu>
<nick>
<nickname>Tyyppi1</nickname>
<tila>0</tila>
<paikalla>0</paikalla>
</nick>
<nick>
<nickname>Tyyppi2</nickname>
<tila>0</tila>
<paikalla>0</paikalla>
</nick>
<viestit>
<nickname>Tyyppi1</nickname>
<viesti>Olen Tyyppi1</viesti>
</viestit>
<viestit>
<nickname>Tyyppi2</nickname>
<viesti>Olen Tyyppi2</viesti>
</viestit>
<viestit>
<nickname>0</nickname>
<viesti>Testi</viesti>
</viestit>
<aiheet>
<aihe>Hyvää iltapäivää</aihe>
</aiheet>
<aiheet>
<aihe>Moi.</aihe>
</aiheet>
</ircsimu>Aihe on jo aika vanha, joten et voi enää vastata siihen.