Code is GSDs, I just ripped it out.
Easy 2/5
THIS IS ALL SERVER SIDE
Go into the Project Menu and add a reference to MS Script Control
Make 3 New Class modules
clsCommands
This is were you put allt he function that sadscript is allowed to process.
clsRC4
Jus tlook at the code i give you =p
clsSadScript
The main sadcript junk
CODE
clsRC4
Option Explicit
Private Const BLOCKSIZE = 256
Dim mnsBox(0 To 255) As Integer 'S-Box
Dim mnKeep(0 To 255) As Integer
Private mstrError As String
Private mstrPassword As String
Private mnErrorNumber As Long
Public Property Get ErrorNumber() As Long
ErrorNumber = mnErrorNumber
End Property
Public Property Let Password(ByVal vData As String)
mstrPassword = vData
Initialize mstrPassword
End Property
Public Property Get Password() As String
Password = mstrPassword
End Property
Public Property Get ErrorMessage() As String
ErrorMessage = mstrError
End Property
Public Function EncryptFile(ByVal strSource As String, ByVal strTarget As String, Optional strPassword As String) As Boolean
Dim strNameRoutine As String ' Name of routine For logging and Error routine
Dim nResult As Long
Dim inbyte As Byte
Dim nIndex As Long
Dim nSourceFile As Integer
Dim nTargetFile As Integer
Dim nSourceSize As Long
Dim nChunkSize As Integer
Dim strInput As String
Dim strOutput As String
Dim blnContinue As Boolean
On Local Error GoTo EncryptFile_Error
' InitialinIndexe variables
strNameRoutine = "EncryptFile"
nResult = 0 ' 0 = Failure - Must change To indicate success
If mstrPassword = "" And strPassword = "" Then
mstrError = "You need To enter a password For encrypten or decrypten"
GoTo EncryptFile_Exit
Else
If Len(strPassword) And strPassword <> mstrPassword Then
mstrPassword = strPassword
End If
End If
If Len(strSource) = 0 Or Len(strTarget) = 0 Then
mstrError = "Error - Source/Target name missing"
GoTo EncryptFile_Exit
End If
If Len(Dir$(strSource)) = 0 Then
mstrError = "Error missing source"
GoTo EncryptFile_Exit
End If
If Len(Dir$(strTarget)) Then
Kill strTarget
End If
' get the file handles
nSourceFile = FreeFile
nSourceSize = FileLen(strSource)
Open strSource For Binary As nSourceFile
nTargetFile = FreeFile
Open strTarget For Binary As nTargetFile
blnContinue = False ' Set this so we reset the indexes in the first call...
Do Until nIndex >= nSourceSize
If nIndex + BLOCKSIZE > nSourceSize Then
nChunkSize = nSourceSize - nIndex
Else
nChunkSize = BLOCKSIZE
End If
nIndex = nIndex + nChunkSize
strInput = Space$(nChunkSize) ' init For getting data
Get #nSourceFile, , strInput
strOutput = EnDeCrypt(strInput, blnContinue)
Put #nTargetFile, , strOutput
blnContinue = True ' mark it so that we Do Not reset the indexes on subsuquent calls
Loop
' clean up
Close nSourceFile
Close nTargetFile
nResult = True
EncryptFile_Exit:
On Local Error GoTo 0 ' turn off error trapping
EncryptFile = nResult
Exit Function
' Error Recovery & Logging
EncryptFile_Error:
' Log the error and exit routine
mnErrorNumber = Err.Number
mstrError = Err.Description & " In " & strNameRoutine
nResult = 0 ' verify that we are Set To failure
Resume EncryptFile_Exit
End Function
Public Function EncryptString(ByVal strSource As String, Optional strPassword As String) As String
Dim strNameRoutine As String ' Name of routine For logging and Error routine
Dim strResult As String
On Local Error GoTo EnCryptString_Error
' Initialize variables
strNameRoutine = "EnCryptString"
strResult = "" ' 0 = Failure - Must change To indicate success
' make sure we have the files, names and
' basic requirements
If mstrPassword = "" And strPassword = "" Then
mstrError = "You need To enter a password For encrypten or decrypten"
GoTo EnCryptString_Exit
Else
If Len(strPassword) And strPassword <> mstrPassword Then
mstrPassword = strPassword
End If
End If
If Len(strSource) = 0 Then
mstrError = "Error - Source/Target name missing"
GoTo EnCryptString_Exit
End If
strResult = EnDeCrypt(strSource, False)
EnCryptString_Exit:
On Local Error GoTo 0 ' turn off error trapping
EncryptString = strResult
Exit Function
' Error Recovery & Logging
EnCryptString_Error:
' Log the error and exit routine
mnErrorNumber = Err.Number
mstrError = Err.Description & " In " & strNameRoutine
strResult = "" ' verify that we are Set To failure
Resume EnCryptString_Exit
End Function
Private Sub Initialize(ByVal strPassword As String)
Dim temp As Integer
Dim nBufferIndex As Integer
Dim nPwdIndex As Integer
'Save Password in Byte-Array
nPwdIndex = 0
For nBufferIndex = 0 To 255
nPwdIndex = nPwdIndex + 1
If nPwdIndex > Len(strPassword) Then
nPwdIndex = 1
End If
mnKeep(nBufferIndex) = Asc(Mid$(strPassword, nPwdIndex, 1))
Next nBufferIndex
'INI S-Box
For nBufferIndex = 0 To 255
mnsBox(nBufferIndex) = nBufferIndex
Next nBufferIndex
nPwdIndex = 0
For nBufferIndex = 0 To 255
nPwdIndex = (nPwdIndex + mnsBox(nBufferIndex) + mnKeep(nBufferIndex)) Mod 256
' Swap( mnsBox(i),mnsBox(j) )
temp = mnsBox(nBufferIndex)
mnsBox(nBufferIndex) = mnsBox(nPwdIndex)
mnsBox(nPwdIndex) = temp
Next nBufferIndex
End Sub
Private Function EnDeCrypt(strSourceText As String, Optional blnContinue As Boolean) As String 'Only use this routine For short texts
Static nIndex As Integer
Static nIndex2 As Integer ' ok it's a poor name, but it is simply the second index...
Dim nKeyByte As Integer
Dim byteCypher As Byte
Dim strCipher As String
Dim nSwap As Integer
Dim nTextIndex As Long
If blnContinue = False Then
Initialize mstrPassword ' we have To re-initialize everytime because of the array shuffle
nIndex = 0
nIndex2 = 0
End If
For nTextIndex = 1 To Len(strSourceText)
nIndex = (nIndex + 1) Mod 256
nIndex2 = (nIndex2 + mnsBox(nIndex)) Mod 256
' Swap( mnsBox(nIndex),mnsBox(nIndex2) )
'
nSwap = mnsBox(nIndex)
mnsBox(nIndex) = mnsBox(nIndex2)
mnsBox(nIndex2) = nSwap
'Generate Keybyte nKeyByte
nKeyByte = mnsBox((mnsBox(nIndex) + mnsBox(nIndex2)) Mod 256)
'Plaintextbyte xor Keybyte
byteCypher = Asc(Mid$(strSourceText, nTextIndex, 1)) Xor nKeyByte
strCipher = strCipher & Chr$(byteCypher)
Next nTextIndex
EnDeCrypt = strCipher
End Function
Private Function EnDeCryptSingle(bytePlain As Byte, Optional blnContinue As Boolean) As Byte 'Use this routine For really huge files
Static nIndex As Integer
Static nIndex2 As Integer
Dim nSwap As Integer
Dim nKeyByte As Integer
Dim byteCipher As Byte
If blnContinue = False Then
Initialize mstrPassword ' we have To re-initialize everytime because of the array shuffle
nIndex = 0
nIndex2 = 0
End If
' get calculation values
nIndex = (nIndex + 1) Mod 256
nIndex2 = (nIndex2 + mnsBox(nIndex)) Mod 256
' Swap( mnsBox(nIndex),mnsBox(nIndex2) )
'
nSwap = mnsBox(nIndex)
mnsBox(nIndex) = mnsBox(nIndex2)
mnsBox(nIndex2) = nSwap
'Generate nKeyByteeybyte nKeyByte
nKeyByte = mnsBox((mnsBox(nIndex) + mnsBox(nIndex2)) Mod 256)
'Plaintextbyte xor nKeyByteeybyte
byteCipher = bytePlain Xor nKeyByte
EnDeCryptSingle = byteCipher
End Function
clsSadScript
Option Explicit
Private Const BLOCKSIZE = 256
Dim mnsBox(0 To 255) As Integer 'S-Box
Dim mnKeep(0 To 255) As Integer
Private mstrError As String
Private mstrPassword As String
Private mnErrorNumber As Long
Public Property Get ErrorNumber() As Long
ErrorNumber = mnErrorNumber
End Property
Public Property Let Password(ByVal vData As String)
mstrPassword = vData
Initialize mstrPassword
End Property
Public Property Get Password() As String
Password = mstrPassword
End Property
Public Property Get ErrorMessage() As String
ErrorMessage = mstrError
End Property
Public Function EncryptFile(ByVal strSource As String, ByVal strTarget As String, Optional strPassword As String) As Boolean
Dim strNameRoutine As String ' Name of routine For logging and Error routine
Dim nResult As Long
Dim inbyte As Byte
Dim nIndex As Long
Dim nSourceFile As Integer
Dim nTargetFile As Integer
Dim nSourceSize As Long
Dim nChunkSize As Integer
Dim strInput As String
Dim strOutput As String
Dim blnContinue As Boolean
On Local Error GoTo EncryptFile_Error
' InitialinIndexe variables
strNameRoutine = "EncryptFile"
nResult = 0 ' 0 = Failure - Must change To indicate success
If mstrPassword = "" And strPassword = "" Then
mstrError = "You need To enter a password For encrypten or decrypten"
GoTo EncryptFile_Exit
Else
If Len(strPassword) And strPassword <> mstrPassword Then
mstrPassword = strPassword
End If
End If
If Len(strSource) = 0 Or Len(strTarget) = 0 Then
mstrError = "Error - Source/Target name missing"
GoTo EncryptFile_Exit
End If
If Len(Dir$(strSource)) = 0 Then
mstrError = "Error missing source"
GoTo EncryptFile_Exit
End If
If Len(Dir$(strTarget)) Then
Kill strTarget
End If
' get the file handles
nSourceFile = FreeFile
nSourceSize = FileLen(strSource)
Open strSource For Binary As nSourceFile
nTargetFile = FreeFile
Open strTarget For Binary As nTargetFile
blnContinue = False ' Set this so we reset the indexes in the first call...
Do Until nIndex >= nSourceSize
If nIndex + BLOCKSIZE > nSourceSize Then
nChunkSize = nSourceSize - nIndex
Else
nChunkSize = BLOCKSIZE
End If
nIndex = nIndex + nChunkSize
strInput = Space$(nChunkSize) ' init For getting data
Get #nSourceFile, , strInput
strOutput = EnDeCrypt(strInput, blnContinue)
Put #nTargetFile, , strOutput
blnContinue = True ' mark it so that we Do Not reset the indexes on subsuquent calls
Loop
' clean up
Close nSourceFile
Close nTargetFile
nResult = True
EncryptFile_Exit:
On Local Error GoTo 0 ' turn off error trapping
EncryptFile = nResult
Exit Function
' Error Recovery & Logging
EncryptFile_Error:
' Log the error and exit routine
mnErrorNumber = Err.Number
mstrError = Err.Description & " In " & strNameRoutine
nResult = 0 ' verify that we are Set To failure
Resume EncryptFile_Exit
End Function
Public Function EncryptString(ByVal strSource As String, Optional strPassword As String) As String
Dim strNameRoutine As String ' Name of routine For logging and Error routine
Dim strResult As String
On Local Error GoTo EnCryptString_Error
' Initialize variables
strNameRoutine = "EnCryptString"
strResult = "" ' 0 = Failure - Must change To indicate success
' make sure we have the files, names and
' basic requirements
If mstrPassword = "" And strPassword = "" Then
mstrError = "You need To enter a password For encrypten or decrypten"
GoTo EnCryptString_Exit
Else
If Len(strPassword) And strPassword <> mstrPassword Then
mstrPassword = strPassword
End If
End If
If Len(strSource) = 0 Then
mstrError = "Error - Source/Target name missing"
GoTo EnCryptString_Exit
End If
strResult = EnDeCrypt(strSource, False)
EnCryptString_Exit:
On Local Error GoTo 0 ' turn off error trapping
EncryptString = strResult
Exit Function
' Error Recovery & Logging
EnCryptString_Error:
' Log the error and exit routine
mnErrorNumber = Err.Number
mstrError = Err.Description & " In " & strNameRoutine
strResult = "" ' verify that we are Set To failure
Resume EnCryptString_Exit
End Function
Private Sub Initialize(ByVal strPassword As String)
Dim temp As Integer
Dim nBufferIndex As Integer
Dim nPwdIndex As Integer
'Save Password in Byte-Array
nPwdIndex = 0
For nBufferIndex = 0 To 255
nPwdIndex = nPwdIndex + 1
If nPwdIndex > Len(strPassword) Then
nPwdIndex = 1
End If
mnKeep(nBufferIndex) = Asc(Mid$(strPassword, nPwdIndex, 1))
Next nBufferIndex
'INI S-Box
For nBufferIndex = 0 To 255
mnsBox(nBufferIndex) = nBufferIndex
Next nBufferIndex
nPwdIndex = 0
For nBufferIndex = 0 To 255
nPwdIndex = (nPwdIndex + mnsBox(nBufferIndex) + mnKeep(nBufferIndex)) Mod 256
' Swap( mnsBox(i),mnsBox(j) )
temp = mnsBox(nBufferIndex)
mnsBox(nBufferIndex) = mnsBox(nPwdIndex)
mnsBox(nPwdIndex) = temp
Next nBufferIndex
End Sub
Private Function EnDeCrypt(strSourceText As String, Optional blnContinue As Boolean) As String 'Only use this routine For short texts
Static nIndex As Integer
Static nIndex2 As Integer ' ok it's a poor name, but it is simply the second index...
Dim nKeyByte As Integer
Dim byteCypher As Byte
Dim strCipher As String
Dim nSwap As Integer
Dim nTextIndex As Long
If blnContinue = False Then
Initialize mstrPassword ' we have To re-initialize everytime because of the array shuffle
nIndex = 0
nIndex2 = 0
End If
For nTextIndex = 1 To Len(strSourceText)
nIndex = (nIndex + 1) Mod 256
nIndex2 = (nIndex2 + mnsBox(nIndex)) Mod 256
' Swap( mnsBox(nIndex),mnsBox(nIndex2) )
'
nSwap = mnsBox(nIndex)
mnsBox(nIndex) = mnsBox(nIndex2)
mnsBox(nIndex2) = nSwap
'Generate Keybyte nKeyByte
nKeyByte = mnsBox((mnsBox(nIndex) + mnsBox(nIndex2)) Mod 256)
'Plaintextbyte xor Keybyte
byteCypher = Asc(Mid$(strSourceText, nTextIndex, 1)) Xor nKeyByte
strCipher = strCipher & Chr$(byteCypher)
Next nTextIndex
EnDeCrypt = strCipher
End Function
Private Function EnDeCryptSingle(bytePlain As Byte, Optional blnContinue As Boolean) As Byte 'Use this routine For really huge files
Static nIndex As Integer
Static nIndex2 As Integer
Dim nSwap As Integer
Dim nKeyByte As Integer
Dim byteCipher As Byte
If blnContinue = False Then
Initialize mstrPassword ' we have To re-initialize everytime because of the array shuffle
nIndex = 0
nIndex2 = 0
End If
' get calculation values
nIndex = (nIndex + 1) Mod 256
nIndex2 = (nIndex2 + mnsBox(nIndex)) Mod 256
' Swap( mnsBox(nIndex),mnsBox(nIndex2) )
'
nSwap = mnsBox(nIndex)
mnsBox(nIndex) = mnsBox(nIndex2)
mnsBox(nIndex2) = nSwap
'Generate nKeyByteeybyte nKeyByte
nKeyByte = mnsBox((mnsBox(nIndex) + mnsBox(nIndex2)) Mod 256)
'Plaintextbyte xor nKeyByteeybyte
byteCipher = bytePlain Xor nKeyByte
EnDeCryptSingle = byteCipher
End Function
Add this at the top of modGameLogic
Global MyScript As clsSadScript
Public clsScriptCommands As clsCommands
Now in Sub InitServer() add the following somewere near the top of the loading sequence:
Call SetStatus("Loading scripts...")
Set MyScript = New clsSadScript
Set clsScriptCommands = New clsCommands
MyScript.ReadInCode App.Path & "\Main.txt", "\Main.txt", MyScript.SControl, False
MyScript.SControl.AddObject "ScriptHardCode", clsScriptCommands, True
Main.txt in your server folder and ti will read it, NO MATTER WHAT IT HAS TO HAVE 1 LINE OF CODE IN IT AT LEAST or it will error.
SadScript cant send strings for some reason, so dont even try it.
according to GSD it goes liek so to make Sadscript work
Put this anywere you want the script to load
MyScript.ExecuteStatement "ScriptFile.txt", "SubNameHere"
Change SubNameHere to whatever sub you want it to load.
Now if you want variables like player index do this:
MyScript.ExecuteStatement "ScriptFile.txt", "SubNameHere " & index
You always need the space after SubNameHere
Now if you want more variables do:
MyScript.ExecuteStatement "ScriptFile.txt", "SubNameHere " & index & "," & index
REMBER TO USE A CODE YOU MUST ADD IT TO clsCommands! Even if its already int he code, you ahve to put it there AGAIN. Me for example, I have 2 sets of GetVar/PutVar loading.
It does take a while to compiule the more you add in.
|