Rem Copyright (C) 2004-2022, Stefan Kanthak Rem * The software is provided "as is" without any warranty, neither express Rem nor implied. Rem In no event will the author be held liable for any damage(s) arising Rem from the use of the software. Rem * Redistribution of the software is allowed only in unmodified form. Rem * Permission is granted to use the software solely for personal private Rem and non-commercial purposes. Rem * An individuals use of the software in his or her capacity or function Rem as an agent, (independent) contractor, employee, member or officer of Rem a business, corporation or organization (commercial or non-commercial) Rem does not qualify as personal private and non-commercial purpose. Rem * Without written approval from the author the software must not be used Rem for a business, for commercial, corporate, governmental, military or Rem organizational purposes of any kind, or in a commercial, corporate, Rem governmental, military or organizational environment of any kind. With WScript.CreateObject("Scripting.FileSystemObject") Const fsoWindowsFolder = 0 Const fsoSystemFolder = 1 Const fsoTemporaryFolder = 2 Const fsoRead = 1 Const fsoWrite = 2 Const fsoAppend = 8 Const fsoASCII = 0 Const fsoUnicode = -1 Const fsoDefault = -2 ' Greek homoglyphs ' Const A = &h391 ' Const B = &h392 ' Const C = &h3F9 ' c = &h3F2 ' Const E = &h395 ' Const H = &h397 ' Const I = &h399 ' ' j = &h3F3 ' Const K = &h39A ' Const M = &h39C ' Const N = &h39D ' Const O = &h39F ' o = &h3BF ' Const P = &h3A1 ' Const T = &h3A4 ' ' v = &h3BD ' Const X = &h3A7 ' Const Y = &h3A5 ' Const Z = &h396 ' Cyrillic homoglyphs Const A = &h410 ' a = &h430 Const B = &h412 Const C = &h421 ' c = &h441 Const E = &h415 ' e = &h435 Const H = &h41D Const I = &h406 ' i = &h456 Const J = &h408 ' j = &h458 Const M = &h41C Const O = &h41E ' o = &h43E Const P = &h420 ' p = &h440 Const S = &h405 ' s = &h455 Const T = &h422 Const X = &h425 ' x = &h445 ' y = &h443 If WScript.Arguments.Count = 0 Then strFolder = .BuildPath(.GetSpecialFolder(fsoTemporaryFolder).Path, .GetTempName()) .CreateFolder strFolder WScript.CreateObject("Shell.Application").Explore strFolder Else strVirtual = .BuildPath(.GetSpecialFolder(fsoTemporaryFolder).ParentFolder.Path, "VirtualStore") strWindows = .BuildPath(strVirtual, .GetSpecialFolder(fsoWindowsFolder).Name) If Not .FolderExists(strWindows) Then .CreateFolder strWindows strFolder = .BuildPath(strWindows, .GetTempName()) .CreateFolder strFolder WScript.CreateObject("Shell.Application").Explore .GetSpecialFolder(fsoWindowsFolder).Path End If strPathExt = WScript.CreateObject("WScript.Shell").Environment("PROCESS").Item("PATHEXT") ' strPathExt = WScript.CreateObject("WScript.Shell").RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\PATHEXT") ' strPathExt = WScript.CreateObject("WScript.Shell").Environment("SYSTEM").Item("PATHEXT") ' strPathExt = WScript.CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Environment\PATHEXT") ' strPathExt = WScript.CreateObject("WScript.Shell").Environment("USER").Item("PATHEXT") ' strPathExt = WScript.CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Volatile Environment\PATHEXT") ' strPathExt = WScript.CreateObject("WScript.Shell").Environment("VOLATILE").Item("PATHEXT") strUnicode = .BuildPath(strFolder, "UNICODE.REG") .OpenTextFile(strUnicode, fsoWrite, vbTrue, fsoUnicode).WriteLine "Windows Registry Editor Version 5.00" blnFlag = vbFalse For Each strExtension In Array("ACM", ChrW(A) & ChrW(C) & ChrW(M), _ "ASA", ChrW(A) & ChrW(S) & ChrW(A), _ "ASP", ChrW(A) & ChrW(S) & ChrW(P), _ "AX", ChrW(A) & ChrW(X), _ "BAT", ChrW(B) & ChrW(A) & ChrW(T), _ "CAB", ChrW(C) & ChrW(A) & ChrW(B), _ "CHM", ChrW(C) & ChrW(H) & ChrW(M), _ "COM", ChrW(C) & ChrW(O) & ChrW(M), _ "EXE", ChrW(E) & ChrW(X) & ChrW(E), _ "HTA", ChrW(H) & ChrW(T) & ChrW(A), _ "HTC", ChrW(H) & ChrW(T) & ChrW(C), _ "HTM", ChrW(H) & ChrW(T) & ChrW(M), _ "IME", ChrW(I) & ChrW(M) & ChrW(E), _ "ISO", ChrW(I) & ChrW(S) & ChrW(O), _ "ISP", ChrW(I) & ChrW(S) & ChrW(P), _ "ITS", ChrW(I) & ChrW(T) & ChrW(S), _ "JOB", ChrW(J) & ChrW(O) & ChrW(B), _ "JS", ChrW(J) & ChrW(S), _ "JSE", ChrW(J) & ChrW(S) & ChrW(E), _ "MSC", ChrW(M) & ChrW(S) & ChrW(C), _ "MSI", ChrW(M) & ChrW(S) & ChrW(I), _ "MSP", ChrW(M) & ChrW(S) & ChrW(P), _ "MST", ChrW(M) & ChrW(S) & ChrW(T), _ "OCX", ChrW(O) & ChrW(C) & ChrW(X), _ "PPT", ChrW(P) & ChrW(P) & ChrW(T), _ "SCT", ChrW(S) & ChrW(C) & ChrW(T), _ "SHB", ChrW(S) & ChrW(H) & ChrW(B), _ "SHS", ChrW(S) & ChrW(H) & ChrW(S), _ "TMP", ChrW(T) & ChrW(M) & ChrW(P), _ "TSP", ChrW(T) & ChrW(S) & ChrW(P), _ "TXT", ChrW(T) & ChrW(X) & ChrW(T), _ "XPS", ChrW(X) & ChrW(P) & ChrW(S)) blnFlag = Not blnFlag If blnFlag Then On Error Resume Next strAssoc = WScript.CreateObject("WScript.Shell").RegRead("HKEY_CLASSES_ROOT\." & strExtension & "\") If Err.Number <> 0 Then strAssoc = vbNullString strMIME = WScript.CreateObject("WScript.Shell").RegRead("HKEY_CLASSES_ROOT\." & strExtension & "\Content Type") If Err.Number <> 0 Then strMIME = vbNullString On Error Goto 0 Else .CopyFile WScript.FullName, .BuildPath(strFolder, "UNICODE." & strExtension), vbTrue ' BUG: .RegWrite converts UTF-16LE to ANSI and creates the subkeys ".??" and ".???" ' WScript.CreateObject("WScript.Shell").RegWrite "HKEY_CURRENT_USER\Software\Classes\." & strExtension & "\", strAssoc, "REG_SZ" ' WScript.CreateObject("WScript.Shell").RegWrite "HKEY_CURRENT_USER\Software\Classes\." & strExtension & "\Content Type", strMIME, "REG_SZ" With .OpenTextFile(strUnicode, fsoAppend, vbFalse, fsoUnicode) .WriteLine .WriteLine "[HKEY_CURRENT_USER\Software\Classes\." & strExtension & "]" .WriteLine "@=""" & strAssoc & """" .WriteLine """Content Type""=""" & strMIME & """" End With strPathExt = "." & strExtension & ";" & strPathExt End If Next With .OpenTextFile(strUnicode, fsoAppend, vbFalse, fsoUnicode) .WriteLine .WriteLine "[HKEY_CURRENT_USER\Volatile Environment]" .WriteLine """PATHEXT""=""" & strPathExt & """" End With With WScript.CreateObject("WScript.Shell") ' .Run """%SystemRoot%\System32\Reg.exe"" IMPORT """ & strUnicode & """", 0, vbTrue .Environment("PROCESS").Item("__COMPAT_LAYER") = "RunAsInvoker" .Run """%SystemRoot%\RegEdit.exe"" /S """ & strUnicode & """", 10, vbTrue .Environment("VOLATILE").Item("PATHEXT") = strPathExt End With End With