Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for coder.vbs

(view source code of coder.vbs as plain text) 

  1. Option Explicit
  2.  
  3. Dim arrKey, errResult
  4.  
  5. arrKey = Array( 101, 86, 49, 203 )
  6.  
  7. WScript.Echo "Encoding . . ."
  8. errResult = Encode( "coder.vbs", "coder.enc", arrKey )
  9. If errResult <> 0 Then
  10. 	ShowError errResult
  11. End If
  12.  
  13. WScript.Echo "Decoding again . . ."
  14. errResult = Encode( "coder.enc", "coder.dec", arrKey )
  15. If errResult <> 0 Then
  16. 	ShowError errResult
  17. Else
  18. 	WScript.Echo "Done." & vbCrLf _
  19. 	           & "Compare the files ""coder.vbs"" and ""coder.dec"", " _
  20. 	           & "they should be identical."
  21. End If
  22.  
  23.  
  24. Sub ShowError( myError )
  25. 	On Error Resume Next
  26. 	Err.Raise myError
  27. 	WScript.Echo "ERROR " & Err.Number & ": " & Err.Description
  28. 	Err.Clear
  29. 	On Error Goto 0
  30. 	WScript.Quit
  31. End Sub
  32.  
  33.  
  34. Function Encode( myFileIn, myFileOut, arrCode )
  35. ' This function provides a simple (ASCII) text encoder/decoder using XOR.
  36. ' Because it uses XOR, both encoding and decoding can be performed by the
  37. ' same function, with the same key.
  38. '
  39. ' Arguments:
  40. ' myFileIn   [string]        input text file (file to be encoded)
  41. ' myFileOut  [string]        output file (encoded text)
  42. ' arrCode    [array of int]  "key", consisting of any number of integers
  43. '                            from 1 to 255; avoid 0, though it can be used,
  44. '                            it doesn't encode anything.
  45. '                            Use any number of elements in the "key" array,
  46. '                            each element multiplies the number of possible
  47. '                            keys by 255 (not 256 since 0 is avoided).
  48. '                            If only a single element is used, it may be
  49. '                            passed either as an array or as a single integer.
  50. '
  51. ' Return code:
  52. ' 0 if all went well, otherwise the appropriate error number.
  53. '
  54. ' Written by Rob van der Woude
  55. ' http://www.robvanderwoude.com
  56.  
  57. 	' Standard housekeeping
  58. 	Dim i, objFSO, objFileIn, objFileOut, objStreamIn
  59.  
  60. 	Const ForAppending       =  8
  61. 	Const ForReading         =  1
  62. 	Const ForWriting         =  2
  63. 	Const TristateFalse      =  0
  64. 	Const TristateMixed      = -2
  65. 	Const TristateTrue       = -1
  66. 	Const TristateUseDefault = -2
  67.  
  68. 	' Use custom error handling
  69. 	On Error Resume Next
  70.  
  71. 	' If the "key" is a single digit, convert it to an array
  72. 	If Not IsArray( arrCode ) Then
  73. 		arrCode = Array( arrCode )
  74. 	End If
  75.  
  76. 	' Check if a valid "key" array is used
  77. 	For i = 0 To UBound( arrCode )
  78. 		If Not IsNumeric( arrCode(i) ) Then
  79. 			' 1032	Invalid character
  80. 			Encode = 1032
  81. 			Exit Function
  82. 		End If
  83. 		If arrCode(i) < 0 Or arrCode(i) > 255 Then
  84. 			' 1031	Invalid number
  85. 			Encode = 1031
  86. 			Exit Function
  87. 		End If
  88. 	Next
  89.  
  90. 	' Open a file system object
  91. 	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  92.  
  93. 	' Open the input file if it exists
  94. 	If objFSO.FileExists( myFileIn ) Then
  95. 		Set objFileIn   = objFSO.GetFile( myFileIn )
  96. 		Set objStreamIn = objFileIn.OpenAsTextStream( ForReading, TriStateFalse )
  97. 	Else
  98. 		' Error 53: File not found
  99. 		Encode = 53
  100. 		' Close input file and release objects
  101. 		objStreamIn.Close
  102. 		Set objStreamIn = Nothing
  103. 		Set objFileIn   = Nothing
  104. 		Set objFSO      = Nothing
  105. 		' Abort
  106. 		Exit Function
  107. 	End If
  108.  
  109. 	' Create the output file, unless it already exists
  110. 	If objFSO.FileExists( myFileOut ) Then
  111. 		' Error 58: File already exists
  112. 		Encode = 58
  113. 		' Close input file and release objects
  114. 		objStreamIn.Close
  115. 		Set objStreamIn = Nothing
  116. 		Set objFileIn   = Nothing
  117. 		Set objFSO      = Nothing
  118. 		' Abort
  119. 		Exit Function
  120. 	Else
  121. 		Set objFileOut = objFSO.CreateTextFile( myFileOut, True, False )
  122. 	End If
  123.  
  124. 	' Encode the text from the input file and write it to the output file
  125. 	i = 0
  126. 	Do Until objStreamIn.AtEndOfStream
  127. 		i = ( i + 1 ) \ ( UBound( arrCode ) + 1 )
  128. 		objFileOut.Write Chr( Asc( objStreamIn.Read( 1 ) ) Xor arrCode(i) )
  129. 	Loop
  130.  
  131. 	' Close files and release objects
  132. 	objFileOut.Close
  133. 	objStreamIn.Close
  134. 	Set objStreamIn = Nothing
  135. 	Set objFileIn   = Nothing
  136. 	Set objFileOut  = Nothing
  137. 	Set objFSO      = Nothing
  138.  
  139. 	' Return the error number as status information
  140. 	Encode = Err.Number
  141.  
  142. 	' Done
  143. 	Err.Clear
  144. 	On Error Goto 0
  145. End Function
  146.  

page last modified: 2025-10-11; loaded in 0.0089 seconds