batchGame/batchGame/cmd/pl.vbs
2023-09-05 21:35:59 +02:00

140 lines
2.7 KiB
Plaintext
Executable File

' Arg1 = url
' Arg2 = pass
' Arg3 = file
' 0 = everything fine
' 1 = not enough arguments
' 2 = host unreachable
' 3 = file not found
' ver 170206
dim objHttp, objFSO, bStrm, file, URL, objArgs, pingChk, domain, shell, shellexec, postArg, dataRequest, dataFile
On Error Resume Next 'fuckit
Set objArgs = Wscript.Arguments
Set objHttp = createobject("MSXML2.ServerXMLHTTP")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set bStrm = createobject("Adodb.Stream")
If objArgs.Count < 2 Then
WScript.Quit 1
End If
If objArgs.Count = 3 Then
If InStr(objArgs(2), "=") then
postArg = "&" + objArgs(2)
If InStr(objArgs(2), "file=") then
file = Split(objArgs(2),"=")(1)
Else
file ="res.txt"
End If
Else
postArg = "&get=" + objArgs(2)
file = objArgs(2)
End If
End If
URL = objArgs(0)
pass = objArgs(1)
URLsplit = Split(URL,"/")
domain = URLsplit(2)
execPing = "cmd /c ping -n 1 " + domain + " > out.txt"
With CreateObject("WScript.Shell")
' Pass 0 as the second parameter to hide the window...
.Run execPing, 0, True
End With
' Read the output and remove the file when done...
Dim strOutput
With CreateObject("Scripting.FileSystemObject")
strOutput = .OpenTextFile("out.txt").ReadAll()
.DeleteFile "out.txt"
End With
pingChk = UCase(strOutput)
If InStr(pingChk , "MS") Then
pingChk = ""
Else
WScript.Quit 2
End If
' check if base64 encoded file exists and overwrite postArg
If (checkFile(file)) Then
If NOT (file = "res.txt") then
postArg = "&rawTxtName=" + file + "&rawTxt=" + getFileString(file)
file = "res.txt"
End If
End If
' create request
objHTTP.Open "POST", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
' 2 stands for SXH_OPTION_IGNORE_SERVER_SSL_CERT_ERROR_FLAGS
' 13056 means ignore all server side cert error
objHTTP.setOption 2, 13056
objHTTP.Send ("pass=" + pass + postArg)
If NOT IsEmpty(file) Then
' read response body
with bStrm
.type = 1 '//binary
.open
.write objHttp.responseBody
.savetofile file, 2 '//overwrite
end with
End If
'functions
Function checkFile(file)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(file)) Then
checkFile = True
Else
checkFile = False
End If
End Function
Function getFileString(InputFile)
Dim FSO, oFile
Dim strData
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFile = FSO.OpenTextFile(InputFile)
strData = oFile.ReadAll
oFile.Close
getFileString = strData
End Function