Вопрос

I'm using this code to Encode my vbscript

'encrypt.vbs 
Set WshShell = CreateObject("WScript.Shell")
strCurDir    = WshShell.CurrentDirectory
 set x = WScript.CreateObject("WScript.Shell")
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 txt = "set root = getobject(" & """winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2""" & ")"                    '  set root = getobject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
 a = encode(txt) 
 strFiley = strCurDir & "\enc4.txt"
 Set objFile = objFSO.CreateTextFile(strFiley,2,True)
objFile.Write(a)

 function encode(s) 
    For i = 1 To Len(s) 
       newtxt = Mid(s, i, 1) 
       newtxt = Chr(Asc(newtxt)+3) 
       coded = coded & newtxt 
    Next 
    encode = coded 
 End Function 

and this code for Decryption

     'decrypt.vbs 
 set x = WScript.createobject("wscript.shell") 
txt = "vhw#urrw#@#jhwremhfw+%zlqpjpwv=~lpshuvrqdwlrqohyho@lpshuvrqdwh€$__1_urrw_flpy5%," ' Encrypted string
 msgbox encode(txt)   
 function encode(s) 
    For i = 1 To Len(s) 
       newtxt = Mid(s, i, 1) 
       newtxt = Chr(Asc(newtxt)-3) 
       coded = coded & newtxt 
    Next 
    encode = coded 
 End Function 

Actually I'm encoding full script not only this section but problem appears with characters "}!\\.\"

An image might be better to explain to explain my problem:

http://www.x88x.com/lives/13958790471.jpg

So how to correct wrong characters?

Это было полезно?

Решение

There's the fundamental discrepancy in mixing Ansi (one-byte) characters with Unicode (two-byte) ones. You manipulate binary values of Ansi characters and write results to a Unicode file. Then, reading this Unicode file, you obtain Unicode characters. But there is no intrinsical function for "translating" characters between Ansi and Unicode (and conversely) in VBScript...

If necessary, instead of "Scripting.FileSystemObject" object, use "ADODB.Stream" object to write and read binary data (besides, AutomatedChaos is right - avoid this...)

Next script shows all differences and "similarities" Ansi vs. Unicode:

Option Explicit
'On Error Resume Next
On Error GoTo 0

Dim strResult: strResult = Wscript.ScriptName & vbNewLine
Dim ii, jj, strAux
Const booHexOut = True

strResult = strResult & vbTab & "Ansi # Unicode" & vbNewLine
jj = 0
For ii = 0 To 255
  strAux = Chr( ii)
  If AscB( Midb( strAux, 1, 1)) = ii And AscB( Midb( strAux, 2, 1)) = 0 Then
  Else 
    If booHexOut Then
      strResult = strResult & strAux & vbTab & CStr( ii) & vbTab & Hex2( ii) _
        & " # " & Hex2( AscB( Midb( strAux, 1, 1))) _
        & ", " & Hex2( AscB( Midb( strAux, 2, 1))) & vbTab 
    Else
      strResult = strResult & strAux & vbTab & CStr( ii) _
        & " # " & CStr( AscB( Midb( strAux, 1, 1))) _
        & ", " & CStr( AscB( Midb( strAux, 2, 1))) & vbTab
    End If 
    jj = jj + 1
    If jj Mod 3 = 0 Then strResult = strResult & vbNewLine 
  End If
Next
strResult = strResult & vbNewLine

strResult = strResult & vbNewLine & vbTab & "Ansi = Unicode" & vbNewLine
jj = 0
For ii = 128 To 255
  strAux = Chr( ii)
  If AscB( Midb( strAux, 1, 1)) = ii And AscB( Midb( strAux, 2, 1)) = 0 Then
    If booHexOut Then
      strResult = strResult & strAux & vbTab & CStr( ii) & vbTab & Hex2( ii) _
        & " = " & Hex2( AscB( Midb( strAux, 1, 1))) _
        & ", " & Hex2( AscB( Midb( strAux, 2, 1))) & vbTab 
    Else
      strResult = strResult & strAux & vbTab & CStr( ii) _
        & " = " & CStr( AscB( Midb( strAux, 1, 1))) _
        & ", " & CStr( AscB( Midb( strAux, 2, 1))) & vbTab 
    End If 
    jj = jj + 1
    If jj Mod 3 = 0 Then strResult = strResult & vbNewLine 
  Else 
  End If
Next
strResult = strResult & vbNewLine

Wscript.Echo strResult
Wscript.Quit

Function Hex2( byVal nmbr)
  Hex2 = Right( "00" & Hex( nmbr), 2)
End Function
Лицензировано под: CC-BY-SA с атрибуция
Не связан с StackOverflow
scroll top