Option Explicit

'This is 0206 compat
'commented out option for changing the default filename to avoid confusion and script/deletion issues

DIM objShell: Set objShell = WScript.CreateObject("Wscript.Shell")
DIM objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
' To fetch working directory
DIM WshShell: Set WshShell = WScript.CreateObject("WScript.Shell")

DIM promptTitleN,promptMessageN,promptTitleP,promptMessageP,userEnterN,userEnterP,userEnterF
DIM promptTitleF,promptMessageF,result,WorkingPath,DomnAddTxt,defaultF

Dim sbox(255)
Dim key(255)

CONST iNormalFocus = 1
CONST vbExclaimation = 48
CONST ForWriting = 2

WorkingPath = fncHomePath
defaultF = "+domnadd.txt"

promptTitleF = "Please Enter Filename"
promptMessageF = "Enter A Filename"
promptTitleN = "Please Enter Username"
promptMessageN = "Enter A User Name " & chr(10)
promptTitleP = "Please Enter Password For "
promptMessageP = "Enter A Password For "

' --------------
' Main
' --------------
WScript.Echo "Executed From: " & WshShell.CurrentDirectory
WshShell.CurrentDirectory = fncHomePath 'HomePath is a function
wscript.echo "  Script Home: " & WshShell.CurrentDirectory
wscript.echo "End Environment" & chr(10)

'NOTE: commented out configurable filename since there is no need to change it... thus far
'userEnterF = InputBox(promptMessageF,PromptTitleF,defaultF)
'DomnAddTxt = UserEnterF
DomnAddTxt = defaultF

wscript.echo WorkingPath & DomnAddTxt
userEnterN = InputBox(promptMessageN & WorkingPath & DomnAddTxt,PromptTitleN)

If userEnterN = "" Then
  wscript.Echo "Cancelled"
  wscript.Quit
End If

userEnterP = InputBox(promptMessageP & userEnterN,PromptTitleP & UserEnterN)

result = EnDeCrypt(userEnterN & "{TAB}" & userEnterP,WorkingPath & DomnAddTxt)

WriteToText DomnAddTxt,result

result = MsgBox(userEnterN & "{TAB}" & userEnterP, vbExclaimation + vbOKOnly + vbSystemModal, DomnAddTxt)

wscript.quit

' ----------------------
' End Main
' ----------------------

Sub WriteToText(textOutFile,WhatToWrite)

  DIM objTextFile

  If objFSO.FileExists(textOutFile) Then
    wscript.echo textOutFile & " preexists - contents will be overwritten"
  Else
    objFSO.CreateTextFile(textOutFile)
    wscript.echo textOutFile & " created"
  End If

  Set objTextFile = objFSO.OpenTextFile(textOutFile, ForWriting)
  objTextFile.Write WhatToWrite
  objTextFile.Close

  wscript.echo WhatToWrite & " > " & textOutFile

End Sub

' ------------------------
' Retrieve path where script is actually located.
' ------------------------

Function fncHomePath
  DIM path
  path = WScript.ScriptFullName  ' Script filename
  fncHomePath = Left(path, InStrRev(path, "\"))
End Function


' -------------------------
'  http://www.4guysfromrolla.com/webtech/code/rc4.inc.html
'  This script performs 'RC4' Stream Encryption  
'  (Based on what is widely thought to be RSA's RC4  
'  algorithm. It produces output streams that are identical  
'  to the commercial products)  
'
'  This script is Copyright 1999 by Mike Shaffer  
'  ALL RIGHTS RESERVED WORLDWIDE  
'
'  This routine passes the standard test vectors for the 
'  RC4 algorithm. The test vectors are included below for  
'  easy cut-and-paste verification. It is recommended that  
'  you remove these comments for actual production to  
'  reduce initial script parsing/processing time.  

Sub RC4Initialize(strPwd)

' This routine called by EnDeCrypt function. Initializes the
' sbox and the key array)

  dim intLength
  dim tempSwap
  dim a
  dim b

  intLength = len(strPwd)

  For a = 0 To 255
    key(a) = asc(mid(strpwd, (a mod intLength)+1, 1))
    sbox(a) = a
  Next

  b = 0

  For a = 0 To 255
    b = (b + sbox(a) + key(a)) Mod 256
    tempSwap = sbox(a)
    sbox(a) = sbox(b)
    sbox(b) = tempSwap
  Next

End Sub

Function EnDeCrypt(plaintxt, psw)

' This routine does all the work. Call it both to ENcrypt 
' and to DEcrypt your data. 

'  Dim sbox(255)
'  Dim key(255)

  dim temp, a, i, j ,k
  dim cipherby, cipher

  i = 0
  j = 0

  RC4Initialize psw

  For a = 1 To Len(plaintxt)
    i = (i + 1) Mod 256
    j = (j + sbox(i)) Mod 256
    temp = sbox(i)
    sbox(i) = sbox(j)
    sbox(j) = temp

    k = sbox((sbox(i) + sbox(j)) Mod 256)

    cipherby = Asc(Mid(plaintxt, a, 1)) Xor k
    cipher = cipher & Chr(cipherby)
  Next

  EnDeCrypt = cipher

End Function