Option Explicit 'It's a script of function of encoding. Dim objFSO, objStream Dim arrModule() Const vbFileName="C:/Documents and Settings/ajx/桌面/NewText.txt" Set objFSO=CreateObject("Scripting.FileSystemObject") If Not objFSO.FileExists(vbFileName) Then Set objStream=objFSO.CreateTextFile(vbFileName) WScript.Quit End If 'It's the main procedure GetOrder 'at the side of Ln 29 ReadTheFile 'at the side of Ln 39 CompileCode 'at the side of Ln 51 OutPutResult 'at the side of Ln 92 '*********************************************** Dim strUserOrder Sub GetOrder strUserOrder=InputBox("What do you want to do?") If strUserOrder<>"+" And strUserOrder<>"-" Then WScript.Quit End If End Sub Dim strText Sub ReadTheFile Set objStream=objFSO.OpenTextFile(vbFileName) strText=objStream.ReadAll Set objStream=Nothing Set objFSO=Nothing End Sub Dim lngIndex Dim lngTextLenth Dim strTextResult Sub CompileCode lngTextLenth=(Len(strText) - 1) ReDim arrModule(lngTextLenth) For lngIndex=0 To lngTextLenth arrModule(lngIndex)=CutDown(strText, lngIndex) If arrModule(lngIndex)="a" Xor arrModule(lngIndex)="b" Xor _ arrModule(lngIndex)="c" Xor arrModule(lngIndex)="d" Xor _ arrModule(lngIndex)="e" Xor arrModule(lngIndex)="f" Xor _ arrModule(lngIndex)="g" Xor arrModule(lngIndex)="h" Xor _ arrModule(lngIndex)="i" Xor arrModule(lngIndex)="j" Xor _ arrModule(lngIndex)="k" Xor arrModule(lngIndex)="l" Xor _ arrModule(lngIndex)="m" Xor arrModule(lngIndex)="n" Xor _ arrModule(lngIndex)="o" Xor arrModule(lngIndex)="p" Xor _ arrModule(lngIndex)="q" Xor arrModule(lngIndex)="r" Xor _ arrModule(lngIndex)="s" Xor arrModule(lngIndex)="t" Xor _ arrModule(lngIndex)="u" Xor arrModule(lngIndex)="v" Xor _ arrModule(lngIndex)="w" Xor arrModule(lngIndex)="x" Xor _ arrModule(lngIndex)="y" Xor arrModule(lngIndex)="z" Xor _ _ arrModule(lngIndex)="A" Xor arrModule(lngIndex)="B" Xor _ arrModule(lngIndex)="C" Xor arrModule(lngIndex)="D" Xor _ arrModule(lngIndex)="E" Xor arrModule(lngIndex)="F" Xor _ arrModule(lngIndex)="G" Xor arrModule(lngIndex)="H" Xor _ arrModule(lngIndex)="I" Xor arrModule(lngIndex)="J" Xor _ arrModule(lngIndex)="K" Xor arrModule(lngIndex)="L" Xor _ arrModule(lngIndex)="M" Xor arrModule(lngIndex)="N" Xor _ arrModule(lngIndex)="O" Xor arrModule(lngIndex)="P" Xor _ arrModule(lngIndex)="Q" Xor arrModule(lngIndex)="R" Xor _ arrModule(lngIndex)="S" Xor arrModule(lngIndex)="T" Xor _ arrModule(lngIndex)="U" Xor arrModule(lngIndex)="V" Xor _ arrModule(lngIndex)="W" Xor arrModule(lngIndex)="X" Xor _ arrModule(lngIndex)="Y" Xor arrModule(lngIndex)="Z" Then Call Detach() End If strTextResult=strTextResult & arrModule(lngIndex) Next End Sub Sub OutPutResult Set objFSO=CreateObject("Scripting.FileSystemObject") Set objStream=objFSO.OpenTextFile(vbFileName, 8) With objStream .WriteLine "" .WriteLine "*************your file*************"&vbNewLine .Write strTextResult End With End Sub Dim intValue Sub Detach arrModule(lngIndex)=GetNumber(arrModule(lngIndex)) Select Case strUserOrder Case "+" intValue=1 Case "-" intValue=-1 End Select arrModule(lngIndex)=ChangeNumber(arrModule(lngIndex), intValue) arrModule(lngIndex)=GetWord(arrModule(lngIndex)) End Sub '*********************************************** Function GetNumber(AnyWord) Select Case AnyWord Case "a" :GetNumber=1 :Case "b" :GetNumber=2 Case "c" :GetNumber=3 :Case "d" :GetNumber=4 Case "e" :GetNumber=5 :Case "f" :GetNumber=6 Case "g" :GetNumber=7 :Case "h" :GetNumber=8 Case "i" :GetNumber=9 :Case "j" :GetNumber=10 Case "k" :GetNumber=11 :Case "l" :GetNumber=12 Case "m" :GetNumber=13 :Case "n" :GetNumber=14 Case "o" :GetNumber=15 :Case "p" :GetNumber=16 Case "q" :GetNumber=17 :Case "r" :GetNumber=18 Case "s" :GetNumber=19 :Case "t" :GetNumber=20 Case "u" :GetNumber=21 :Case "v" :GetNumber=22 Case "w" :GetNumber=23 :Case "x" :GetNumber=24 Case "y" :GetNumber=25 :Case "z" :GetNumber=26 _ Case "A" :GetNumber=29 :Case "B" :GetNumber=30 Case "C" :GetNumber=31 :Case "D" :GetNumber=32 Case "E" :GetNumber=33 :Case "F" :GetNumber=34 Case "G" :GetNumber=35 :Case "H" :GetNumber=36 Case "I" :GetNumber=37 :Case "J" :GetNumber=38 Case "K" :GetNumber=39 :Case "L" :GetNumber=40 Case "M" :GetNumber=41 :Case "N" :GetNumber=42 Case "O" :GetNumber=43 :Case "P" :GetNumber=44 Case "Q" :GetNumber=45 :Case "R" :GetNumber=46 Case "S" :GetNumber=47 :Case "T" :GetNumber=48 Case "U" :GetNumber=49 :Case "V" :GetNumber=50 Case "W" :GetNumber=51 :Case "X" :GetNumber=52 Case "Y" :GetNumber=53 :Case "Z" :GetNumber=54 End Select End Function Function GetWord(AnyNumber) Select Case AnyNumber Case 1 :GetWord="a" :Case 2 :GetWord="b" Case 3 :GetWord="c" :Case 4 :GetWord="d" Case 5 :GetWord="e" :Case 6 :GetWord="f" Case 7 :GetWord="g" :Case 8 :GetWord="h" Case 9 :GetWord="i" :Case 10 :GetWord="j" Case 11 :GetWord="k" :Case 12 :GetWord="l" Case 13 :GetWord="m" :Case 14 :GetWord="n" Case 15 :GetWord="o" :Case 16 :GetWord="p" Case 17 :GetWord="q" :Case 18 :GetWord="r" Case 19 :GetWord="s" :Case 20 :GetWord="t" Case 21 :GetWord="u" :Case 22 :GetWord="v" Case 23 :GetWord="w" :Case 24 :GetWord="x" Case 25 :GetWord="y" :Case 26 :GetWord="z" _ Case 29 :GetWord="A" :Case 30 :GetWord="B" Case 31 :GetWord="C" :Case 32 :GetWord="D" Case 33 :GetWord="E" :Case 34 :GetWord="F" Case 35 :GetWord="G" :Case 36 :GetWord="H" Case 37 :GetWord="I" :Case 38 :GetWord="J" Case 39 :GetWord="K" :Case 40 :GetWord="L" Case 41 :GetWord="M" :Case 42 :GetWord="N" Case 43 :GetWord="O" :Case 44 :GetWord="P" Case 45 :GetWord="Q" :Case 46 :GetWord="R" Case 47 :GetWord="S" :Case 48 :GetWord="T" Case 49 :GetWord="U" :Case 50 :GetWord="V" Case 51 :GetWord="W" :Case 52 :GetWord="X" Case 53 :GetWord="Y" :Case 54 :GetWord="Z" End Select End Function Function CutDown(AnyWord, AnyIndex) CutDown=Right(Left(AnyWord, AnyIndex + 1), 1) End Function Function ChangeNumber(AnyNumber, AnyValue) ChangeNumber=AnyNumber + AnyValue Select Case ChangeNumber Case 27 ChangeNumber=1 Case 55 ChangeNumber=29 Case 0 ChangeNumber=26 Case 28 ChangeNumber=54 End Select End Function