Scripts verschlüsseln

Ich versuche immer ein VBS-script anstatt einer Batch-Datei zu schreiben. Die Ausführung geht doch sicher schneller, ohne DOS-Box.

Auf meinem alten W98-Rechner habe ich vor kurzem versehentlich neu installiert. Jetzt geht allerdings die Parameter-Übergabe mit VBS nicht mehr. Wie kann ich das reparieren? Ich habe schon den IE neu installiert, ohne Erfolg.
Soweit ich mich erinnere, wurde drag-drop bei VBS erst vor einiger Zeit eingeführt.
Zur Überbrückung mußte ich daher wieder wie früher eine Batch-Datei vorschalten, die WSCRIPT vbs-script %1 %2 ... aufruft.

 

Der Link http://msdn.microsoft.com/scripting/vbscript/download/x86/sce10de.exe aus dem Beitrag "Scripts verschlüsseln" landet auf 404...

 

der richtige link lautet:

http://www.microsoft.com/downloads/details.aspx?displaylang=de&FamilyID=E7877F67-C447-4873-B1B0-21F0626A6329

 

Klar geht das.Man braucht noch nicht einmal screnc.exe oder ein externes Programm, sondern nur das richtige VBS-Gegengift :

Aufruf mit: cscript decode.vbs geheimes_script.vbe



decode.vbs :

Code:

option explicit 
Dim oArgs, NomFichier 
'Optional argument : the encoded filename 
NomFichier="" 
Set oArgs = WScript.Arguments 
Select Case oArgs.Count 
Case 0 'No Arg, popup a dialog box to choose the file 
   NomFichier=BrowseForFolder("Choose an encoded file", &H4031, &H0011) 
Case 1 
   If Instr(oArgs(0),"?")=0 Then '-? ou /? => aide 
      NomFichier=oArgs(0) 
   End If 
Case Else 
   WScript.Echo "Too many parameters" 
End Select 
Set oArgs = Nothing 

If NomFichier<>"" Then 
   Dim fso 
   Set fso=WScript.CreateObject("Scripting.FileSystemObject") 
   If fso.FileExists(NomFichier) Then 
      Dim fic,contenu 
      Set fic = fso.OpenTextFile(NomFichier, 1) 
      Contenu=fic.readAll 
      fic.close 
      Set fic=Nothing 

      Const TagInit="#@~^" '#@~^awQAAA== 
      Const TagFin="==^#~@" '& chr(0) 
      Dim DebutCode, FinCode 
      Do 
         FinCode=0 
         DebutCode=Instr(Contenu,TagInit) 
         If DebutCode>0 Then 
            If (Instr(DebutCode,Contenu,"==")-DebutCode)=10 Then 'If "==" follows the tag 
               FinCode=Instr(DebutCode,Contenu,TagFin) 
               If FinCode>0 Then 
                  Contenu=Left(Contenu,DebutCode-1) & _ 
                  Decode(Mid(Contenu,DebutCode+12,FinCode-DebutCode-12-6)) & _ 
                  Mid(Contenu,FinCode+6) 
               End If 
            End If 
         End If 
      Loop Until FinCode=0 
      WScript.Echo Contenu 
   Else 
      WScript.Echo Nomfichier & " not found" 
   End If 
   Set fso=Nothing 
Else 
   WScript.Echo "Please give a filename" 
   WScript.Echo "Usage : " & wscript.fullname  & " " & WScript.ScriptFullName & " <filename>" 
End If 

Function Decode(Chaine) 
   Dim se,i,c,j,index,ChaineTemp 
   Dim tDecode(127) 
   Const Combinaison="1231232332321323132311233213233211323231311231321323112331123132" 

   Set se=WSCript.CreateObject("Scripting.Encoder") 
   For i=9 to 127 
      tDecode(i)="JLA" 
   Next 
   For i=9 to 127 
      ChaineTemp=Mid(se.EncodeScriptFile(".vbs",string(3,i),0,""),13,3) 
      For j=1 to 3 
         c=Asc(Mid(ChaineTemp,j,1)) 
         tDecode(c)=Left(tDecode(c),j-1) & chr(i) & Mid(tDecode(c),j+1) 
      Next 
   Next 
   'Next line we correct a bug, otherwise a ")" could be decoded to a ">" 
   tDecode(42)=Left(tDecode(42),1) & ")" & Right(tDecode(42),1) 
   Set se=Nothing 

   Chaine=Replace(Replace(Chaine,"@&",chr(10)),"@#",chr(13)) 
   Chaine=Replace(Replace(Chaine,"@*",">"),"@!","<") 
   Chaine=Replace(Chaine,"@$","@") 
   index=-1 
   For i=1 to Len(Chaine) 
      c=asc(Mid(Chaine,i,1)) 
      If c<128 Then index=index+1 
      If (c=9) or ((c>31) and (c<128)) Then 
         If (c<>60) and (c<>62) and (c<>64) Then 
            Chaine=Left(Chaine,i-1) & Mid(tDecode(c),Mid(Combinaison,(index mod 64)+1,1),1) & Mid(Chaine,i+1) 
         End If 
      End If 
   Next 
   Decode=Chaine 
End Function 

Function BrowseForFolder(ByVal pstrPrompt, ByVal pintBrowseType, ByVal pintLocation) 
   Dim ShellObject, pstrTempFolder, x 
   Set ShellObject=WScript.CreateObject("Shell.Application") 
   On Error Resume Next 
   Set pstrTempFolder=ShellObject.BrowseForFolder(&H0,pstrPrompt,pintBrowseType,pintLocation) 
   BrowseForFolder=pstrTempFolder.ParentFolder.ParseName(pstrTempFolder.Title).Path 
   If Err.Number<>0 Then BrowseForFolder="" 
   Set pstrTempFolder=Nothing 
   Set ShellObject=Nothing 
End Function