Imports SKYPE4COMLib Imports Newtonsoft Imports System.Text Imports System.Text.RegularExpressions Public Class Form1 Dim versionstring As String = "v5.5.4 coriander" Dim welcomestring As String = "Skype Bot One " + versionstring + vbNewLine + "(c)2012-2016 moose_crap" + vbNewLine + "Prefix commands with !, e.g. '!help'" Dim WithEvents sk As New Skype Dim player As New System.Media.SoundPlayer #If CONFIG = "Release" Then Dim whydir As String = "C:\apache\htdocs\images\why\" Dim linkfile As String = "C:\apache\htdocs\files\links.txt" Dim sounddir As String = "C:\saysounds\" Dim logdir As String = "C:\skypelogs\" Dim swfdir As String = "C:\apache\crazyfarmsexy\src\" Dim vlcpath As String = "C:\Program Files\VideoLAN\vlc-2.2.4\vlc.exe" #Else Dim whydir As String = "U:\apache\htdocs\images\why\" Dim linkfile As String = "links.txt" Dim sounddir As String = "U:\saysounds\" Dim logdir As String = "skypelogs" Dim swfdir As String = "U:\apache\crazyfarmsexy\src\" Dim vlcpath As String = "C:\Program Files (x86)\VideoLAN\vlc-2.2.4\vlc.exe" #End If Private Declare Function SetFocus Lib "user32.dll" (ByVal hwnd As IntPtr) As IntPtr Dim twitchclientid As String = "fdbieswwkxtoyuttjqyuwgbgzx35kmd" Dim watchedstreams() As String = {"moosecrap", "craze42", "SpamminN", "tks_ftw", "Fredstonemason", "Pastafarian45"} Dim lastcall As ICall Dim chatlist As New List(Of String) Dim soundfrequency As Integer = 5 Dim replydelay As Integer = 30 Dim lastreply As Date Dim ammo, mechs, mechskills, modules, upgrades, weapons As New List(Of MechPart) Dim voicebox As New Speech.Synthesis.SpeechSynthesizer Dim goldarblob As String 'Dim WithEvents ears As New System.Speech.Recognition.SpeechRecognizer Dim banlist As New List(Of String) Dim mlabready As Boolean = False Dim lasterror As Exception Dim lasterrormsg As String Dim limitlist As New List(Of lastmsg) Dim commonwords() As String = {"the", "of", "to", "and", "a", "in", "is", "it", "you", "that", "he", "was", "for", "on", "are", "with", "as", "i", "his", "they", "be", "at", "one", "have", "this", "from", "or", "had", "by", "hot", "but", "some", "what", "there", "we", "can", "out", "other", "were", "all", "your", "when", "up", "use", "word", "how", "said", "an", "each", "she", "which", "do", "their", "time", "if", "will", "way", "about", "many", "then", "them", "would", "write", "like", "so", "these", "her", "long", "make", "thing", "see", "him", "two", "has", "look", "more", "day", "could", "go", "come", "did", "my", "sound", "no", "most", "number", "who", "over", "know", "water", "than", "call", "first", "people", "may", "down", "side", "been", "now", "find", "any", "new", "work", "part", "take", "get", "place", "made", "live", "where", "after", "back", "little", "only", "round", "man", "year", "came", "show", "every", "good", "me", "give", "our", "under", "got"} Dim fortunes() As String = {"Bad Luck", "Average Luck", "Good Luck", "Excellent Luck", "Reply hazy, try again", "Godly Luck", "Very Bad Luck", "Outlook good", "Better not tell you now", "You will meet a dark handsome stranger", "ｷﾀ━━━━━━(ﾟ∀ﾟ)━━━━━━ !!!!", "（　´_ゝ`）ﾌｰﾝ", "Good news will come to you by mail"} Dim vlcprocess As Process Dim sw As New Diagnostics.Stopwatch Dim streams As New List(Of streamtimer) Private Class lastmsg Property handle As String Property time As DateTime End Class Private Class MechPart Property id As Integer Property name As String End Class Private Class IntString Property int As Long Property str As String End Class Private Class Sale Property Name As String Property Price As String Property Discount As String End Class Private Class streamtimer Property name As String Property live As Boolean = False Property lastlive As DateTime Public Sub New(n As String) Me.name = n End Sub End Class Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load 'PlayYouTube("RaCodgL9cvk", "1:04") 'quad.LoadFile("data.txt") 'CalcMath("(1000)/((2016-2007)*(52*40))") 'LoadMechlab() Randomize() For Each x In watchedstreams streams.Add(New streamtimer(x)) Next Label1.Text = "Skype: " + sk.Client.IsRunning.ToString voicebox.SelectVoiceByHints(Speech.Synthesis.VoiceGender.Female, Speech.Synthesis.VoiceAge.Teen) voicebox.SetOutputToDefaultAudioDevice() 'ears.LoadGrammar(New System.Speech.Recognition.DictationGrammar) End Sub Private Sub msg(ByVal pMessage As ChatMessage, ByVal Status As TChatMessageStatus) Handles sk.MessageStatus Try If pMessage.Chat.Name = "#moose_crap/$craze42;9b4dd08f6cb55896" Then goldarblob = pMessage.Chat.Blob If CheckBoxTwitch.Checked Then twitchtimer.Enabled = True End If End If 'no double posts If Status = TChatMessageStatus.cmsRead Or Status = TChatMessageStatus.cmsSending Or Status = TChatMessageStatus.cmsUnknown Then Exit Sub End If pMessage.Seen = True 'call check, temp=true means in call Dim temp As Boolean = False If sk.ActiveCalls.Count > 0 Then If sk.ActiveCalls.Item(1).PartnerHandle = pMessage.Sender.Handle Then temp = True End If If Not temp Then For Each x In sk.ActiveCalls.Item(1).Participants If CType(x, IParticipant).Handle = pMessage.Sender.Handle Then temp = True End If Next End If End If If pMessage.Sender.Handle = "moose_crap" Or pMessage.Sender.Handle = sk.CurrentUserHandle Then temp = True End If 'new chat handler If Not chatlist.Contains(pMessage.ChatName) Then log("", "Joined chat " + pMessage.Chat.FriendlyName) pMessage.Chat.SendMessage(welcomestring) chatlist.Add(pMessage.ChatName) End If 'logger Dim cleanedchatname As String = pMessage.ChatName.Replace("/", ".") FileIO.FileSystem.WriteAllText(logdir + cleanedchatname + ".txt", pMessage.Timestamp.ToString("[dd MMM yyyy HH:mm:ss] ") + pMessage.FromHandle + " > " + pMessage.Body + vbNewLine, True) 'admin only commands If pMessage.Sender.Handle = "moose_crap" Or pMessage.Sender.Handle = sk.CurrentUserHandle Then Select Case pMessage.Body Case "!why on" CheckBoxWhy.Checked = True Case "!why off" CheckBoxWhy.Checked = False Case "!links on" CheckBoxLink.Checked = True Case "!links off" CheckBoxLink.Checked = False Case "!sounds on" CheckBoxSounds.Checked = True Case "!sounds off" CheckBoxSounds.Checked = False Case "!youtube on" CheckBoxYoutube.Checked = True Case "!youtube off" CheckBoxYoutube.Checked = False Case "!hueh on" CheckBoxHueh.Checked = True Case "!hueh off" CheckBoxHueh.Checked = False Case "!limit on" CheckBoxLimit.Checked = True Case "!limit off" CheckBoxLimit.Checked = False Case "!tts on" CheckBoxTTS.Checked = True Case "!tts off" CheckBoxTTS.Checked = False Case "!stt on" CheckBoxReply.Checked = True Case "!stt off" CheckBoxReply.Checked = False Case "!error on" CheckBoxError.Checked = True Case "!error off" CheckBoxError.Checked = False Case "!weather on" CheckBoxWeather.Checked = True Case "!weather off" CheckBoxWeather.Checked = False Case "!news on" CheckBoxNews.Checked = True Case "!news off" CheckBoxNews.Checked = False Case "!reply on" CheckBoxReply.Checked = True Case "!reply off" CheckBoxReply.Checked = False Case "!voice on" CheckBoxVoice.Checked = True Case "!voice off" CheckBoxVoice.Checked = False Case "!sales on" CheckBoxMath.Checked = True Case "!sales off" CheckBoxMath.Checked = False Case "!twtich on" CheckBoxTwitch.Checked = True Case "!twitch off" CheckBoxTwitch.Checked = False Case "!swf on" CheckBoxSwf.Checked = True Case "!swf off" CheckBoxSwf.Checked = False Case "!hangup" Try For Each x In sk.ActiveCalls CType(x, ICall).Finish() Next Catch End Try Case "!pickup" lastcall.Join(lastcall.Id) Case "~" player.Stop() voicebox.SpeakAsyncCancelAll() If Not vlcprocess Is Nothing AndAlso Not vlcprocess.HasExited Then log("kill pid", vlcprocess.Id.ToString) vlcprocess.Kill() vlcprocess.WaitForExit(1000) End If Case "~tts" voicebox.SpeakAsyncCancelAll() Case "~sounds" player.Stop() Case "!error" Try If lasterror Is Nothing Then pMessage.Chat.SendMessage("No error to report") Else pMessage.Chat.SendMessage(lasterrormsg + vbNewLine + vbNewLine + lasterror.ToString + vbNewLine + lasterror.Data.ToString) End If Catch ex As Exception pMessage.Chat.SendMessage(ex.ToString) End Try Case "!list" Dim retstr As String = "" Dim i As Integer = 1 For Each x As IChat In sk.RecentChats retstr += i.ToString + " ) " + (If(x.Topic = "", x.FriendlyName, x.Topic)) + vbNewLine i += 1 Next pMessage.Chat.SendMessage(retstr) End Select If pMessage.Body.StartsWith("!override") Then If FileIO.FileSystem.FileExists(sounddir + pMessage.Body.Split(" ")(1) + ".wav") Then CheckBoxSounds.Checked = False player.SoundLocation = sounddir + pMessage.Body.Split(" ")(1) + ".wav" player.Load() player.Play() End If End If If pMessage.Body.StartsWith("!ban") And pMessage.Body.Contains(" ") Then banlist.Add(pMessage.Body.Substring(pMessage.Body.IndexOf(" ") + 1)) End If If pMessage.Body.StartsWith("!unban") And pMessage.Body.Contains(" ") Then banlist.Remove(pMessage.Body.Substring(pMessage.Body.IndexOf(" ") + 1)) End If If pMessage.Body.StartsWith("!limit") And pMessage.Body.Contains(" ") Then Try soundfrequency = CInt(pMessage.Body.Substring(pMessage.Body.IndexOf(" "))) Catch ex As Exception End Try End If If pMessage.Body.StartsWith("!delay") And pMessage.Body.Contains(" ") Then Try replydelay = CInt(pMessage.Body.Substring(pMessage.Body.IndexOf(" "))) Catch ex As Exception End Try End If If pMessage.Body.StartsWith("!say") Then sk.RecentChats(CInt(pMessage.Body.Remove(0, 5).Split(" ")(0))).SendMessage(pMessage.Body.Remove(0, 5).Remove(0, pMessage.Body.Remove(0, 5).IndexOf(" "))) End If 'If pMessage.Body.StartsWith("!messages") Then ' Dim tempchat As IChat = sk.RecentChats(pMessage.Body.Remove(0, 10).Split(" ")(0)) ' Dim retstr As String ' retstr += tempchat.Topic + vbNewLine + vbNewLine 'End If End If ''niggermode bot 'If CheckBoxNigger.Checked And pMessage.Sender.Handle <> "skype.radio.lulz" And pMessage.IsEditable Then ' Randomize() ' Dim niggeredstring As String = "" ' Dim splitstr() As String = pMessage.Body.Split(" ") ' For Each x In splitstr ' If Rnd() < 0.2 Then ' x = "nigger" ' End If ' niggeredstring += x + " " ' Next ' pMessage.Body = niggeredstring 'End If 'linkbot, hardcoded now If CheckBoxLink.Checked And pMessage.Chat.Name = "#moose_crap/$craze42;9b4dd08f6cb55896" Then If (pMessage.Body.Contains("://") Or pMessage.Body.Contains("www.")) And Not pMessage.Sender.Handle = sk.CurrentUser.Handle Then FileIO.FileSystem.WriteAllText(linkfile, pMessage.Timestamp.ToString("dd MMM yyyy HH:mm:ss ") + pMessage.Sender.FullName + " > " + pMessage.Body + vbCrLf, True) End If End If '==Everything below this line ban-restricted== If banlist.Contains(pMessage.Sender.Handle) Then Exit Sub End If If pMessage.Sender.Handle <> sk.CurrentUserHandle And CheckBoxVoice.Checked Then quad.AddString(pMessage.Body) If Regex.IsMatch(pMessage.Body, "\b(skype)?bot\b", RegexOptions.IgnoreCase) Then If Rnd() > 0.8 Then pMessage.Chat.SendMessage(quad.MakeSentence(pMessage.Body)) Else pMessage.Chat.SendMessage(quad.MakeSentence) End If End If End If 'proness If pMessage.ChatName = "#moose_crap/$craze42;9b4dd08f6cb55896" And pMessage.Sender.Handle <> sk.CurrentUserHandle Then ReplyToMessage(pMessage) 'Dim body As String = pMessage.Body 'body.Replace("weegee", "!weegee") 'body.Replace("Weegee", "!Weegee") 'body.Replace("WEEGEE", "!WEEGEE") 'body.Replace("robert", "!robert") 'body.Replace("Robert", "!Robert") 'body.Replace("ROBERT", "!ROBERT") 'body.Replace("rob ", "!rob ") 'body.Replace("Rob ", "!Rob ") 'body.Replace("ROB ", "!ROB ") 'If body <> pMessage.Body Then ' pMessage.Body = body 'End If End If 'everyones meta commands If CanPlay(pMessage.Sender.Handle) Then Select Case pMessage.Body Case "!fuckeveryoneelse" If pMessage.ChatName = "#moose_crap/$craze42;9b4dd08f6cb55896" Then player.SoundLocation = "C:\saysounds\goldar.wav" player.Load() player.Play() Threading.Thread.Sleep(2000) 'For Each X In sk.Chats ' If CType(X, IChat).Name <> "#moose_crap/$craze42;9b4dd08f6cb55896" Then ' CType(X, IChat).SendMessage("I MUST GO MY PEOPLE NEED ME") ' CType(X, IChat).Leave() ' End If 'Next For Each s In sk.ActiveCalls CType(s, ICall).Finish() Next 'sk.Chats(0).SendMessage("MY BODY IS READY") End If Case "!status" pMessage.Chat.SendMessage("Why bot: " + CheckBoxWhy.Checked.ToString + vbNewLine + "Link grabber: " + CheckBoxLink.Checked.ToString + vbNewLine + "Saysounds: " + CheckBoxSounds.Checked.ToString + vbNewLine + "YouTube: " + CheckBoxYoutube.Checked.ToString + vbNewLine + "HuehBot: " + CheckBoxHueh.Checked.ToString + vbNewLine + "Sound limiter: " + CheckBoxLimit.Checked.ToString + vbNewLine + "MechBot: " + CheckBoxMech.Checked.ToString + vbNewLine + "TTS: " + CheckBoxTTS.Checked.ToString + vbNewLine + "Replybot: " + CheckBoxReply.Checked.ToString + vbNewLine + "Error Reporting: " + CheckBoxError.Checked.ToString + vbNewLine + "Weather: " + CheckBoxWeather.Checked.ToString + vbNewLine + "Skynet: " + CheckBoxVoice.Checked.ToString + vbNewLine + "News: " + CheckBoxNews.Checked.ToString + vbNewLine + "Steam sales: " + CheckBoxMath.Checked.ToString + vbNewLine + "Twitch notifications: " + CheckBoxTwitch.Checked.ToString + vbNewLine + "Swfbot: " + CheckBoxSwf.Checked.ToString + vbNewLine + "Calls: " + sk.ActiveCalls.Count.ToString) Case "!help" pMessage.Chat.SendMessage("Current public commands are:" & vbNewLine & "!status View current status" & vbNewLine & "!help Display this message" & vbNewLine & "~[sounds|tts|youtube] Stop sounds" & vbNewLine & "!play [url/id/video search] Play YouTube video" & vbNewLine & "!speak [text] Text to speech" & vbNewLine & "!banlist View ban list" & vbNewLine & "!weather Weather forecast (NOAA)" & vbNewLine & "!eweather Extended forecast" & vbNewLine & "!news News (drudgereport.com)" & vbNewLine & "!reloadmechlab Reload mechlab data (use if it's not working)" & vbNewLine & "!newsounds List new sounds" & vbNewLine & "!bingo SNB countdown" & vbNewLine & "!sales Steam sales" & vbNewLine & "!start/!stop/!time Run timer" & vbNewLine & "!fortune Get your fortune" & vbNewLine & "!motd" & vbNewLine & "!version") Case "!banlist" Dim s As String = "Banned users:" + vbNewLine For Each x In banlist s += x s += vbNewLine Next pMessage.Chat.SendMessage(s) Case "!weather" If CheckBoxWeather.Checked Then Dim wc As New Net.WebClient wc.Headers.Add("User-Agent: Mozilla/5.0 (Windows NT 6.3; rv:36.0) Gecko/20100101 Firefox/36.0") Dim xmlstr As String = wc.DownloadString("http://forecast.weather.gov/MapClick.php?lat=47.80948&lon=-122.26049423217773&unit=0&lg=english&FcstType=dwml") Dim xdoc As New Xml.XmlDocument xdoc.LoadXml(xmlstr) Dim dlist As New List(Of String) Dim wlist As New List(Of String) Dim retstr As String = "" Dim typestr As String = xdoc.SelectSingleNode("dwml/data/parameters/wordedForecast").Attributes("time-layout").Value For Each x In xdoc.SelectNodes("dwml/data/time-layout[layout-key='" + typestr + "']/start-valid-time") dlist.Add(CType(x, Xml.XmlNode).Attributes("period-name").Value) Next For Each x As Xml.XmlNode In xdoc.SelectNodes("dwml/data/parameters/wordedForecast/text") wlist.Add(x.InnerText) Next For i = 0 To 6 If Not dlist(i).Contains("Night") Then retstr += dlist(i) + ": " + wlist(i) + vbNewLine + vbNewLine End If Next pMessage.Chat.SendMessage(retstr) End If Case "!eweather" If CheckBoxWeather.Checked Then Dim wc As New Net.WebClient wc.Headers.Add("User-Agent: Mozilla/5.0 (Windows NT 6.3; rv:36.0) Gecko/20100101 Firefox/36.0") Dim xmlstr As String = wc.DownloadString("http://forecast.weather.gov/MapClick.php?lat=47.80948&lon=-122.26049423217773&unit=0&lg=english&FcstType=dwml") Dim xdoc As New Xml.XmlDocument xdoc.LoadXml(xmlstr) Dim dlist As New List(Of String) Dim wlist As New List(Of String) Dim retstr As String = "" Dim typestr As String = xdoc.SelectSingleNode("dwml/data/parameters/wordedForecast").Attributes("time-layout").Value For Each x In xdoc.SelectNodes("dwml/data/time-layout[layout-key='" + typestr + "']/start-valid-time") dlist.Add(CType(x, Xml.XmlNode).Attributes("period-name").Value) Next For Each x As Xml.XmlNode In xdoc.SelectNodes("dwml/data/parameters/wordedForecast/text") wlist.Add(x.InnerText) Next For i = 0 To dlist.Count - 1 retstr += dlist(i) + ": " + wlist(i) + vbNewLine + vbNewLine Next pMessage.Chat.SendMessage(retstr) End If Case "!news" If CheckBoxNews.Checked Then Dim drudge As String Dim wc As New Net.WebClient drudge = wc.DownloadString("http://www.drudgereport.com/") Dim splitstr() As String = drudge.Split(vbCrLf) drudge = splitstr.First(Function(x) x.Contains("")) Dim link As String = drudge.Substring(drudge.IndexOf("HREF=") + 6, drudge.LastIndexOf("""") - (drudge.IndexOf("HREF=") + 6)) Dim title As String = drudge.Substring(drudge.LastIndexOf(""">") + 2, drudge.LastIndexOf("") - (drudge.LastIndexOf(""">")) - 2) pMessage.Chat.SendMessage(title + vbNewLine + link) End If Case "!reloadmechlab" If CheckBoxMech.Checked Then LoadMechlab() pMessage.Chat.SendMessage("Mechlab reloaded: " + ammo.Count.ToString + " " + mechs.Count.ToString + " " + mechskills.Count.ToString + " " + modules.Count.ToString + " " + upgrades.Count.ToString + " " + weapons.Count.ToString) End If Case "!newsounds" Dim files As New List(Of IntString) Dim fi As IO.FileInfo For Each x In FileIO.FileSystem.GetFiles(sounddir) fi = FileIO.FileSystem.GetFileInfo(x) Dim intstr As New IntString intstr.int = fi.LastWriteTimeUtc.Ticks intstr.str = fi.Name.Split({".wav"}, StringSplitOptions.None)(0) files.Add(intstr) Next files.Sort(Function(a As IntString, b As IntString) a.int.CompareTo(b.int)) Dim retstr As String = "New sounds:" + vbNewLine For i = files.Count - 1 To files.Count - 11 Step -1 retstr += files(i).str + vbNewLine Next pMessage.Chat.SendMessage(retstr) Case "!version" pMessage.Chat.SendMessage(versionstring + vbNewLine + "Build date: " + FileIO.FileSystem.GetFileInfo("SKYPE BOT ONE.exe").LastWriteTime.ToString("MM\/dd\/yyyy")) Case "!motd" pMessage.Chat.SendMessage("( ͡° ͜ʖ ͡°)") Case "!bingo" Dim nextsaturday As Date = Now While nextsaturday.DayOfWeek <> DayOfWeek.Saturday nextsaturday = nextsaturday.AddDays(1) End While Dim bingostarttime As New Date(nextsaturday.Year, nextsaturday.Month, nextsaturday.Day, 18, 30, 0, 0) If ((Now - bingostarttime).TotalHours < 4) And ((Now - bingostarttime).TotalHours >= 0) Then 'bingo in progress pMessage.Chat.SendMessage("ITS HAPPENING (yn)") Else pMessage.Chat.SendMessage((bingostarttime - Now).ToString("d' days 'h' hours 'm' minutes 's' seconds until bingo!'")) End If Case "!sales" 'If CheckBoxMath.Checked Then ' Dim steampage As String ' Dim wc As New Net.WebClient ' wc.Encoding = Encoding.UTF8 ' steampage = wc.DownloadString("http://store.steampowered.com/mobilestorefront") ' 'dailydeals, comchoice, flashsales,voting ' Dim unixtimes As New List(Of Date) ' For Each x As Match In Regex.Matches(steampage, "VCountdown\(\s(\d+)") ' unixtimes.Add(New Date(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc) + New TimeSpan(0, 0, CInt(x.Groups(1).Value))) ' Next ' Dim names As New List(Of String) ' Dim percents As New List(Of String) ' Dim prices As New List(Of String) ' For Each x As Match In Regex.Matches(steampage, "alt=""(.+)""") ' names.Add(x.Groups(1).Value) ' Next ' For Each x As Match In Regex.Matches(steampage, "
(.+?)
") ' percents.Add(x.Groups(1).Value) ' Next ' For Each x As Match In Regex.Matches(steampage, "
(.+?)
") ' prices.Add(x.Groups(1).Value.Replace("$", "$")) ' Next ' For Each x As Match In Regex.Matches(steampage, "

\r\n\s+(.+?)\s+?

") ' names.Add(x.Groups(1).Value) ' Next ' Dim dailydeals(8) As Sale ' For i = 0 To 8 ' Dim s As New Sale ' s.Name = names(i) ' s.Discount = percents(i) ' s.Price = prices(i) ' dailydeals(i) = s ' Next ' Array.Sort(dailydeals, Function(a As Sale, b As Sale) a.Name.CompareTo(b.Name)) ' Dim communitychoice As String = Regex.Match(steampage, "(.+?)").Groups(1).Value ' Dim flashsales(3) As Sale ' For i = 0 To 3 ' Dim s As New Sale ' s.Name = names(i + 9) ' s.Discount = percents(i + 9) ' s.Price = prices(i + 9) ' flashsales(i) = s ' Next ' Array.Sort(flashsales, Function(a As Sale, b As Sale) a.Name.CompareTo(b.Name)) ' Dim yesterdaydeals(8) As Sale ' For i = 0 To 8 ' Dim s As New Sale ' s.Name = names(i + 13) ' s.Discount = percents(i + 13) ' s.Price = prices(i + 13) ' yesterdaydeals(i) = s ' Next ' Array.Sort(yesterdaydeals, Function(a As Sale, b As Sale) a.Name.CompareTo(b.Name)) ' Dim retstring As New StringBuilder ' retstring.AppendLine("Daily Deals (" & (Date.UtcNow - unixtimes(0)).ToString("h\:mm\:ss") & ") :") ' For Each x In dailydeals ' retstring.AppendLine(" " & x.Name & " - " & x.Price & " [" & x.Discount & "]") ' Next ' retstring.AppendLine() ' retstring.AppendLine("Community Choice (" & (Date.UtcNow - unixtimes(1)).ToString("h\:mm\:ss") & "), voting ends in " & (Date.UtcNow - unixtimes(3)).ToString("h\:mm\:ss") & " :") ' retstring.AppendLine(" " & communitychoice) ' retstring.AppendLine() ' retstring.AppendLine("Flash sales (" & (Date.UtcNow - unixtimes(2)).ToString("h\:mm\:ss") & ") :") ' For Each x In flashsales ' retstring.AppendLine(" " & x.Name & " - " & x.Price & " [" & x.Discount & "]") ' Next ' retstring.AppendLine() ' retstring.AppendLine("Yesterday's Deals (" & (Date.UtcNow - unixtimes(0)).ToString("h\:mm\:ss") & ") :") ' For Each x In yesterdaydeals ' retstring.AppendLine(" " & x.Name & " - " & x.Price & " [" & x.Discount & "]") ' Next ' pMessage.Chat.SendMessage(retstring.ToString) 'End If Case "!start" sw.Reset() sw.Start() pMessage.Chat.SendMessage("Started timer") Case "!stop" sw.Stop() pMessage.Chat.SendMessage("Elapsed time: " & sw.Elapsed.ToString("d\:hh\:mm\:ss\.fff")) Case "!time" pMessage.Chat.SendMessage("Elapsed time: " & sw.Elapsed.ToString("d\:hh\:mm\:ss\.fff")) Case "!fortune" pMessage.Chat.SendMessage("Your fortune: " & fortunes(Math.Floor(fortunes.Count * Rnd()))) End Select End If 'hueh bot If (Me.CheckBoxHueh.Checked AndAlso (((pMessage.Body.ToLower.StartsWith("hue ") Or pMessage.Body.ToLower.StartsWith("hueh ")) Or (pMessage.Body.ToLower = "hue")) Or (pMessage.Body.ToLower = "hueh"))) Then Dim strArray As String() = pMessage.Body.Split(" ".ToCharArray) Dim num As Integer = 0 Dim str4 As String For Each str4 In strArray If ((str4.ToLower = "hue") Or (str4.ToLower = "hueh")) Then num += 1 Else num = 0 Exit For End If Next If (num <> 0) Then pMessage.Chat.SendMessage(String.Concat(New String() {num.ToString, " BR", If((num > 1), "s", ""), " from ", pMessage.Sender.FullName, "!"})) End If End If 'whybot If (CheckBoxWhy.Checked) And (pMessage.Body.EndsWith(".jpg") Or pMessage.Body.EndsWith(".gif") Or pMessage.Body.EndsWith(".png")) And Not pMessage.Body.Contains("..") Then Dim str As String = pMessage.Body.Substring(0, pMessage.Body.LastIndexOf(".")) If FileIO.FileSystem.FileExists(whydir + str + ".jpg") Then pMessage.Chat.SendMessage("http://long-cat.net/images/why/" + str.Replace(" ", "%20") + ".jpg") ElseIf FileIO.FileSystem.FileExists(whydir + str + ".png") Then pMessage.Chat.SendMessage("http://long-cat.net/images/why/" + str.Replace(" ", "%20") + ".png") ElseIf FileIO.FileSystem.FileExists(whydir + str + ".gif") Then pMessage.Chat.SendMessage("http://long-cat.net/images/why/" + str.Replace(" ", "%20") + ".gif") End If End If 'swfbot If CheckBoxSwf.Checked And Regex.IsMatch(pMessage.Body, "^[^\\/]+\.swf$") Then If FileIO.FileSystem.FileExists(swfdir & pMessage.Body) Then pMessage.Chat.SendMessage("http://crazyfarmsexy.com/?swf=" & pMessage.Body.Replace(" ", "%20")) End If End If 'mechbot 'http://mwo.smurfy-net.de/mechlab#i=35&l=bd5cf5dab9f1b4783f1462c65539f4fe50a05404 If CheckBoxMech.Checked Then If pMessage.Body.StartsWith("http://mwo.smurfy-net.de/mechlab") Then Dim mechid As String = pMessage.Body.Substring(pMessage.Body.IndexOf("#") + 3, pMessage.Body.IndexOf("&") - pMessage.Body.IndexOf("#") - 3) Dim id As String = System.Web.HttpUtility.ParseQueryString(pMessage.Body)("l") pMessage.Chat.SendMessage(ParseLoadout(mechid, id)) End If End If If temp = False Then Exit Sub End If '=========EVERYTHING BELOW THIS LINE IS INCALL ONLY============ Select Case pMessage.Body Case "~" If CheckBoxSounds.Checked = True Then player.Stop() End If If CheckBoxYoutube.Checked Then If Not vlcprocess Is Nothing AndAlso Not vlcprocess.HasExited Then vlcprocess.Kill() End If End If If CheckBoxTTS.Checked Then voicebox.SpeakAsyncCancelAll() End If Case "~tts" If CheckBoxTTS.Checked Then voicebox.SpeakAsyncCancelAll() End If Case "~sounds" If CheckBoxSounds.Checked Then player.Stop() End If Case "~youtube" If CheckBoxYoutube.Checked Then If Not vlcprocess Is Nothing AndAlso Not vlcprocess.HasExited Then vlcprocess.CloseMainWindow() vlcprocess.WaitForExit(1000) End If End If End Select 'TTS bot If CheckBoxTTS.Checked And pMessage.Body.StartsWith("!speak") Then voicebox.SpeakAsync(pMessage.Body.Substring(pMessage.Body.IndexOf(" ") + 1)) log("", "TTS: " + pMessage.Body.Substring(pMessage.Body.IndexOf(" ") + 1)) End If If CheckBoxYoutube.Checked Then Dim ytmatch As Match = Regex.Match(pMessage.Body, "(?<=!play (https?://)?(www\.)?(youtu(be.com/watch([&?]\w+=\w*)*[&?]v=|\.be/))?)[a-z0-9\-_]{11}", RegexOptions.IgnoreCase) 'Dim ytmatch As Match = Regex.Match(pMessage.Body, "(?<=!play .*(youtu.be/|[&?v=]))[a-z0-9\-_]{11}", RegexOptions.IgnoreCase) If ytmatch.Success AndAlso CanPlay(pMessage.Sender.Handle) Then Dim timematch As Match = Regex.Match(pMessage.Body, "(?<=t=)(\d{1,2}h)?(\d{1,2}m)?\d{1,4}s?(?=$)") If timematch.Success Then PlayYouTube(ytmatch.Value, Regex.Replace(timematch.Value, "[HMhm]", ":").Replace("s", "")) Else PlayYouTube(ytmatch.Value, ) End If ElseIf Regex.Match(pMessage.Body, "(?<=^!play ).+$").Success AndAlso CanPlay(pMessage.Sender.Handle) Then ytmatch = Regex.Match(pMessage.Body, "(?<=^!play ).+$") Dim wc As New Net.WebClient wc.Encoding = System.Text.Encoding.UTF8 Dim searchstr As String = wc.DownloadString("https://www.youtube.com/results?search_query=" & ytmatch.Value) ytmatch = Regex.Match(searchstr, "(?<=href=""/watch\?v=)[a-z0-9\-_]{11}", RegexOptions.IgnoreCase) Dim vid As String = ytmatch.Value PlayYouTube(vid, ) ytmatch = Regex.Match(searchstr, "(?<=]*href=""/watch\?v=" & vid & "[^>]*title=\"").*?(?=\"")", RegexOptions.IgnoreCase) Dim retstring As String = "Playing """ & ytmatch.Value & """" & vbNewLine ytmatch = Regex.Match(searchstr, "(?<= - Duration: )[0-9:]*?(?=.<)", RegexOptions.IgnoreCase) retstring &= "Duration: " & ytmatch.Value & vbNewLine ytmatch = Regex.Match(searchstr, "(?<=
  • )[0-9,]*(?= views
    • )", RegexOptions.IgnoreCase) retstring &= "Views: " & ytmatch.Value & vbNewLine & "http://youtu.be/" & vid pMessage.Chat.SendMessage(retstring) End If End If If CheckBoxSounds.Checked And (sk.ActiveCalls.Count) Then If FileIO.FileSystem.FileExists(sounddir + pMessage.Body + ".wav") AndAlso CanPlay(pMessage.Sender.Handle) Then If pMessage.Body.Contains("..\") Then pMessage.Chat.SendMessage("NO FUCK YOU") Exit Sub End If If Now.Month = 4 And Now.Day = 1 Then 'april fools Dim soundlist As List(Of String) soundlist = FileIO.FileSystem.GetFiles(sounddir).ToList player.SoundLocation = soundlist(Math.Floor(Rnd() * soundlist.Count)) player.Load() player.Play() Else player.SoundLocation = sounddir + pMessage.Body + ".wav" player.Load() player.Play() log(pMessage.Sender.Handle, pMessage.Body) End If End If End If 'Math bot If CheckBoxMath.Checked AndAlso pMessage.Body.EndsWith("=") Then pMessage.Chat.SendMessage(CalcMath(pMessage.Body.TrimEnd("="))) End If Catch ex As Exception FileIO.FileSystem.WriteAllText("error.log", lasterrormsg + vbNewLine + vbNewLine + lasterror.ToString + vbNewLine + lasterror.Data.ToString + "================", True) lasterror = ex lasterrormsg = Now.ToString + " """ + pMessage.Sender.Handle + """ > " + pMessage.Body If CheckBoxError.Checked Then pMessage.Chat.SendMessage("Error!") End If End Try End Sub Private Function CalcMath(ByVal eqn As String) As Double 'return if we're passed a straight number If Double.TryParse(eqn, Nothing) Then Return CDbl(eqn) End If eqn = Regex.Replace(eqn, "\be\b", Math.E.ToString) eqn = Regex.Replace(eqn, "\bpi\b", Math.PI.ToString) For Each funmatch As Match In Regex.Matches(eqn, "([a-z]+)\((.+)\)") Select Case funmatch.Groups(1).Value Case "sin" eqn = eqn.Replace(funmatch.Value, Math.Sin(CalcMath(funmatch.Groups(2).Value) * Math.PI / 180)) Case "cos" eqn = eqn.Replace(funmatch.Value, Math.Cos(CalcMath(funmatch.Groups(2).Value) * Math.PI / 180)) Case "tan" eqn = eqn.Replace(funmatch.Value, Math.Tan(CalcMath(funmatch.Groups(2).Value) * Math.PI / 180)) Case "asin" eqn = eqn.Replace(funmatch.Value, Math.Asin(CalcMath(funmatch.Groups(2).Value)) * 180 / Math.PI) Case "acos" eqn = eqn.Replace(funmatch.Value, Math.Acos(CalcMath(funmatch.Groups(2).Value)) * 180 / Math.PI) Case "atan" eqn = eqn.Replace(funmatch.Value, Math.Atan(CalcMath(funmatch.Groups(2).Value)) * 180 / Math.PI) Case "abs" eqn = eqn.Replace(funmatch.Value, Math.Abs(CalcMath(funmatch.Groups(2).Value))) Case "exp" eqn = eqn.Replace(funmatch.Value, Math.Exp(CalcMath(funmatch.Groups(2).Value))) Case "ln" eqn = eqn.Replace(funmatch.Value, Math.Log(CalcMath(funmatch.Groups(2).Value))) Case "log" eqn = eqn.Replace(funmatch.Value, Math.Log10(CalcMath(funmatch.Groups(2).Value))) Case "sinh" eqn = eqn.Replace(funmatch.Value, Math.Sinh(CalcMath(funmatch.Groups(2).Value))) Case "cosh" eqn = eqn.Replace(funmatch.Value, Math.Cosh(CalcMath(funmatch.Groups(2).Value))) Case "tanh" eqn = eqn.Replace(funmatch.Value, Math.Tanh(CalcMath(funmatch.Groups(2).Value))) Case "sqrt" eqn = eqn.Replace(funmatch.Value, Math.Sqrt(CalcMath(funmatch.Groups(2).Value))) Case "sign" eqn = eqn.Replace(funmatch.Value, Math.Sign(CalcMath(funmatch.Groups(2).Value))) Case "round" eqn = eqn.Replace(funmatch.Value, Math.Round(CalcMath(funmatch.Groups(2).Value))) Case "ceiling" eqn = eqn.Replace(funmatch.Value, Math.Ceiling(CalcMath(funmatch.Groups(2).Value))) Case "floor" eqn = eqn.Replace(funmatch.Value, Math.Floor(CalcMath(funmatch.Groups(2).Value))) Case "truncate" eqn = eqn.Replace(funmatch.Value, Math.Truncate(CalcMath(funmatch.Groups(2).Value))) Case Else eqn = Double.NaN.ToString End Select Next For Each parmatch As Match In Regex.Matches(eqn, "\((.+?)\)") eqn = eqn.Replace(parmatch.Value, CalcMath(parmatch.Groups(1).Value)) Next Dim floatmatch As String = "-?\d+\.?\d*([eE][+-]?\d+)?" Dim exmatch As Match While Regex.IsMatch(eqn, "(?" & floatmatch & ")\s*\^\s*(?" & floatmatch & ")") exmatch = Regex.Match(eqn, "(?" & floatmatch & ")\s*\^\s*(?" & floatmatch & ")") eqn = eqn.Replace(exmatch.Value, CStr(CDbl(exmatch.Groups("l").Value) ^ CDbl(exmatch.Groups("r").Value))) End While Dim multmatch As Match While Regex.IsMatch(eqn, "(?" & floatmatch & ")\s*\*\s*(?" & floatmatch & ")") multmatch = Regex.Match(eqn, "(?" & floatmatch & ")\s*\*\s*(?" & floatmatch & ")") eqn = eqn.Replace(multmatch.Value, CStr(CDbl(multmatch.Groups("l").Value) * CDbl(multmatch.Groups("r").Value))) End While Dim divmatch As Match While Regex.IsMatch(eqn, "(?" & floatmatch & ")\s*\\\s*(?" & floatmatch & ")") divmatch = Regex.Match(eqn, "(?" & floatmatch & ")\s*\\\s*(?" & floatmatch & ")") eqn = eqn.Replace(divmatch.Value, CStr(CDbl(divmatch.Groups("l").Value) \ CDbl(divmatch.Groups("r").Value))) End While Dim modmatch As Match While Regex.IsMatch(eqn, "(?" & floatmatch & ")\s*\%\s*(?" & floatmatch & ")") modmatch = Regex.Match(eqn, "(?" & floatmatch & ")\s*\%\s*(?" & floatmatch & ")") eqn = eqn.Replace(modmatch.Value, CStr(CDbl(modmatch.Groups("l").Value) Mod CDbl(modmatch.Groups("r").Value))) End While Dim quotmatch As Match While Regex.IsMatch(eqn, "(?" & floatmatch & ")\s*\/\s*(?" & floatmatch & ")") quotmatch = Regex.Match(eqn, "(?" & floatmatch & ")\s*\/\s*(?" & floatmatch & ")") eqn = eqn.Replace(quotmatch.Value, CStr(CDbl(quotmatch.Groups("l").Value) / CDbl(quotmatch.Groups("r").Value))) End While Dim addmatch As Match While Regex.IsMatch(eqn, "(?" & floatmatch & ")\s*\+\s*(?" & floatmatch & ")") addmatch = Regex.Match(eqn, "(?" & floatmatch & ")\s*\+\s*(?" & floatmatch & ")") eqn = eqn.Replace(addmatch.Value, CStr(CDbl(addmatch.Groups("l").Value) + CDbl(addmatch.Groups("r").Value))) End While Dim submatch As Match While Regex.IsMatch(eqn, "(?" & floatmatch & ")\s*\-\s*(?" & floatmatch & ")") submatch = Regex.Match(eqn, "(?" & floatmatch & ")\s*\-\s*(?" & floatmatch & ")") eqn = eqn.Replace(submatch.Value, CStr(CDbl(submatch.Groups("l").Value) - CDbl(submatch.Groups("r").Value))) End While Return CDbl(eqn) End Function Private Sub callhandler(ByVal pCall As SKYPE4COMLib.Call, ByVal Status As TCallStatus) Handles sk.CallStatus log("", pCall.Id & ": " & [Enum].GetName(GetType(TCallStatus), Status)) For Each x In sk.ActiveCalls If (CType(x, ICall).Status = TCallStatus.clsInProgress) And (CType(x, ICall).Id <> pCall.Id) Then pCall.Finish() log("local", "rejected call") Exit Sub End If Next If Status = TCallStatus.clsRinging Then 'log("", "Picked up " + pCall.Id.ToString) pCall.Answer() lastcall = pCall ElseIf Status = TCallStatus.clsInProgress Then 'If CheckBoxRecord.Checked Then ' Dim cmd As New System.Diagnostics.ProcessStartInfo ' Dim proc As Process ' Dim filename As String = "C:\skypecalls\" & Now.ToString("yyyy-MM-dd-HH-mm-ss") & ".opus" ' With cmd ' .FileName = "C:\bin\ffmpeg.exe" ' .WorkingDirectory = "C:\bin" ' .UseShellExecute = False ' .Arguments = "-y -f dshow -ac 2 -i audio=""Virtual Cable 1"" -f dshow -ac 2 -i audio=""Virtual Cable 2"" -filter_complex amix -c:a libopus -vbr on -application voip -frame_duration 60 -b:a 16384 " & filename ' .CreateNoWindow = False ' .RedirectStandardInput = True ' .RedirectStandardOutput = False ' End With ' proc = System.Diagnostics.Process.Start(cmd) ' proc.PriorityClass = ProcessPriorityClass.BelowNormal ' ffmpeginput = proc.StandardInput 'End If ElseIf Status = TCallStatus.clsFailed Or Status = TCallStatus.clsCancelled Or Status = TCallStatus.clsFinished Then 'log("", "Finished call " & pCall.Id.ToString) 'If CheckBoxRecord.Checked Then ' ffmpeginput.Write("q") ' ffmpeginput = Nothing 'End If End If End Sub Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Try lastcall = sk.ActiveCalls.Item(1) Catch ex As Exception End Try If sk.Client.IsRunning = False Then sk.Timeout = 240000 sk.Client.Start() End If sk.Attach() Label1.Text = "Skype: Running" Label2.Text = "Version: " + sk.Version Label3.Text = "Screen Name: " + sk.CurrentUserHandle Label5.Text = "Status: " + sk.CurrentUserStatus.ToString Label4.Text = "Protocol: " + sk.Protocol.ToString End Sub Private Sub LoadMechlab() ammo.Clear() mechs.Clear() mechskills.Clear() modules.Clear() upgrades.Clear() weapons.Clear() Dim wc As New Net.WebClient Dim page As String = wc.DownloadString("http://mwo.smurfy-net.de/mechlab") Dim url As String = Regex.Match(page, "(?<=)").Value Dim data_mechs As String = HttpUtility.HtmlDecode(wc.DownloadString("http://mwo.smurfy-net.de" & url)) data_mechs = data_mechs.Substring(38, data_mechs.Length - 38 - 7) Dim mlist As Xml.XmlNodeList Dim xdoc As Xml.XmlDocument = Newtonsoft.Json.JsonConvert.DeserializeXmlNode(data_mechs, "mechlab") mlist = xdoc.SelectNodes("mechlab/mechs/*/family") For Each x As Xml.XmlNode In mlist Dim newpart As New MechPart newpart.id = x.ParentNode.Name newpart.name = StringToProper(x.InnerText, " ", {}) If x.ParentNode.SelectNodes("translated_name")(0).InnerText.Contains("-") Then newpart.name += x.ParentNode.SelectNodes("translated_name")(0).InnerText.Substring(x.ParentNode.SelectNodes("translated_name")(0).InnerText.IndexOf("-")) 'non hero mech Else 'hero mech newpart.name = StringToProper(x.ParentNode.SelectNodes("translated_name")(0).InnerText) End If mechs.Add(newpart) Next mlist = xdoc.SelectNodes("mechlab/weapons/*/translatedName") For Each x As Xml.XmlNode In mlist Dim newpart As New MechPart newpart.id = x.ParentNode.Name newpart.name = StringToProper(x.InnerText) weapons.Add(newpart) Next mlist = xdoc.SelectNodes("mechlab/modules/*/translatedName") For Each x As Xml.XmlNode In mlist Dim newpart As New MechPart newpart.id = x.ParentNode.Name newpart.name = StringToProper(x.InnerText) modules.Add(newpart) Next mlist = xdoc.SelectNodes("mechlab/ammo/*/translatedName") For Each x As Xml.XmlNode In mlist Dim newpart As New MechPart newpart.id = x.ParentNode.Name newpart.name = StringToProper(x.InnerText) ammo.Add(newpart) Next mlist = xdoc.SelectNodes("mechlab/upgrades/*/translatedName") For Each x As Xml.XmlNode In mlist Dim newpart As New MechPart newpart.id = x.ParentNode.Name newpart.name = StringToProper(x.InnerText) upgrades.Add(newpart) Next mlist = xdoc.SelectNodes("mechlab/mechskills/*/translatedName") log("", "Mechlab loaded") mlabready = True End Sub Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click TextBox1.Text = "" End Sub Private Sub TextBox2_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles TextBox2.KeyDown If e.KeyData = Keys.Enter Then If FileIO.FileSystem.FileExists(sounddir + TextBox2.Text + ".wav") Then log("localshell", "played " + TextBox2.Text) player.SoundLocation = sounddir + TextBox2.Text + ".wav" player.Load() player.Play() End If TextBox2.Text = "" End If End Sub Public Sub log(ByVal user As String, ByVal op As String) TextBox1.Text = Now.ToString("dd MMM yyyy HH:mm:ss ") + user + " > " + op + vbCrLf + TextBox1.Text End Sub Private Function CanPlay(ByVal handle As String) As Boolean If CheckBoxLimit.Checked = False Or handle = "moose_crap" Then Return True End If Dim num As Integer = limitlist.FindIndex(Function(x) x.handle = handle) If num = -1 Then Dim item As New lastmsg item.handle = handle item.time = Now Me.limitlist.Add(item) Return True End If Dim span As TimeSpan = Now - limitlist(num).time If span.TotalSeconds < soundfrequency Then sk.SendMessage(handle, "Woah there! You've got to wait a while before sending another command.") Return False Else limitlist(num).time = Now Return True End If End Function Private Class TfwNoGF Property name As String Property count As Integer End Class Private Function ParseLoadout(ByVal mechid As String, ByVal id As String) As String Dim wc As New System.Net.WebClient Dim unparseddata As String = wc.DownloadString("http://mwo.smurfy-net.de/mechlab/loadouts/" + mechid + "/" + id) Dim parsedxml As Xml.XmlDocument = Json.JsonConvert.DeserializeXmlNode(unparseddata, "loadout") Dim retstring As String = "" retstring = mechs.Find(Function(t) t.id = parsedxml.SelectSingleNode("loadout/mech_id").InnerText).name + vbNewLine + vbNewLine + "==Weapons==" + vbNewLine Dim m As New List(Of String) For Each x As Xml.XmlNode In parsedxml.SelectNodes("loadout/configuration/*[type='weapon']/id") m.Add(weapons.Find(Function(t) t.id = x.InnerText).name) Next m.Sort() For Each x In m retstring += (x + vbNewLine) Next retstring += vbNewLine + "==Modules==" + vbNewLine Dim modulelist As New List(Of TfwNoGF) For Each x As Xml.XmlNode In parsedxml.SelectNodes("loadout/configuration/*[type='module']/id") Dim modname As String = modules.Find(Function(t) t.id = x.InnerText).name Dim foundindex As Integer = modulelist.FindIndex(Function(q) q.name = modname) If foundindex = -1 Then Dim newgf As New TfwNoGF newgf.count = 1 newgf.name = modname modulelist.Add(newgf) Else modulelist(foundindex).count += 1 End If Next For Each x In modulelist If x.count = 1 Then retstring += x.name + vbNewLine Else retstring += x.name + " x" + x.count.ToString + vbNewLine End If Next retstring += vbNewLine + "==Upgrades==" + vbNewLine m.Clear() For Each x As Xml.XmlNode In parsedxml.SelectNodes("loadout/upgrades/id") m.Add(upgrades.Find(Function(t) t.id = x.InnerText).name) Next For Each x In m retstring += (x + vbNewLine) Next retstring += vbNewLine retstring += "==Ammo==" + vbNewLine modulelist.Clear() For Each x As Xml.XmlNode In parsedxml.SelectNodes("loadout/configuration/*[type='ammo']/id") Dim modname As String = ammo.Find(Function(t) t.id = x.InnerText).name Dim foundindex As Integer = modulelist.FindIndex(Function(q) q.name = modname) If foundindex = -1 Then Dim newgf As New TfwNoGF newgf.count = 1 newgf.name = modname modulelist.Add(newgf) Else modulelist(foundindex).count += 1 End If Next For Each x In modulelist If x.count = 1 Then retstring += x.name + vbNewLine Else retstring += x.name + " x" + x.count.ToString + vbNewLine End If Next retstring += vbNewLine Dim armor As Integer = 0 For Each x As Xml.XmlNode In parsedxml.SelectNodes("loadout/configuration/armor") armor += x.InnerText Next retstring += "Total armor: " + armor.ToString Return retstring End Function Private Sub Button4_Click(sender As System.Object, e As System.EventArgs) Handles Button4.Click player.Stop() End Sub ''' ''' Changes an all-caps string into a proper-capitalized string using defualt values ''' ''' Input string to change ''' Fixed string ''' Private Overloads Function StringToProper(str As String) As String If str.StartsWith("C-") Then str = "CLAN " & str.Substring(2) End If Return StringToProper(str, " ", {"LRM", "MRM", "SRM", "AC/", "C.A.S.E.", "AMS", "LB", "PPC", "ER", "ECM", "IV", "II", "TAG", "NARC", "10-X", "VI", "S-SRM", "U-AC/", "MG"}) End Function ''' ''' Changes an all-caps string into a proper-capitalized string ''' ''' Input string to change ''' Seperator characters ''' Chunks containing any of these string will not be changed ''' Fixed string ''' Private Overloads Function StringToProper(str As String, sep() As Char, dontmatch() As String) As String For Each s In sep Dim tempstring As String = "" Dim splitstring() As String = str.Split(s) For Each x In splitstring If x = "" Then Continue For End If If StringContainsString(x, dontmatch) Then tempstring += x + s Continue For End If x = x.ToLowerInvariant Dim newchar As Char = x(0) newchar = Char.ToUpperInvariant(newchar) x = x.Remove(0, 1) x = newchar + x tempstring += x + s Next str = tempstring.TrimEnd(s) Next Return str End Function Private Function StringContainsString(str As String, match() As String) As Boolean For Each x In match If str = (x) Or str.StartsWith(x) Then Return True End If Next Return False End Function Private Function MakeStringInteresting(str As String) As List(Of String) Dim Split() As String = str.Split(" .,?!-".ToCharArray) Dim ret As New List(Of String) For Each x In Split For Each y In commonwords If x.ToLowerInvariant = (y) Then x = "" End If Next If x <> "" And Not ret.Contains(x) Then ret.Add(x) End If Next Return ret End Function 'Private Sub recspeech(sender As Object, e As System.Speech.Recognition.SpeechRecognizedEventArgs) Handles ears.SpeechRecognized ' If CheckBoxSTT.Checked Then ' sk.FindChatUsingBlob(goldarblob).SendMessage("Recognized speech:" + vbNewLine + e.Result.Text) ' End If 'End Sub Private Sub ReplyToMessage(ByVal pmessage As ChatMessage) If ((Now - lastreply).TotalSeconds < replydelay) Or (Not CheckBoxReply.Checked) Then Exit Sub End If Randomize() Dim didreply As Boolean = True Dim body As String = pmessage.Body.ToLowerInvariant.Trim If ((body = ":|" Or body.Contains(":|:|") Or body.Contains(":| :|")) And pmessage.Sender.Handle = "craze42") And Rnd() < 0.1 Then If Rnd() > 0.5 Then pmessage.Chat.SendMessage(":|(skype)(skype)(skype):|:|:|:|:|" + vbNewLine + ":|(skype)(skype)(skype):|(skype)(skype)(skype)(skype)" + vbNewLine + ":|(skype)(skype)(skype):|(skype)(skype)(skype)(skype)" + vbNewLine + ":|(skype)(skype)(skype):|(skype)(skype)(skype)(skype)" + vbNewLine + ":|:|:|:|:|:|:|:|:|" + vbNewLine + "(skype)(skype)(skype)(skype):|(skype)(skype)(skype):|" + vbNewLine + "(skype)(skype)(skype)(skype):|(skype)(skype)(skype):|" + vbNewLine + "(skype)(skype)(skype)(skype):|(skype)(skype)(skype):|" + vbNewLine + ":|:|:|:|:|(skype)(skype)(skype):|") Else pmessage.Chat.SendMessage("Funkytown") player.SoundLocation = sounddir + "funkytown.wav" player.Load() player.Play() End If ElseIf body = ":|" Or body.Contains(":|:|") Or body.Contains(":| :|") Then If Rnd() > 0.9 Then pmessage.Chat.SendMessage(pmessage.Sender.FullName + ", EVERYONE is dissapointed in him. :| :|") ElseIf Rnd() <= 0.9 And Rnd() > 0.5 Then pmessage.Chat.SendMessage("Don't worry " + pmessage.Sender.FullName + ", I'm dissapointed too. :|") ElseIf Rnd() <= 0.5 And Rnd() > 0.1 Then pmessage.Chat.SendMessage("Hey " + pmessage.Sender.FullName + ", give him a break.") Else pmessage.Chat.SendMessage("Dude why are you :| ing. I don't even get it.") End If ElseIf body.Contains("windowed") Or body.Contains("in a window") Or body.Contains("windowed mode") Or body.Contains("window mode") Then pmessage.Chat.SendMessage("Didn't know Harris was in here (wasntme)") ElseIf body.Contains("skype bot pl") Or body.Contains("skypebot pl") Then If Now.Hour >= 22 Or Now.Hour <= 6 Then pmessage.Chat.SendMessage("Hey I'm busy sleeping |-)") Else pmessage.Chat.SendMessage("Still in beta, cmon (waiting)") End If ElseIf body.Contains("(highfive)") And Rnd() < 0.6 Then pmessage.Chat.SendMessage("(highfive)") ElseIf body.Contains("ameri") And body.Contains("clap") Then pmessage.Chat.SendMessage("(flag:us)(clap)(flag:us)") ElseIf body.Contains("twitch.tv") And Rnd() > 0.5 Then pmessage.Chat.SendMessage("Is this teh urn? Kappa") ElseIf body.Contains("facepalm") And Rnd() > 0.7 Then pmessage.Chat.SendMessage("Cmon (facepalm)") ElseIf body.Contains("suicide") Then pmessage.Chat.SendMessage("i want to commit sudoku!") ElseIf body.Contains("nigger") And Rnd() < 0.1 Then pmessage.Chat.SendMessage("Niggers gonna nig (bandit)") ElseIf body.Contains("pizza") And Rnd() < 0.4 Then If Rnd() > 0.5 Then pmessage.Chat.SendMessage("Did somebody say pizza!? (pi)") Else pmessage.Chat.SendMessage("Gotta get me some of that PIZZA PIE! (pi)(mm)(pi)") End If ElseIf body.Count(Function(x) x = ">") > 6 Then pmessage.Chat.SendMessage("So much greentext, my monitor is almost out of green.") ElseIf body.Contains("4chan.org") And pmessage.Sender.Handle = "piroglith" And Rnd() < 0.2 Then pmessage.Chat.SendMessage("Oh there goes Scott with those 4chan links again...") ElseIf pmessage.Sender.Handle = "craze42" And (body.Contains("ing to bed") Or body.Contains("ing to sleep")) And Rnd() < 0.3 Then pmessage.Chat.SendMessage("Heading to bed already Corey? Cmon it's only " + Now.ToString("h:mm tt") + "! It's just like that one LAN...") ElseIf body.Contains(":||") And Rnd() > 0.5 Then pmessage.Chat.SendMessage("Check out all those chins on that :|") ElseIf body.EndsWith(".wav") And Rnd() < 0.5 And sk.ActiveCalls.Count = 0 Then pmessage.Chat.SendMessage("Why are you trying to play a sound? I'm not even in a call. (doh)") ElseIf body.EndsWith("%") And body.Length > 1 And Rnd() < 0.15 Then pmessage.Chat.SendMessage("I hold the world record in that category :P") ElseIf body = "butthash" And pmessage.Sender.Handle = "rulebreaker4454" And Rnd() > 0.7 And sk.ActiveCalls.Count > 0 Then pmessage.Chat.SendMessage("BUTTHASH? REALLY ALEX? CMON") ElseIf body.Contains("rip in peace") And Rnd() < 0.5 Then pmessage.Chat.SendMessage("We cry everytim ;(") ElseIf body.Contains("sandstorm") And Rnd() < 0.7 Then pmessage.Chat.SendMessage("༼ つ ◕_◕ ༽つ DUDUDUDUDUDUDUDUDUDU <(◕_◕< )") ElseIf body.Contains("gaybar") And Rnd() < 0.5 Then pmessage.Chat.SendMessage("I guess we know where " & pmessage.Sender.FullName & " is going.") Else didreply = False End If If didreply Then lastreply = Now End If End Sub Private Class quad Implements IEquatable(Of quad) Private realtokens(3) As String Private lowertokens(3) As String Public Property tokens As String() Get Return realtokens End Get Set(value As String()) realtokens = value 'lowertokens(0) = realtokens(0).ToLowerInvariant.Trim(" <>?:""{}|_+,./;'[]\-=`~!@#$%^&*()".ToCharArray) 'lowertokens(1) = realtokens(1).ToLowerInvariant.Trim(" <>?:""{}|_+,./;'[]\-=`~!@#$%^&*()".ToCharArray) 'lowertokens(2) = realtokens(2).ToLowerInvariant.Trim(" <>?:""{}|_+,./;'[]\-=`~!@#$%^&*()".ToCharArray) 'lowertokens(3) = realtokens(3).ToLowerInvariant.Trim(" <>?:""{}|_+,./;'[]\-=`~!@#$%^&*()".ToCharArray) End Set End Property Public Property CanStart As Boolean 'Can this quad start a sentence Public Property CanEnd As Boolean 'Can this quad end a sentence Private Shared wordchars() As Char = "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM1234567890>" Public Shared quadlist As New List(Of quad) Public Overloads Function Equals(other As quad) As Boolean Implements System.IEquatable(Of quad).Equals Return Me.tokens(0) = other.tokens(0) AndAlso Me.tokens(1) = other.tokens(1) AndAlso Me.tokens(2) = other.tokens(2) AndAlso Me.tokens(3) = other.tokens(3) End Function Public Overrides Function GetHashCode() As Integer Return Me.tokens(0).GetHashCode Xor Me.tokens(1).GetHashCode Xor Me.tokens(2).GetHashCode Xor Me.tokens(3).GetHashCode End Function Public Overrides Function Equals(obj As Object) As Boolean If obj.GetType = GetType(quad) Then Return Me.Equals(CType(obj, quad)) Else Return False End If End Function Public Sub New(s1 As String, s2 As String, s3 As String, s4 As String) Me.tokens(0) = s1 Me.lowertokens(0) = Regex.Match(s1.ToLowerInvariant, "\S*").Value Me.tokens(1) = s2 Me.lowertokens(1) = Regex.Match(s2.ToLowerInvariant, "\S*").Value Me.tokens(2) = s3 Me.lowertokens(2) = Regex.Match(s3.ToLowerInvariant, "\S*").Value Me.tokens(3) = s4 Me.lowertokens(3) = Regex.Match(s4.ToLowerInvariant, "\S*").Value End Sub Public Function Contains(s As String) Dim ls As String = s.ToLowerInvariant Return Me.lowertokens(0) = (ls) OrElse Me.lowertokens(1) = (ls) OrElse Me.lowertokens(2) = (ls) OrElse Me.lowertokens(3) = (ls) End Function Public Shared Operator =(a As quad, b As quad) Return a.Equals(b) End Operator Public Shared Operator <>(a As quad, b As quad) Return Not a.Equals(b) End Operator Public Overrides Function ToString() As String Return Me.tokens(0) & Me.tokens(1) & Me.tokens(2) & Me.tokens(3) End Function ''' ''' True if this quad can come before q ''' ''' Quad to test ''' ''' Public Function CanBeBefore(q As quad) As Boolean Return q.lowertokens(0) = Me.lowertokens(1) And q.lowertokens(1) = Me.lowertokens(2) And q.lowertokens(2) = Me.lowertokens(3) End Function ''' ''' True if this quad can come after q ''' ''' Quad to test ''' ''' Public Function CanBeAfter(q As quad) As Boolean Return q.lowertokens(1) = Me.lowertokens(0) And q.lowertokens(2) = Me.lowertokens(1) And q.lowertokens(3) = Me.lowertokens(2) End Function Public Shared Sub LoadFile(filepath As String) Dim i As Integer = 0 Dim intxt As String = FileIO.FileSystem.ReadAllText(filepath) Dim splittext() As String = intxt.Split(vbCrLf) For Each x In splittext If x.Length >= 8 Then AddString(x) End If i += 1 Next MsgBox("DONE NIGGA") End Sub Public Shared Sub AddString(str As String) Dim sentencelist() As String = RegularExpressions.Regex.Split(str, "(?<=[\.!\?\r\n])\s+") For s = 0 To sentencelist.Length - 1 Dim words As New List(Of String) For Each x As Match In Regex.Matches(sentencelist(s), "\S+\s*") words.Add(x.Value) Next 'Dim chrarray() As Char = sentencelist(s).ToCharArray 'Dim buffer As New StringBuilder 'For i = 0 To chrarray.Length - 1 ' buffer.Append(chrarray(i)) ' If Not wordchars.Contains(chrarray(i)) Then 'we've hit a punctuation character ' If chrarray(i) = "," Then ' buffer.Append(" ") ' End If ' If buffer.Length > 1 Then ' words.Add(buffer.ToString) ' End If ' buffer.Clear() ' End If 'Next 'If buffer.Length > 0 Then ' words.Add(buffer.ToString) 'End If If words.Count >= 4 Then For i = 0 To words.Count - 4 Dim q As New quad(words(i), words(i + 1), words(i + 2), words(i + 3)) Dim index As Integer = quadlist.FindIndex(Function(p) p = q) If index = -1 Then quadlist.Add(q) Else q = quadlist(index) End If If i = 0 Then q.CanStart = True End If If i = words.Count - 4 Then q.CanEnd = True End If Next Else 'didnt learn anything, too short message End If Next End Sub Public Overloads Shared Function MakeSentence() Return MakeSentence("") End Function Public Overloads Shared Function MakeSentence(ByVal query As String) As String Dim qwords As New List(Of String) qwords = Form1.MakeStringInteresting(query.Replace("skypebot", "").Replace("skype bot", "").Replace("bot", "")) If qwords.Count > 0 Then query = qwords(Math.Floor(Rnd() * qwords.Count)) Else query = "" End If Dim midquad As quad Dim output As New StringBuilder Dim results As New List(Of quad) If query <> "" Then results = quadlist.FindAll(Function(p As quad) p.Contains(query)) End If If results.Count = 0 Then 'pick random form all, none found midquad = quadlist(Math.Floor(Rnd() * quadlist.Count)) Else midquad = results(Math.Floor(Rnd() * results.Count)) End If output.Append(midquad.ToString) Dim q As quad = midquad 'build back to the start While Not q.CanStart results = quadlist.FindAll(Function(p As quad) p.CanBeBefore(q)) q = results(Math.Floor(Rnd() * results.Count)) output.Insert(0, q.tokens(0), 1) End While q = midquad 'build out to the end While Not q.CanEnd results = quadlist.FindAll(Function(p As quad) p.CanBeAfter(q)) q = results(Math.Floor(Rnd() * results.Count)) output.Append(q.tokens(3)) End While Return output.ToString End Function Public Function GetBytes() As Byte() Dim enc As New System.Text.UTF8Encoding 'str1 0x00 str2 0x00 str3 0x00 str4 0x00 flag 0xff Dim byte1() As Byte = enc.GetBytes(Me.tokens(0)) Dim byte2() As Byte = enc.GetBytes(Me.tokens(1)) Dim byte3() As Byte = enc.GetBytes(Me.tokens(2)) Dim byte4() As Byte = enc.GetBytes(Me.tokens(3)) Dim flagbyte As Byte = (1 * System.Convert.ToByte(Me.CanStart)) Or (2 * System.Convert.ToByte(Me.CanEnd)) Dim ret(byte1.Length + byte2.Length + byte3.Length + byte4.Length + 5) As Byte byte1.CopyTo(ret, 0) byte2.CopyTo(ret, byte1.Length + 1) byte3.CopyTo(ret, byte1.Length + 1 + byte2.Length + 1) byte4.CopyTo(ret, byte1.Length + 1 + byte2.Length + 1 + byte3.Length + 1) ret(ret.Length - 2) = flagbyte ret(ret.Length - 1) = &HFF Return ret End Function Public Sub New(packed() As Byte) Dim enc As New System.Text.UTF8Encoding 'str1 0x00 str2 0x00 str3 0x00 str4 0x00 flag 0xff Dim i As Integer = 0 Dim start As Integer = 0 Dim byt As Byte = 255 For d = 0 To 3 While byt <> &H0 byt = packed(i) i += 1 End While byt = &HFF Me.tokens(d) = enc.GetString(packed, start, i - start - 1) Me.lowertokens(d) = Me.tokens(d).ToLowerInvariant.Trim(" <>?:""{}|_+,./;'[]\-=`~!@#$%^&*()".ToCharArray) start = i Next Me.CanStart = packed(packed.Length - 2) And &H1 Me.CanEnd = packed(packed.Length - 2) And &H2 End Sub Public Shared Sub Save(path As String) Dim barray As New List(Of Byte) For Each x In quadlist barray.AddRange(x.GetBytes) Next FileIO.FileSystem.WriteAllBytes(path, barray.ToArray, False) End Sub Public Shared Sub Load(path As String) quadlist.Clear() Dim indata() As Byte = FileIO.FileSystem.ReadAllBytes(path) Dim buf() As Byte Dim lastindex As Integer = -1 For i = 0 To indata.Length - 1 If indata(i) = &HFF And i <> indata.Length - 1 Then ReDim buf(i - lastindex - 1) For k = 0 To i - lastindex - 1 buf(k) = indata(lastindex + k + 1) Next lastindex = i Dim q As New quad(buf) quadlist.Add(q) End If Next End Sub End Class Private Sub ButtonLoadBrain_Click(sender As System.Object, e As System.EventArgs) Handles ButtonLoadBrain.Click quad.Load("skypebot.dat") log("skypebot", "Loaded " + quad.quadlist.Count.ToString + " quads") End Sub Private Sub ButtonSaveBrain_Click(sender As System.Object, e As System.EventArgs) Handles ButtonSaveBrain.Click If quad.quadlist.Count > 0 Then quad.Save("skypebot.dat") End If log("", "Saved " & quad.quadlist.Count & " quads") End Sub Private Sub Form1_FormClosing(sender As System.Object, e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing If quad.quadlist.Count > 0 Then quad.Save("skypebot.dat") End If End Sub Private Sub twitchtimer_Tick(sender As System.Object, e As System.EventArgs) Handles twitchtimer.Tick 'MsgBox("starting timer sub") Dim wc As New Net.WebClient wc.Headers.Add("Client-ID: " & twitchclientid) Dim xdoc As New Xml.XmlDocument For Each x In streams Try 'MsgBox(i) xdoc = Newtonsoft.Json.JsonConvert.DeserializeXmlNode(wc.DownloadString("https://api.twitch.tv/kraken/streams/" & x.name), "twitch") Dim streamnode As Xml.XmlNode = xdoc.SelectSingleNode("twitch/stream") If streamnode.InnerXml = "" Then x.live = False If x.name = "moosecrap" And FileIO.FileSystem.FileExists("C:\apache\htdocs\live\moosecrap.live") Then FileIO.FileSystem.DeleteFile("C:\apache\htdocs\live\moosecrap.live") End If Else If Not x.live And (Now - x.lastlive).TotalMinutes > 5 Then x.live = True Dim t As String = x.name & " just went live!" & vbNewLine & streamnode.SelectSingleNode("channel/url").InnerText & vbNewLine & """" & streamnode.SelectSingleNode("channel/status").InnerText & """" & vbNewLine & "Game: " & streamnode.SelectSingleNode("game").InnerText sk.FindChatUsingBlob(goldarblob).SendMessage(t) ElseIf Not x.live Then x.live = True End If x.lastlive = Now If x.name = "moosecrap" AndAlso Not FileIO.FileSystem.FileExists("C:\apache\htdocs\live\moosecrap.live") Then FileIO.FileSystem.WriteAllText("C:\apache\htdocs\live\moosecrap.live", "", False) End If End If Catch End Try Next End Sub Private Sub CheckBoxTwitch_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles CheckBoxTwitch.CheckedChanged If CheckBoxTwitch.Checked Then If goldarblob <> "" Then twitchtimer.Enabled = True End If Else twitchtimer.Enabled = False End If End Sub ''' ''' Play a youtube video ''' ''' 11-digit alphanumeric youtube video id ''' timestamp to seek to ''' Private Sub PlayYouTube(id As String, Optional seek As String = "0") Dim ytdlpsi As New ProcessStartInfo("youtube-dl", "-g http://youtube.com/watch?v=" & id) ytdlpsi.RedirectStandardOutput = True ytdlpsi.UseShellExecute = False ytdlpsi.CreateNoWindow = True Dim ytdl As Process ytdl = Process.Start(ytdlpsi) Dim urls() As String = ytdl.StandardOutput.ReadToEnd.Split({vbCr, vbLf}, StringSplitOptions.RemoveEmptyEntries) Dim digits() As String = seek.Split(":") Dim timestamp As Double Dim mult As Double = 1.0 For i = digits.Length - 1 To 0 Step -1 Dim digitdbl As Double If Double.TryParse(digits(i), digitdbl) Then timestamp += digitdbl * mult mult *= 60 Else Throw New Exception("Seek was not a valid timestamp string") End If Next 'Dim ffplaypsi As New ProcessStartInfo("ffplay", "-autoexit -ss " & seek & " """ & urls.Last & """") Dim vlcpsi As New ProcessStartInfo(vlcpath, "--play-and-exit --qt-start-minimized --qt-notification=0 --start-time=" & CStr(timestamp) & " """ & urls.Last & """") If Not vlcprocess Is Nothing AndAlso Not vlcprocess.HasExited Then vlcprocess.CloseMainWindow() End If Me.Focus() vlcprocess = Process.Start(vlcpsi) Threading.Thread.Sleep(500) SetFocus(vlcprocess.MainWindowHandle) End Sub End Class