Attachment 'autoExec.vbs.html'
Download' Code formatted with <https://www.xhcode.com/vbscriptformat/> With WScript If .Arguments.Count < 1 Then .Echo"Quit." .Quit End If Set objFS = .CreateObject("Scripting.FileSystemObject") Set objWshShell = .CreateObject("WScript.Shell") Set objMessage = .CreateObject("Scripting.Dictionary") End With nowTime = Now debugMode = False If Not debugMode Then On Error Resume Next Const ERROR_SUCCESS = 0 Const ERROR_EBP_BASE = & HB1050000 Const EBP_BADPARAM = & H0001 Const EBP_NOTSUPPORTOS = & H0002 Const EBP_NOTADMIN = & H0003 Const EBP_ALREADYEXEC = & H0004 Const EBP_CANNOTEXEC = & H0005 Const EBP_NOTSUPPORTPC = & H0006 Const EBP_NOTCOMPATIBLEPC = & H0007 Const EBP_NOTCOMPATIIMAGE = & H0008 Const EBP_CANNOTDELFOLDER = & H0009 Const EBP_UPTODATE = & H000A Const EBP_EXECCANCELED = & H0100 Const EBP_NOPERMISSION = & H0101 Const EBP_BADDEVDRIVER = & H0102 Const EBP_INCOMPATIIMAGE = & H0103 Const EBP_CANNOTREADIMAGE = & H0104 Const EBP_CORRUPTEDIMAGE = & H0105 Const EBP_BADENCPASFORMAT = & H0106 Const EBP_SOMEERROR_BASE = & H0100 Const EBP_ESPERROR_BASE = & H1000 Const EBP_EXTRACTCANCELED = & H0200 Const EBP_CANNOTEXTRACT = & H0201 Const MsgBoxWidth = 600 Const MsgBoxHeight = 400 Const MsgBoxWidth2 = 610 Const MsgBoxHeight2 = 420 Const FdBoxWidth = 450 Const FdBoxHeight = 250 Const strMutexName = "DBI_BIOS_Package_2" Const strPopupTitle = "%b BIOS Package %v" Const strPackageFolder = "BIOS_Package" Const strCloseFlgName = "_closeexecutingbar_.flg" Const strOldBrandName = "TOSHIBA" Const strTargetBase = "C:\TOSHBIOS." Const strDefFolderExt = "UPD" Const strAutoFolderExt = "AUTO" Const strFdFolderExt = "FD" Const strSmsFolderExt = "SMS" Const strBiosFolderName = "BIOS" Const strEcFolderName = "EC" Const strUndefinedFolder = "Undefined_Folder" Const strExe32Name = "NCHGBIOS2.EXE" Const strExe64Name = "NCHGBIOS2x64.EXE" Const strChgBiosName = "CHGBIOSF.EXE" Const strExeESP32Name = "NCHGBIOSESP.EXE" Const strExeESP64Name = "NCHGBIOSESPx64.EXE" Const strChgBiosEFIName = "CHGBIOSA.EFI" Const strExe32Name3 = "NCHGBIOS3.EXE" Const strExe64Name3 = "NCHGBIOS3x64.EXE" Const strChgBiosPegasus10PName = "TOSFIRMUP.EFI" Const strChgBiosPegasus10PToolName = "startup.nsh" Const strBiosFilePrefix = "BIO" Const strBiosFileExt = "T.COM" Const strBiosPegasus10PFileExt = "T.BIN" Const strBiosPegasus10PToolName = "H2OFFT-Sx64.efi" Const strEcFilePrefix = "EC" Const strEcFileExt = "BIN" Const strEcPegasus10PFileExt = "TXT" Const strEcPegasus10PToolName = "ChgPgEC.efi" Const strMachineIdPegasus10P = "00A1" Const strEcTypePegasus10P = "ECPG" Const strRequiredBiosVersionPegasus10P = "1.60" Const strMachineIdSkylakeOrLater = "009D" aryMachineIdNotSkylake = Array("009E","00A1","00A3","00A4","00A5","00A8","00AA","00AC") Const strPostExeName = "TosDspProfileConvert.exe" Const strSilentParam = "/silent" Const strAutoParam = "/auto" Const strFdParam = "/fd" Const strSmsParam = "/sms" Const strAnyOSParam = "/anyos" Const strAllowReWriteParam = "/force" Const strAllowVersionDownParam = "/allowversiondown" Const strNoCleanParam = "/noClean" Const strNoRebootParam = "/noreboot" Const strWarnTypeSParam = "/ws" Const strLangParam = "/lang" Const strSvPassParam = "/svpass" Const strOwnerParam = "/owner" Const strExecParam = "/exec" Const strSuppressPopupParam = "/suppresspopup" Const strCheckOnlyParam = "/checkonly" Const strDebugMode = "/debugMode" Const strParamFileExt = ".prm" Const strParamOwnerSection = "owner" Const strParamX64Key = "x64" Const strParamAdminKey = "admin" Const strParamLangIDKey = "langid" Const strParamSystemSection = "system" Const strParamMachineIdKey = "MID" Const strParamBiosVersionKey = "BiosVer" Const strParamEcTypeKey = "EcType" Const strParamEcVersionKey = "EcVer" Const strParamBootModeKey = "BootMode" Const strParamIntelTxtKey = "iTxt" Const strEmbedFileExt = ".emb" Const strEmbedSvPassKey = "svpass" Const strEmbedSilentKey = "silent" Const strEmbedNoRebootKey = "noreboot" Const strEmbedAllowReWriteKey = "force" Const strDefLangId = "0409" Const strIniFileName = "version.ini" Const strIniPackageSection = "BIOS_Package" Const strIniVersionKey = "version" Const strIniCompanySection = "Company" Const strIniBrandNameKey = "brand_name" specialCase = Array(Array(1,"0075","EC71","<","V1.50"),Array(1,"0076","EC72","<","V1.50"),Array(1,"0077","EC74","<","V1.20"),Array(1,"007D","EC77","<","V1.50"),Array(1,"007E","EC78","<","V1.30"),Array(1,"007F","EC7A","<","V1.10"),Array(1,"0080","EC79","<","V1.10"),Array(1,"0081","EC7C","<","V1.20"),Array(0)) exitCode = ERROR_SUCCESS ownerMode = False cleanMode = True rebootMode = False noRebootMode = False silentMode = False autoMode = False fdMode = False smsMode = False anyOSMode = False checkOnlyMode = False allowReWriteMode = False allowVerDownMode = False WarnTypeS = False x64Mode = False tcsMode = False suppressPopup = False isAdmin = False ExecutingBarClosed = False isPegasus10P = False isSkylakeOrLater = False isBiosBootUEFI = False isSchemeESP = False LangID = strDefLangId MachineID = "" BiosVersion = "" EcType = "" EcVersion = "" BootMode = "" iTxtState = "" UpdaterExe = "" ownerPath = "" debugLogFile = "" extractFolder = "" SvPass = "" ErrorMsg = "" lastError = "" Const BDEdisableCount = 1 autoSuspendBDE = False Const MinimumBatteryLifePercent = 30 needBattChk = True FONT_COLOR_WHITE = vbWhite FONT_COLOR_BLUE = vbBlue FONT_COLOR_RED = vbRed FONT_COLOR_GREEN = RGB(0,128,0) FONT_COLOR_LIME = vbGreen FONT_COLOR_MAROON = RGB(128,0,0) FONT_COLOR_ORANGE = RGB(238,120,0) myPath = WScript.ScriptFullName With objFS myFolder = .GetParentFolderName(myPath) myName = .GetFileName(myPath) myBaseName = .GetBaseName(myName) paramFile = .BuildPath(myFolder,myBaseName & strParamFileExt) embedFile = .BuildPath(myFolder,myBaseName & strEmbedFileExt) iniFile = .BuildPath(myFolder,strIniFileName) End With curFolder = objWshShell.CurrentDirectory If objFS.FileExists(paramFile)Then x64Mode = (GetIniKeyVal(paramFile,strParamOwnerSection,strParamX64Key) = "1") isAdmin = (GetIniKeyVal(paramFile,strParamOwnerSection,strParamAdminKey) = "1") LangID = GetIniKeyVal(paramFile,strParamOwnerSection,strParamLangIDKey) MachineID = GetIniKeyVal(paramFile,strParamSystemSection,strParamMachineIdKey) BiosVersion = GetIniKeyVal(paramFile,strParamSystemSection,strParamBiosVersionKey) EcType = GetIniKeyVal(paramFile,strParamSystemSection,strParamEcTypeKey) EcVersion = GetIniKeyVal(paramFile,strParamSystemSection,strParamEcVersionKey) BootMode = GetIniKeyVal(paramFile,strParamSystemSection,strParamBootModeKey) iTxtState = GetIniKeyVal(paramFile,strParamSystemSection,strParamIntelTxtKey) End If If Len(LangID) <> 4 Then LangID = FormatToHex(Hex(GetLocale),4) If objFS.FileExists(embedFile)Then If GetIniKeyVal(embedFile,"",strEmbedSilentKey) = "1" Then silentMode = True If GetIniKeyVal(embedFile,"",strEmbedNoRebootKey) = "1" Then noRebootMode = True If GetIniKeyVal(embedFile,"",strEmbedAllowReWriteKey) = "1" Then allowReWriteMode = True SvPass = GetIniKeyVal(embedFile,"",strEmbedSvPassKey) End If BrandName = GetIniKeyVal(iniFile,strIniCompanySection,strIniBrandNameKey) If BrandName = "" Then BrandName = strOldBrandName PackageVer = GetIniKeyVal(iniFile,strIniPackageSection,strIniVersionKey) PopupTitle = StringReplace(StringReplace(strPopupTitle,"%b",BrandName),"%v",PackageVer) If WScript.Arguments.Count > 0 Then For i = 0 To WScript.Arguments.Count - 1 arg = WScript.Arguments(i) If InStr(arg,strDebugMode & "=") = 1 Then debugMode = True debugLogFile = Mid(arg,Len(strDebugMode) + 2) ElseIf arg = strDebugMode Then debugMode = True ElseIf InStr(arg,strOwnerParam & "=") = 1 Then ownerPath = Mid(arg,Len(strOwnerParam) + 2) If ownerPath <> "" Then ownerMode = True End If Next End If If debugMode Then PopupTitle = "[DEBUG] " & PopupTitle If debugLogFile <> "" Then With objFS If(.GetBaseName(debugLogFile) <> "")And(.GetExtensionName(debugLogFile) <> "")Then debugLogFile = .GetAbsolutePathName(debugLogFile) ElseIf ownerMode Then debugLogFile = .BuildPath(.GetParentFolderName(ownerPath),.GetBaseName(ownerPath) & "_" & GetDateString(nowTime,2) & ".log") Else debugLogFile = .BuildPath(curFolder,strIniPackageSection & "_" & GetDateString(nowTime,2) & ".log") End If End With DebugMessage"[[[[ Debug Start ]]]]" & vbCrLf Else DebugMessage"Debug mode." End If If ownerMode Then DebugMessage"Owner mode." End If If WScript.Arguments.Count > 0 Then For i = 0 To WScript.Arguments.Count - 1 arg = WScript.Arguments(i) LCarg = LCase(arg) If arg = strNoCleanParam Then cleanMode = False DebugMessage"No Clean mode." ElseIf LCarg = strSilentParam Then silentMode = True DebugMessage"Silent mode." ElseIf LCarg = strAutoParam Then If extractFolder = "" Then autoMode = True DebugMessage"Auto mode." Else exitCode = EBP_BADPARAM End If ElseIf LCarg = strFdParam Then fdMode = True DebugMessage"FD mode." ElseIf LCarg = strSmsParam Then smsMode = True DebugMessage"SMS mode." ElseIf LCarg = strAnyOSParam Then anyOSMode = True DebugMessage"Any OS mode." ElseIf LCarg = strAllowReWriteParam Then allowReWriteMode = True DebugMessage"Allow Re-Write mode." ElseIf LCarg = strAllowVersionDownParam Then allowVerDownMode = True DebugMessage"Allow Version Down mode." ElseIf LCarg = strNoRebootParam Then noRebootMode = True DebugMessage"No Reboot mode." ElseIf LCarg = strWarnTypeSParam Then WarnTypeS = True DebugMessage"Warning type: S" ElseIf LCarg = strSuppressPopupParam Then suppressPopup = True DebugMessage"Suppress Popup mode." ElseIf InStr(LCarg,strSvPassParam & "=") = 1 Then SvPass = Mid(arg,Len(strSvPassParam) + 2) If SvPass = "" Then exitCode = EBP_BADPARAM DebugMessage"SvPass = " & SvPass ElseIf InStr(LCarg,strLangParam & "=") = 1 Then If Len(LCarg) = (Len(strLangParam) + 4)Then LCarg = Right(LCarg,3) If LCarg = "enu" Then LangID = "0409" ElseIf LCarg = "jpn" Then LangID = "0411" Else exitCode = EBP_BADPARAM End If DebugMessage"LangID = " & LangID Else exitCode = EBP_BADPARAM End If ElseIf(Left(LCarg,1) <> "/")And(extractFolder = "")Then extractFolder = arg End If If exitCode <> ERROR_SUCCESS Then Exit For Next End If If cleanMode And Not ownerMode Then cleanMode = False DebugMessage"Changed to No Clean mode." End If If cleanMode Then With objFS If .FileExists(myPath)Then .DeleteFile myPath,True If .FileExists(paramFile)Then .DeleteFile paramFile,True If .FileExists(embedFile)Then .DeleteFile embedFile,True If .FileExists(iniFile)Then .DeleteFile iniFile,True End With End If TranslateMessages cleanMode If exitCode = ERROR_SUCCESS Then If silentMode Then If fdMode Or autoMode Or smsMode Or(extractFolder <> "")Then exitCode = EBP_BADPARAM Else autoMode = True suppressPopup = True End If ElseIf autoMode Then If fdMode Or smsMode Then exitCode = EBP_BADPARAM ElseIf extractFolder <> "" Then If InStr(UCase(extractFolder),UCase(strTargetBase)) = 1 Then strExt = UCase(Mid(extractFolder,Len(strTargetBase) + 1)) Else strExt = UCase(objFS.GetExtensionName(extractFolder)) End If DebugMessage"strExt = """ & strExt & """" If strExt = UCase(strSmsFolderExt)Then noRebootMode = True smsMode = True DebugMessage"Changed to SMS mode." ElseIf strExt = UCase(strFdFolderExt)Then autoMode = False fdMode = True extractFolder = "" DebugMessage"Changed to FD mode." ElseIf strExt <> UCase(strAutoFolderExt)Then exitCode = EBP_BADPARAM End If End If ElseIf smsMode Then If fdMode Or(extractFolder <> "")Then exitCode = EBP_BADPARAM Else autoMode = True noRebootMode = True End If ElseIf fdMode Then If suppressPopup Then exitCode = EBP_BADPARAM End If If allowVerDownMode And Not allowReWriteMode Then exitCode = EBP_BADPARAM End If If Not autoMode Then suppressPopup = False If UCase(BrandName) = UCase(strOldBrandName)Then PopupTitle = ReplMessage("OLDCAPTIONTITLE","%v",PackageVer) Else PopupTitle = ReplMessage("CAPTIONTITLE","%v",PackageVer) End If If debugMode Then PopupTitle = "[DEBUG] " & PopupTitle OSType = GetOSType isWin10 = (OSType >= OS_Win10) isWin10Home = isWin10 And IsWindowsHomeEdition DebugMessage"myPath = """ & myPath & """" & vbCrLf & "myFolder = """ & myFolder & """" & vbCrLf & "myName = """ & myName & """" & vbCrLf & "paramFile = """ & paramFile & """" & vbCrLf & "embedFile = """ & embedFile & """" & vbCrLf & "iniFile = """ & iniFile & """" & vbCrLf & "curFolder = """ & curFolder & """" & vbCrLf & "extractFolder = """ & extractFolder & """" & vbCrLf & vbCrLf & "OS Type = " & OSType & vbCrLf & "isWin10 = " & isWin10 & vbCrLf & "isWin10Home = " & isWin10Home & vbCrLf & "x64Mode = " & x64Mode & vbCrLf & "isAdmin = " & isAdmin & vbCrLf & "LangID = """ & LangID & """" & vbCrLf & "MachineID = " & MachineID & vbCrLf & "BiosVersion = """ & BiosVersion & """" & vbCrLf & "EcType = " & EcType & vbCrLf & "EcVersion = """ & EcVersion & """" & vbCrLf & "BootMode = " & BootMode & vbCrLf & "iTxtState = " & iTxtState & vbCrLf & "silentMode = " & silentMode & vbCrLf & "noRebootMode = " & noRebootMode & vbCrLf & "allowReWriteMode = " & allowReWriteMode & vbCrLf & vbCrLf & "BrandName = """ & BrandName & """" & vbCrLf & "PackageVer = """ & PackageVer & """" & vbCrLf & "PopupTitle = """ & PopupTitle & """" If debugMode Then On Error GoTo 0 Do If exitCode <> ERROR_SUCCESS Then ErrorMsg = GetMessage("BADPARAM") Exit Do End If If OSType < OS_WinXP Then exitCode = EBP_NOTSUPPORTOS ErrorMsg = GetMessage("NOTSUPPORTOS") Exit Do End If If Not isAdmin Then exitCode = EBP_NOTADMIN ErrorMsg = GetMessage("NOTADMIN") Exit Do End If If MutexExist(strMutexName)Then exitCode = EBP_ALREADYEXEC ErrorMsg = GetMessage("ALREADYEXEC") Exit Do End If Set objHelper = (New CTosWshHelper)(x64Mode,strMutexName) If Not objHelper.Activated Then exitCode = EBP_CANNOTEXEC ErrorMsg = GetMessage("CANNOTEXEC") Exit Do End If DebugMessage"Exec ..." If MachineID = "" Then MachineID = objHelper.MachineInfo("MID") If Len(MachineID) <> 4 Then DebugMessage"MachineID = [" & MachineID & "]" MachineID = "" ElseIf MachineID = strMachineIdPegasus10P Then isPegasus10P = True EcType = strEcTypePegasus10P ElseIf MachineID >= strMachineIdSkylakeOrLater Then isSkylakeOrLater = True For Each excludedMID In aryMachineIdNotSkylake If MachineID = excludedMID Then isSkylakeOrLater = False Exit For End If Next End If If EcType = "" Then EcType = objHelper.MachineInfo("EcType") If Len(EcType) <> 4 Then DebugMessage"EcType = [" & EcType & "]" EcType = "" End If If BootMode = "UEFI" Then isBiosBootUEFI = True DebugMessage"MachineID => " & MachineID & vbCrLf & "EcType => " & EcType & vbCrLf & "isBiosBootUEFI = " & isBiosBootUEFI & vbCrLf & "isSkylakeOrLater = " & isSkylakeOrLater & vbCrLf & "isPegasus10P = " & isPegasus10P If BiosVersion = "" Then BiosVersion = objHelper.MachineInfo("BiosVersion") DebugMessage"BiosVersion => """ & BiosVersion & """" End If If EcVersion = "" Then EcVersion = objHelper.MachineInfo("EcVersion") DebugMessage"EcVersion => """ & EcVersion & """" End If If Not IsValidVersionFormat(EcVersion)Then EcVersion = "" If(MachineID = "")Or(BiosVersion = "")Or(EcType = "")Or(EcVersion = "")Or(BootMode = "")Then exitCode = EBP_NOTSUPPORTPC ErrorMsg = GetMessage("NOTSUPPORTPC") Exit Do End If If isPegasus10P Then isSchemeESP = True ElseIf isSkylakeOrLater Then If isBiosBootUEFI Then isSchemeESP = True ElseIf x64Mode Then UpdaterExe = strExe64Name3 Else UpdaterExe = strExe32Name3 End If ElseIf x64Mode Then UpdaterExe = strExe64Name Else UpdaterExe = strExe32Name End If DebugMessage"isSchemeESP = " & isSchemeESP If(UpdaterExe = "")And isSchemeESP Then If x64Mode Then UpdaterExe = strExeESP64Name Else UpdaterExe = strExeESP32Name End If End If If UpdaterExe <> "" Then UpdaterExe = objFS.BuildPath(myFolder,UpdaterExe) DebugMessage"UpdaterExe = """ & UpdaterExe & """" If Not objFS.FileExists(UpdaterExe)Then UpdaterExe = "" End If If UpdaterExe = "" Then exitCode = EBP_NOTCOMPATIBLEPC ErrorMsg = GetMessage("NOTCOMPATIBLEPC") Exit Do End If If isPegasus10P Then BiosFileName = strBiosFilePrefix & MachineID & strBiosPegasus10PFileExt Else BiosFileName = strBiosFilePrefix & MachineID & strBiosFileExt End If BiosFile = objFS.BuildPath(myFolder,BiosFileName) BiosPegasus10PToolName = strBiosPegasus10PToolName BiosPegasus10PTool = objFS.BuildPath(myFolder,BiosPegasus10PToolName) BiosFolder = objFS.BuildPath(myFolder,strBiosFolderName) If objFS.FolderExists(BiosFolder)Then NewBiosFile = objFS.BuildPath(BiosFolder,BiosFileName) If objFS.FileExists(NewBiosFile)Then If objFS.FileExists(BiosFile)Then objFS.DeleteFile BiosFile,True If debugMode Then objFS.CopyFile NewBiosFile,BiosFile,False Else objFS.MoveFile NewBiosFile,BiosFile End If End If NewBiosPegasus10PTool = objFS.BuildPath(BiosFolder,BiosPegasus10PToolName) If objFS.FileExists(NewBiosPegasus10PTool)Then If objFS.FileExists(BiosPegasus10PTool)Then objFS.DeleteFile BiosPegasus10PTool,True If debugMode Then objFS.CopyFile NewBiosPegasus10PTool,BiosPegasus10PTool,False Else objFS.MoveFile NewBiosPegasus10PTool,BiosPegasus10PTool End If End If If ownerMode And Not debugMode Then objFS.DeleteFolder BiosFolder,True End If If(BiosFile <> "")And Not objFS.FileExists(BiosFile)Then BiosFile = "" If BiosFile = "" Then BiosFileName = "" If(BiosPegasus10PTool <> "")And Not objFS.FileExists(BiosPegasus10PTool)Then BiosPegasus10PTool = "" If BiosPegasus10PTool <> "" Then BiosPegasus10PToolName = "" EcFileName = "" EcFile = "" EcPegasus10PToolName = "" EcPegasus10PTool = "" EcFolder = objFS.BuildPath(myFolder,strEcFolderName) If objFS.FolderExists(EcFolder)Then For Each objFile In objFS.GetFolder(EcFolder).Files With objFile fileExt = UCase(objFS.GetExtensionName(.Name)) If isPegasus10P Then If(UCase(Left(.Name,2)) = Left(EcType,2))And(fileExt = strEcPegasus10PFileExt)Then EcFileName = .Name EcFile = objFS.BuildPath(myFolder,EcFileName) EcPegasus10PToolName = strEcPegasus10PToolName EcPegasus10PTool = objFS.BuildPath(myFolder,EcPegasus10PToolName) If objFS.FileExists(EcFile)Then objFS.DeleteFile EcFile,True If debugMode Then objFS.CopyFile .Path,EcFile,False Else objFS.MoveFile .Path,EcFile End If NewEcPegasus10PTool = objFS.BuildPath(EcFolder,EcPegasus10PToolName) If objFS.FileExists(NewEcPegasus10PTool)Then If objFS.FileExists(EcPegasus10PTool)Then objFS.DeleteFile EcPegasus10PTool,True If debugMode Then objFS.CopyFile NewEcPegasus10PTool,EcPegasus10PTool,False Else objFS.MoveFile NewEcPegasus10PTool,EcPegasus10PTool End If End If End If ElseIf(UCase(Left(.Name,4)) = EcType)And(fileExt = strEcFileExt)Then EcFileName = .Name EcFile = objFS.BuildPath(myFolder,EcFileName) If objFS.FileExists(EcFile)Then objFS.DeleteFile EcFile,True If debugMode Then objFS.CopyFile .Path,EcFile,False Else objFS.MoveFile .Path,EcFile End If End If End With If EcFile <> "" Then Exit For Next If ownerMode And Not debugMode Then objFS.DeleteFolder EcFolder,True End If If EcFile = "" Then For Each objFile In objFS.GetFolder(myFolder).Files With objFile fileExt = UCase(objFS.GetExtensionName(.Name)) If isPegasus10P Then If(UCase(Left(.Name,2)) = Left(EcType,2))And(fileExt = strEcPegasus10PFileExt)Then EcFileName = .Name EcFile = .Path End If ElseIf(UCase(Left(.Name,4)) = EcType)And(fileExt = strEcFileExt)Then EcFileName = .Name EcFile = .Path End If End With If EcFile <> "" Then Exit For Next End If If(EcFile <> "")And Not objFS.FileExists(EcFile)Then EcFile = "" If EcFile = "" Then EcFileName = "" If(EcPegasus10PTool <> "")And Not objFS.FileExists(EcPegasus10PTool)Then EcPegasus10PTool = "" If EcPegasus10PTool <> "" Then EcPegasus10PToolName = "" DebugMessage"BiosFile = """ & BiosFile & """" & vbCrLf & "BiosPegasus10PTool = """ & BiosPegasus10PTool & """" & vbCrLf & "EcFile = """ & EcFile & """" & vbCrLf & "EcPegasus10PTool = """ & EcPegasus10PTool & """" If(BiosFile = "")And(EcFile = "")Then exitCode = EBP_NOTCOMPATIBLEPC ErrorMsg = GetMessage("NOTCOMPATIBLEPC") Exit Do End If BiosFileVer = "" EcFileVer = "" strVerMsg = "" If BiosFile <> "" Then BiosFileVer = GetBiosFileVer(BiosFile,"BIOS") DebugMessage"BiosFileVer = """ & BiosFileVer & """" If BiosFileVer <> "" Then ver1 = StringReplace(Mid(BiosVersion,2)," "," ") ver2 = StringReplace(Mid(BiosFileVer,2)," "," ") strVerMsg = strVerMsg & StringReplace(ReplMessage("BIOSVERS","%1",ver1),"%2",ver2) & vbCrLf Else strVerMsg = "BIOS" exitCode = EBP_NOTCOMPATIIMAGE End If End If If EcFile <> "" Then EcFileVer = GetEcFileVer(EcFile,EcType) DebugMessage"EcFileVer = """ & EcFileVer & """" If EcFileVer <> "" Then ver1 = StringReplace(Mid(EcVersion,2)," "," ") ver2 = StringReplace(Mid(EcFileVer,2)," "," ") strVerMsg = strVerMsg & StringReplace(ReplMessage("ECVERS","%1",ver1),"%2",ver2) & vbCrLf Else If exitCode <> ERROR_SUCCESS Then strVerMsg = GetMessage("BIOSANDEC") Else strVerMsg = strEcFilePrefix End If exitCode = EBP_NOTCOMPATIIMAGE End If End If If exitCode <> ERROR_SUCCESS Then ErrorMsg = ReplMessage("NOTCOMPATIIMAGE","%s",strVerMsg) Exit Do End If UpdateBIOS = BiosFile <> "" UpdateEC = EcFile <> "" strTarget = GetTargetMessage(UpdateBIOS,UpdateEC) For i = LBound(specialCase)To UBound(specialCase) Select Case specialCase(i)(0) Case 1 If((specialCase(i)(1) = "")Or(MachineID = specialCase(i)(1)))And((specialCase(i)(2) = "")Or(EcType = specialCase(i)(2)))Then compStr = specialCase(i)(4) tempStr = Left(EcVersion,Len(compStr)) Select Case specialCase(i)(3) Case"=" If tempStr = compStr Then needBattChk = False Case">" If tempStr > compStr Then needBattChk = False Case"<" If tempStr < compStr Then needBattChk = False Case">=" If tempStr >= compStr Then needBattChk = False Case"<=" If tempStr <= compStr Then needBattChk = False Case"<>" If tempStr <> compStr Then needBattChk = False End Select If Not needBattChk Then DebugMessage"Special Case 1: needBattChk = " & needBattChk End If End Select Next If Not fdMode Then strUpdMsg = "" strNonMsg = "" strErrMsg = "" RewriteBIOS = False VerDownBIOS = False RewriteEC = False VerDownEC = False If UpdateBIOS Then flg = CompareFirmwareVersion(BiosFileVer,BiosVersion) If flg = 0 Then If allowReWriteMode Then RewriteBIOS = True Else UpdateBIOS = False End If ElseIf flg < 0 Then If allowVerDownMode Then VerDownBIOS = True Else UpdateBIOS = False End If End If End If If UpdateEC Then flg = CompareFirmwareVersion(EcFileVer,EcVersion) If flg = 0 Then If allowReWriteMode Then RewriteEC = True Else UpdateEC = False End If ElseIf flg < 0 Then If allowVerDownMode Then VerDownEC = True Else UpdateEC = False End If End If End If BiosVerTooLow = False If isPegasus10P And(UpdateBIOS Or UpdateEC)Then If CompareFirmwareVersion(BiosVersion,strRequiredBiosVersionPegasus10P) < 0 Then BiosVerTooLow = True UpdateBIOS = False UpdateEc = False End If End If If UpdateBIOS Or UpdateEC Then strTarget = GetTargetMessage(UpdateBIOS,UpdateEC) If UpdateBIOS And UpdateEC Then If RewriteBIOS And RewriteEC Then strUpdMsg = ReplMessage("FORCEREWRITE","%s",strTarget) ElseIf VerDownBIOS And VerDownEC Then strUpdMsg = ReplMessage("FORCEVERDOWN","%s",strTarget) ElseIf RewriteBIOS Or VerDownBIOS Or RewriteEC Or VerDownEC Then strUpdMsg = ReplMessage("FORCEUPDATE","%s",strTarget) Else strUpdMsg = ReplMessage("NEEDUPDATE","%s",strTarget) End If ElseIf RewriteBIOS Or RewriteEC Then strUpdMsg = ReplMessage("FORCEREWRITE","%s",strTarget) ElseIf VerDownBIOS Or VerDownEC Then strUpdMsg = ReplMessage("FORCEVERDOWN","%s",strTarget) Else strUpdMsg = ReplMessage("NEEDUPDATE","%s",strTarget) End If ElseIf BiosVerTooLow Then exitCode = EBP_CANNOTEXEC strNonMsg = GetMessage("CANNOTEXEC") Else exitCode = EBP_UPTODATE If strTarget = GetMessage("BIOSANDEC")Then strNonMsg = ReplMessage("NONEEDUPDATE2","%s",strTarget) Else strNonMsg = ReplMessage("NONEEDUPDATE","%s",strTarget) End If End If BDEstate = GetBDEstate autoSuspendBDE = (isWin10 And(BDEstate = BDE_PROTECTION_ON)) enableBDEmessage = ((BDEstate <> BDE_PROTECTION_NONE)And((BDEstate = BDE_PROTECTION_UNKNOWN)Or Not isWin10Home)And Not autoSuspendBDE) DebugMessage"BDEProtectionStatus = " & BDEstate & vbCrLf & "autoSuspendBDE = " & autoSuspendBDE & vbCrLf & "enableBDEmessage = " & enableBDEmessage If checkOnlyMode Then If Not suppressPopup Then CloseExecutingBar PopupInfoMsg strUpdMsg & strNonMsg End If Exit Do End If Set objMsgBox = objHelper.CreatePopup Do If Not objHelper.IsPopup(objMsgBox)Then exitCode = EBP_CANNOTEXEC ErrorMsg = GetMessage("CANNOTEXEC") Exit Do End If If exitCode = ERROR_SUCCESS Then exitCode = EBP_EXECCANCELED With objMsgBox If Not suppressPopup Then If Not needBattChk Then .Property("Width") = MsgBoxWidth2 .Property("Height") = MsgBoxHeight2 Else .Property("Width") = MsgBoxWidth .Property("Height") = MsgBoxHeight End If .Property("BaseColor") = FONT_COLOR_WHITE .Property("Title") = PopupTitle .ButtonAdd GetMessage("EXECBUTTON"),False .ButtonAdd GetMessage("CLOSEBUTTON") .ButtonDefault = POPUP_BUTTON2 .Open CloseExecutingBar End If FirstTime = True CanExec = False ReqExec = False ReqExit = suppressPopup ExitSleep = 0 CheckCount = 0 CurBDEstate = BDEstate Do If CheckCount > 0 Then CheckCount = CheckCount - 1 ElseIf CheckCount = 0 Then CheckCount = 10 If UpdateBIOS Or UpdateEC Then strWarnMsg = "" CurState = True If LCase(objHelper.MachineInfo("iTxt")) = "enabled" Then strWarnMsg = ReplMessage("ITXTENABLED","%s",strTarget) CurState = False ElseIf Not objHelper.PowerCheck(needBattChk)Then If(Not isPegasus10P)Or(Trim(EcVersion) <> "V0.00")Then If needBattChk Then strWarnMsg = GetMessage("NEEDPOWER") Else strWarnMsg = GetMessage("NEEDACPOWER") End If CurState = False End If End If If enableBDEmessage Then CurBDEstate = GetBDEstate If FirstTime Or(CanExec <> CurState)Or(BDEstate <> CurBDEstate)Then CanExec = CurState BDEstate = CurBDEstate If FirstTime Then DebugMessage"CanExec = " & CanExec & vbCrLf & "BDEstate = " & BDEstate If CanExec And autoMode Then ReqExec = True If Not suppressPopup Then BtnFocus = POPUP_BUTTON2 .Message = strVerMsg & vbCrLf If CanExec Then .MessageLineAdd strUpdMsg,FONT_COLOR_BLUE,FONT_STYLE_BOLD .MessageLineAdd"" .MessageLineAdd GetMessage("CAUTIONS"),FONT_COLOR_MAROON,FONT_STYLE_BOLD .MessageLineAdd"" If(BDEstate = BDE_PROTECTION_NONE)Or Not enableBDEmessage Then BtnFocus = POPUP_BUTTON1 Else If BDEstate = BDE_PROTECTION_OFF Then .MessageLineAdd ReplMessage("BDESUSPENDED","%s",strTarget),FONT_COLOR_MAROON,FONT_STYLE_BOLD BtnFocus = POPUP_BUTTON1 ElseIf BDEstate = BDE_PROTECTION_ON Then .MessageLineAdd ReplMessage("BDEENABLED","%s",strTarget),FONT_COLOR_RED,FONT_STYLE_BOLD Else .MessageLineAdd ReplMessage("BDEUNKNOWN","%s",strTarget),FONT_COLOR_MAROON,FONT_STYLE_BOLD End If .MessageLineAdd"" End If .MessageLineAdd ReplMessage("NOTICE","%s",strTarget) If Not needBattChk Then .MessageLineAdd"" .MessageLineAdd GetMessage("NEEDBATTCHARGE"),FONT_COLOR_MAROON,FONT_STYLE_BOLD End If Else .MessageLineAdd strWarnMsg,FONT_COLOR_RED,FONT_STYLE_BOLD End If .Property("MessageScroll") = "Top" .ButtonEnable(POPUP_BUTTON1) = CanExec .ButtonSetFocus BtnFocus End If End If ElseIf FirstTime And Not suppressPopup Then .Message = strVerMsg & vbCrLf If strNonMsg <> "" Then If BiosVerTooLow Then .MessageLineAdd strNonMsg,FONT_COLOR_ORANGE,FONT_STYLE_BOLD Else .MessageLineAdd strNonMsg,FONT_COLOR_GREEN,FONT_STYLE_BOLD End If End If If autoMode And Not WarnTypeS Then ExitSleep = 3 ReqExit = True End If End If FirstTime = False End If If Not suppressPopup Then Button = .ButtonClick With objHelper If .OnButtonClick(Button,POPUP_BUTTON2)Then ReqExit = True ElseIf CanExec Then If .OnButtonClick(Button,POPUP_BUTTON1)Then ReqExec = True End If End With End If If ReqExec Then CheckCount = - 1 CanExec = False ReqExec = False If Not suppressPopup Then .ButtonEnable(POPUP_BUTTON1) = False .ButtonEnable(POPUP_BUTTON2) = False .Message = GetMessage("UPDATEPREPARING") End If exeParam = "" JoinParam exeParam,UpdaterExe,False If isPegasus10P Then JoinParam exeParam,"-p",False If UpdateBIOS Then JoinParam exeParam,BiosFileName,False If UpdateEC Then JoinParam exeParam,EcFileName,False If Not isSchemeESP Then If SvPass <> "" Then JoinParam exeParam,"/p=" & SvPass,False End If If suppressPopup Then JoinParam exeParam,"/s",False ElseIf Not isSchemeESP Then ownerHWND = .Property("Handle") If Len(ownerHWND) = 8 Then JoinParam exeParam,"/w=" & ownerHWND,False End If DebugMessage"exeParam = [" & exeParam & "]" With objHelper.CreateProcess .CurrentDirectory = myFolder .Exec exeParam,debugMode,False Do While.Status = 0 DebugMessage".Status = " & .Status objMsgBox.Sleep 100 Loop errCode = .ExitCode End With DebugMessage"errCode = 0x" & FormatToHex(Hex(errCode),2) If errCode = 0 Then If objFS.FileExists(objFS.BuildPath(myFolder,strPostExeName))Then exeParam = "" JoinParam exeParam,strPostExeName,False DebugMessage"exeParam = [" & exeParam & "]" With objHelper.CreateProcess .CurrentDirectory = myFolder .Exec exeParam,True,False Do While.Status = 0 objMsgBox.Sleep 100 Loop result = .ExitCode End With DebugMessage"errCode = 0x" & FormatToHex(Hex(result),2) End If If autoSuspendBDE Then result = DisablingBDE(BDEdisableCount,lastErrorCode) DebugMessage"DisablingBDE => " & result If InStr(result,"Error") > 0 Then errCode = & H40 DebugMessage"-> errCode = 0x" & FormatToHex(Hex(errCode),2) If lastErrorCode <> 0 Then lastError = "0x" & FormatToHex(Hex(lastErrorCode),8) DebugMessage"-> lastError = " & lastError End If End If End If End If If errCode = 0 Then exitCode = ERROR_SUCCESS If Not noRebootMode Then rebootMode = True If Not suppressPopup Then .Message = "" If noRebootMode Then .MessageLineAdd GetMessage("NEEDREBOOT"),FONT_COLOR_BLUE,FONT_STYLE_BOLD If autoMode Then ExitSleep = 5 ReqExit = True Else .ButtonEnable(POPUP_BUTTON2) = True End If Else .MessageLineAdd GetMessage("REBOOTING") ExitSleep = 3 ReqExit = True End If End If Else If isSchemeESP Then If errCode > & HFFF Then exitCode = EBP_ESPERROR_BASE + & HFFF Else exitCode = EBP_ESPERROR_BASE + errCode End If str = "0x" & FormatToHex(Hex(errCode),3) If lastError <> "" Then str = str & " [" & lastError & "]" strErrMsg = ReplMessage("SOMEERROR","%d",str) Else Select Case errCode Case 1 exitCode = EBP_BADDEVDRIVER strErrMsg = GetMessage("BADDEVDRIVER") Case 2 exitCode = EBP_NOPERMISSION strErrMsg = GetMessage("NOPERMISSION") Case 3 exitCode = EBP_CANNOTREADIMAGE strErrMsg = ReplMessage("CANNOTREADIMAGE","%s","BIOS") Case 4 exitCode = EBP_CORRUPTEDIMAGE strErrMsg = ReplMessage("CORRUPTEDIMAGE","%s","BIOS") Case 5 exitCode = EBP_CANNOTREADIMAGE strErrMsg = ReplMessage("CANNOTREADIMAGE","%s",strEcFilePrefix) Case 6 exitCode = EBP_CORRUPTEDIMAGE strErrMsg = ReplMessage("CORRUPTEDIMAGE","%s",strEcFilePrefix) Case 7 exitCode = EBP_INCOMPATIIMAGE strErrMsg = GetMessage("INCOMPATIIMAGE") Case 8 exitCode = EBP_BADENCPASFORMAT strErrMsg = GetMessage("BADENCPASFORMAT") Case Else If errCode > & HFF Then exitCode = EBP_SOMEERROR_BASE + & HFF Else exitCode = EBP_SOMEERROR_BASE + errCode End If str = "0x" & FormatToHex(Hex(errCode),2) If lastError <> "" Then str = str & " [" & lastError & "]" strErrMsg = ReplMessage("SOMEERROR","%d",str) End Select End If If Not suppressPopup Then .Message = "" .MessageLineAdd GetMessage("UPDATEFAILED"),FONT_COLOR_RED,FONT_STYLE_BOLD .ButtonEnable(POPUP_BUTTON2) = True End If End If End If If Not suppressPopup Then If strErrMsg <> "" Then .MessageLineAdd strErrMsg,FONT_COLOR_RED,FONT_STYLE_BOLD If ReqExit Then .ButtonEnable(POPUP_BUTTON1) = False .ButtonEnable(POPUP_BUTTON2) = False If ExitSleep > 0 Then .Sleep 1000 * ExitSleep Else .Sleep 50 End If End If strErrMsg = "" Loop UntilReqExit If Not suppressPopup Then .Close End With Loop UntilTrue End If If fdMode Then Set objMsgBox = objHelper.CreatePopup Do If Not objHelper.IsPopup(objMsgBox)Then exitCode = EBP_CANNOTEXEC ErrorMsg = GetMessage("CANNOTEXEC") Exit Do End If With objMsgBox .Property("Width") = FdBoxWidth .Property("Height") = FdBoxHeight .Property("BaseColor") = FONT_COLOR_WHITE .Property("Title") = PopupTitle .ButtonAdd GetMessage("CLOSEBUTTON"),False .Open CloseExecutingBar .Message = ReplMessage("EXTRACTIMAGE","%s",strTarget) target = extractFolder ownerHWND = 0 Set objAppShell = WScript.CreateObject("Shell.Application") Set objFolder = Nothing Do WhileTrue If target = "" Then ownerHWND = CLng("&H" & .Property("Handle")) Set objFolder = objAppShell.BrowseForFolder(ownerHWND,ReplMessage("SELECTFOLDER","%s",strTarget), & H53) If objFolder Is Nothing Then target = "" ElseIf Not objFolder.Self.IsFileSystem Then target = strUndefinedFolder DebugMessage"Undefined Folder = """ & objFolder.Self.Path & """" Else target = objFolder.Self.Path End If Set objFolder = Nothing End If DebugMessage"target = """ & target & """" If target = strUndefinedFolder Then .MsgBox GetMessage("ILLEGALFOLDER"),vbOKOnly Or vbCritical,PopupTitle ElseIf target <> "" Then If Not objFS.FolderExists(target)Then .MsgBox ReplMessage("UNKNOWNFOLDER","%f",target),vbOKOnly Or vbCritical,PopupTitle Else If .MsgBox(ReplMessage(ReplMessage("DOEXTRACT","%s",strTarget),"%f",target),vbYesNo Or vbQuestion,PopupTitle) = vbYes Then Exit Do End If Else exitCode = EBP_EXTRACTCANCELED Exit Do End If target = "" Loop Set objAppShell = Nothing If exitCode = ERROR_SUCCESS Then ExitSleep = 0 strExtracted = "" With objFS ChgBiosFile = .BuildPath(myFolder,strChgBiosName) If .FileExists(ChgBiosFile)Then destFile = .BuildPath(target,strChgBiosName) .CopyFile ChgBiosFile,destFile,True If .FileExists(destFile)Then strExtracted = strExtracted & vbCrLf & " - " & strChgBiosName Else exitCode = EBP_CANNOTEXTRACT End If End If ChgBiosEFIFile = .BuildPath(myFolder,strChgBiosEFIName) If .FileExists(ChgBiosEFIFile)Then destEFIFile = .BuildPath(target,strChgBiosEFIName) .CopyFile ChgBiosEFIFile,destEFIFile,True If .FileExists(destEFIFile)Then strExtracted = strExtracted & vbCrLf & " - " & strChgBiosEFIName Else exitCode = EBP_CANNOTEXTRACT End If End If ChgBiosPegasus10PFile = .BuildPath(myFolder,strChgBiosPegasus10PName) If .FileExists(ChgBiosPegasus10PFile)Then destPegasus10PFile = .BuildPath(target,strChgBiosPegasus10PName) .CopyFile ChgBiosPegasus10PFile,destPegasus10PFile,True If .FileExists(destPegasus10PFile)Then strExtracted = strExtracted & vbCrLf & " - " & strChgBiosPegasus10PName Else exitCode = EBP_CANNOTEXTRACT End If End If ChgBiosPegasus10PTool = .BuildPath(myFolder,strChgBiosPegasus10PToolName) If .FileExists(ChgBiosPegasus10PTool)Then destPegasus10PTool = .BuildPath(target,strChgBiosPegasus10PToolName) .CopyFile ChgBiosPegasus10PTool,destPegasus10PTool,True If .FileExists(destPegasus10PTool)Then strExtracted = strExtracted & vbCrLf & " - " & strChgBiosPegasus10PToolName Else exitCode = EBP_CANNOTEXTRACT End If End If If(BiosFile <> "")And .FileExists(BiosFile)Then destFile = .BuildPath(target,BiosFileName) .CopyFile BiosFile,destFile,True If .FileExists(destFile)Then strExtracted = strExtracted & vbCrLf & " - " & BiosFileName Else exitCode = EBP_CANNOTEXTRACT End If End If If(BiosPegasus10PTool <> "")And .FileExists(BiosPegasus10PTool)Then destPegasus10PTool = .BuildPath(target,BiosPegasus10PToolName) .CopyFile BiosPegasus10PTool,destPegasus10PTool,True If .FileExists(destPegasus10PTool)Then strExtracted = strExtracted & vbCrLf & " - " & BiosPegasus10PToolName Else exitCode = EBP_CANNOTEXTRACT End If End If If(EcFile <> "")And .FileExists(EcFile)Then destFile = .BuildPath(target,EcFileName) .CopyFile EcFile,destFile,True If .FileExists(destFile)Then strExtracted = strExtracted & vbCrLf & " - " & EcFileName Else exitCode = EBP_CANNOTEXTRACT End If End If If(EcPegasus10PTool <> "")And .FileExists(EcPegasus10PTool)Then destPegasus10PTool = .BuildPath(target,EcPegasus10PToolName) .CopyFile EcPegasus10PTool,destPegasus10PTool,True If .FileExists(destPegasus10PTool)Then strExtracted = strExtracted & vbCrLf & " - " & EcPegasus10PToolName Else exitCode = EBP_CANNOTEXTRACT End If End If End With .Message = "" If exitCode = ERROR_SUCCESS Then .MessageLineAdd ReplMessage("EXTRACTED","%f",target) .MessageLineAdd strExtracted .Property("MessageScroll") = "Top" Else strErrMsg = ReplMessage(ReplMessage("CANNOTEXTRACT","%s",strTarget),"%f",target) .MessageLineAdd strErrMsg,FONT_COLOR_RED,FONT_STYLE_BOLD End If Else ExitSleep = 3000 .MessageLineAdd vbCrLf & GetMessage("EXTRACTCANCELED") End If .ButtonEnable(POPUP_BUTTON1) = True .ButtonSetFocus POPUP_BUTTON1 .Sleep ExitSleep,True .Close End With Loop UntilTrue End If Loop UntilTrue Set objMsgBox = Nothing Set objHelper = Nothing If ErrorMsg <> "" Then DebugMessage"ErrorMsg = """ & ErrorMsg & """" If Not suppressPopup Then PopupErrMsg ErrorMsg End If If debugMode And(debugLogFile = "")And cleanMode Then If MsgBox("Debug: Clean now ?",vbYesNo Or vbQuestion Or vbDefaultButton2 Or vbApplicationModal,PopupTitle) = vbNo Then cleanMode = False End If If cleanMode Then DebugMessage"Clean ..." If Not Cleaning(myFolder,True)Then exitCode = EBP_CANNOTDELFOLDER If Not suppressPopup Then PopupWarnMsg ReplMessage("CANNOTDELFOLDER","%f",myFolder) End If If objFS.FileExists(myPath)Then objFS.DeleteFile myPath,True End If If(exitCode <> ERROR_SUCCESS)And(exitCode <> EBP_CANNOTDELFOLDER)Then rebootMode = False If exitCode <> ERROR_SUCCESS Then exitCode = ERROR_EBP_BASE + exitCode If debugMode And(debugLogFile = "")And rebootMode Then If MsgBox("Debug: Reboot now ?",vbYesNo Or vbQuestion Or vbDefaultButton2 Or vbApplicationModal,PopupTitle) = vbNo Then rebootMode = False End If Set objMessage = Nothing Set objWshShell = Nothing Set objFS = Nothing If rebootMode Then Reboot WScript.Quit exitCode Function FormatToHex(ByVal str,ByVal n) If Len(str) >= n Then FormatToHex = str Else FormatToHex = String(n - Len(str),"0") & str End If End Function Function StringCheck(ByVal str,ByVal patrn,ByVal ignCase) Dim reg Set reg = New RegExp With reg .Pattern = patrn .Global = False .IgnoreCase = ignCase .MultiLine = True StringCheck = .Test(str) End With Set reg = Nothing End Function Function StringReplace(ByVal str,ByVal patrn,ByVal replStr) Dim reg Set reg = New RegExp With reg .Pattern = patrn .Global = True .IgnoreCase = False .MultiLine = True StringReplace = .Replace(str,replStr) End With Set reg = Nothing End Function Sub TranslateMessages(ByVal delLangFile) Dim file,str,key,msg,objFile,fileExt With objFS file = .BuildPath(myFolder,myBaseName & "." & LangID) If Not .FileExists(file)Then file = .BuildPath(myFolder,myBaseName & "." & strDefLangId) If .FileExists(file)Then With .OpenTextFile(file) Do Until.AtEndOfStream str = .ReadLine If Left(LTrim(StringReplace(str,"\t","")),1) = ";" Then str = "" If InStr(str,"=") > 1 Then key = Trim(StringReplace(Split(str,"=",2)(0),"\t","")) msg = Split(str,"=",2)(1) msg = StringReplace(msg,"\\n",vbCrLf) msg = StringReplace(msg,"\\t",vbTab) With objMessage If .Exists(key)Then .Key(key) = msg Else .Add key,msg End If End With End If Loop End With End If If delLangFile Then For Each objFile In .GetFolder(myFolder).Files fileExt = .GetExtensionName(objFile.Name) If(LCase(.GetBaseName(objFile.Name)) = LCase(myBaseName))And(Len(fileExt) = 4)Then If StringReplace(fileExt,"[0-9]+","") = "" Then .DeleteFile objFile.Path,True End If Next End If End With End Sub Function GetMessage(ByVal Key) GetMessage = Key With objMessage If .Exists(Key)Then GetMessage = .Item(Key) End With End Function Function ReplMessage(ByVal Key,ByVal patrn,ByVal replStr) ReplMessage = StringReplace(GetMessage(Key),patrn,replStr) End Function Function GetTargetMessage(ByVal BIOS,ByVal EC) If BIOS And EC Then GetTargetMessage = GetMessage("BIOSANDEC") ElseIf BIOS Then GetTargetMessage = "BIOS" Else GetTargetMessage = strEcFilePrefix End If End Function Sub CloseExecutingBar Dim CloseFlgFile If ExecutingBarClosed Then Exit Sub CloseFlgFile = objFS.BuildPath(myFolder,strCloseFlgName) If Not objFS.FileExists(CloseFlgFile)Then DebugMessage"CloseExecutingBar" objFS.CreateTextFile(CloseFlgFile,True).Close End If ExecutingBarClosed = True End Sub Function GetDateString(ByVal dateTime,ByVal selectFormat) Dim yy,mm,dd,hh,mn,ss yy = Right("000" & Year(dateTime),4) mm = Right("0" & Month(dateTime),2) dd = Right("0" & Day(dateTime),2) hh = Right("0" & Hour(dateTime),2) mn = Right("0" & Minute(dateTime),2) ss = Right("0" & Second(dateTime),2) Select Case selectFormat Case 1 GetDateString = yy & mm & dd & hh & mn & ss Case 2 GetDateString = yy & mm & dd & "_" & hh & mn & ss Case 3 GetDateString = yy & "-" & mm & "-" & dd & "_" & hh & "-" & mn & "-" & ss Case Else GetDateString = yy & "/" & mm & "/" & dd & " " & hh & ":" & mn & ":" & ss End Select End Function Sub GetNowTime(dateTime,milliSec) Dim tm,nw,ymd,tm0,nw0 tm = Timer nw = Now ymd = DateSerial(Year(nw),Month(nw),Day(nw)) tm0 = Fix(tm) nw0 = Hour(nw) * 3600 + Minute(nw) * 60 + Second(nw) If Abs(tm0 - nw0) > 1 Then ymd = DateAdd("d", - 1,ymd) dateTime = DateAdd("s",tm0,ymd) milliSec = Right("00" & Fix((tm - tm0) * 1000),3) End Sub Sub PopupMsg(ByVal msg) objWshShell.Popup msg,0,PopupTitle,vbOKOnly Or vbApplicationModal End Sub Sub PopupTimeMsg(ByVal msg,timeout) objWshShell.Popup msg,timeout,PopupTitle,vbOKOnly Or vbApplicationModal End Sub Sub PopupInfoMsg(ByVal msg) objWshShell.Popup msg,0,PopupTitle,vbOKOnly Or vbInformation Or vbApplicationModal End Sub Sub PopupWarnMsg(ByVal msg) objWshShell.Popup msg,0,PopupTitle,vbOKOnly Or vbExclamation Or vbApplicationModal End Sub Sub PopupErrMsg(ByVal msg) Dim reqClose reqClose = (ownerMode And(exitCode <> ERROR_SUCCESS)) If(exitCode <> EBP_CANNOTDELFOLDER)And cleanMode And Not debugMode Then Cleaning myFolder,Not reqClose If reqClose Then CloseExecutingBar objWshShell.Popup msg,0,PopupTitle,vbOKOnly Or vbCritical Or vbApplicationModal End Sub Sub DebugMessage(ByVal msg) Dim dateTime,milliSec,strPrefix,strSpacer,str,line If debugMode Then If debugLogFile <> "" Then If msg <> "" Then GetNowTime dateTime,milliSec strPrefix = "[" & GetDateString(dateTime,0) & "." & milliSec & "] " strSpacer = String(Len(strPrefix)," ") str = "" For Each line In Split(msg,vbCrLf) If line <> "" Then str = str & strPrefix & line str = str & vbCrLf strPrefix = strSpacer Next Else str = vbCrLf End If On Error Resume Next With objFS.OpenTextFile(debugLogFile,8,True) .Write str .Close End With On Error GoTo 0 Else objWshShell.Popup msg,0,PopupTitle,vbOKOnly Or vbApplicationModal End If End If End Sub Sub JoinParam(param,ByVal str,ByVal unshift) If str <> "" Then If InStr(str," ") >= 1 Then str = """" & str & """" If unshift Then If param <> "" Then param = " " & param param = str & param Else If param <> "" Then param = param & " " param = param & str End If End If End Sub Function GetIniKeyVal(ByVal iniFile,ByVal section,ByVal key) Dim flg,str,aStr GetIniKeyVal = "" If objFS.FileExists(iniFile)Then With objFS.OpenTextFile(iniFile) flg = (section = "") section = LCase("[" & section & "]") key = LCase(key) Do Until.AtEndOfStream str = LTrim(.ReadLine) If Not flg Then If LCase(Trim(str)) = section Then flg = True Else If Left(str,1) = "[" Then Exit Do aStr = Split(str,"=",2) If(UBound(aStr) = 1)And(LCase(Trim(aStr(0))) = key)Then GetIniKeyVal = Trim(aStr(1)) If(Len(GetIniKeyVal) > 1)And(Left(GetIniKeyVal,1) = """")And(Right(GetIniKeyVal,1) = """")Then GetIniKeyVal = Mid(GetIniKeyVal,2,Len(GetIniKeyVal) - 2) End If Exit Do End If End If Loop End With End If End Function Const OS_Unknown = 0 Const OS_Win95 = 16 Const OS_Win98 = 17 Const OS_WinNTbase = 18 Const OS_WinNT4 = 40 Const OS_Win2000 = 50 Const OS_WinXP = 51 Const OS_WinXP_64 = 52 Const OS_WinVista = 60 Const OS_Win7 = 61 Const OS_Win8 = 62 Const OS_Win8_1 = 63 Const OS_Win10 = 100 Dim OS_Type_Cache Dim OS_IsHomeEdition_Cache Function GetOSType Dim objSys If IsEmpty(OS_Type_Cache)Then OS_Type_Cache = OS_Unknown OS_IsHomeEdition_Cache = False On Error Resume Next With GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") For Each objSys In .ExecQuery("Select * from Win32_OperatingSystem") Select Case objSys.OStype Case 16 OS_Type_Cache = OS_Win95 Case 17 OS_Type_Cache = OS_Win98 Case 18 Select Case Left(objSys.Version,3) Case"4.0" OS_Type_Cache = OS_WinNT4 Case"5.0" OS_Type_Cache = OS_Win2000 Case"5.1" OS_Type_Cache = OS_WinXP Case"5.2" OS_Type_Cache = OS_WinXP_64 Case"6.0" OS_Type_Cache = OS_WinVista Case"6.1" OS_Type_Cache = OS_Win7 Case"6.2" OS_Type_Cache = OS_Win8 Case"6.3" OS_Type_Cache = OS_Win8_1 Case"10." OS_Type_Cache = OS_Win10 Case Else OS_Type_Cache = OS_WinNTbase End Select End Select If(objSys.SuiteMask And 512) <> 0 Then OS_IsHomeEdition_Cache = True End If Next End With On Error GoTo 0 End If GetOSType = OS_Type_Cache End Function Function IsWindowsHomeEdition If IsEmpty(OS_IsHomeEdition_Cache)Then GetOSType IsWindowsHomeEdition = OS_IsHomeEdition_Cache End Function Function GetByte(buf,pos) GetByte = AscB(MidB(buf,pos,1)) End Function Function BinToStr(ByVal buf,ByVal size) Dim i,str str = "" If size > 0 Then For i = 1 To size str = str & Chr(GetByte(buf,i)) Next End If BinToStr = str End Function Function GetBiosFileVer(ByVal target,ByVal signature) Const adTypeBinary = 1 Dim val,ver ver = "" If objFS.FileExists(target)Then On Error Resume Next With WScript.CreateObject("ADODB.Stream") .Open .Type = adTypeBinary .LoadFromFile target If isPegasus10P Then .Position = & H417200 val = .Read(6) If BinToStr(val,6) = "$BVDT$" Then .Position = & H41720D val = .Read(9) If BinToStr(val,9) = "$Version " Then .Position = & H417216 val = BinToStr(.Read(5),5) If Len(val) = 5 Then ver = "v" & val End If End If Else .Position = & H00 val = .Read(3) If(GetByte(val,1) = 0)And(GetByte(val,2) = 0)And(GetByte(val,3) <= 2)Then .Position = & H03 If BinToStr(.Read(4),4) = signature Then .Position = & H0B val = BinToStr(.Read(6),6) If(Len(val) = 6)And(Left(val,1) = "v")Then ver = val End If End If End If .Close End With If Err.Number <> 0 Then ver = "" On Error GoTo 0 End If GetBiosFileVer = ver End Function Function GetEcFileVer(ByVal target,ByVal signature) Const adTypeBinary = 1 Dim val,ver If isPegasus10P Then ver = "" Else ver = GetBiosFileVer(target,signature) End If If ver = "" Then If objFS.FileExists(target)Then On Error Resume Next With WScript.CreateObject("ADODB.Stream") .Open .Type = adTypeBinary .LoadFromFile target If isPegasus10P Then .Position = & H0 If BinToStr(.Read(5),5) = "@a000" Then .Position = & H7 ver = BinToStr(.Read(9),9) If(Mid(ver,1,3) = "00 ")And(Mid(ver,6,2) = " 0")And(Mid(ver,9,1) = " ")Then ver = "V" & Mid(ver,8,1) & "." & Mid(ver,4,2) End If Else .Position = & H80 If BinToStr(.Read(8),8) = "progdown" Then .Position = & H88 If GetByte(.Read(1),1) = & H02 Then .Position = & H8A val = BinToStr(.Read(6),6) If(Len(val) = 6)And(Left(val,1) = "V")Then ver = val End If End If End If .Close End With If Err.Number <> 0 Then ver = "" On Error GoTo 0 End If End If GetEcFileVer = ver End Function Const BDE_PROTECTION_NONE = - 1 Const BDE_PROTECTION_OFF = 0 Const BDE_PROTECTION_ON = 1 Const BDE_PROTECTION_UNKNOWN = 2 Const BDE_FULLY_ENCRYPTED = 1 Function GetBDEstate Dim res,objWMIService,objVolumes,objVolume,bootDrive,val,errCode res = BDE_PROTECTION_NONE On Error Resume Next If GetOSType >= OS_WinVista Then Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2\Security\MicrosoftVolumeEncryption") If Err.Number = 0 Then Set objVolumes = objWMIService.InstancesOf("Win32_EncryptableVolume") If Err.Number = 0 Then res = BDE_PROTECTION_UNKNOWN bootDrive = UCase(objShell.ExpandEnvironmentStrings("%SystemDrive%")) If(Len(bootDrive) <> 2)Or(Right(bootDrive,1) <> ":")Then bootDrive = "C:" For Each objVolume In objVolumes If UCase(objVolume.DriveLetter) = bootDrive Then errCode = objVolume.GetProtectionStatus(val) If errCode = 0 Then If val = BDE_PROTECTION_OFF Then errCode = objVolume.GetConversionStatus(val) If errCode = 0 Then If val = BDE_FULLY_ENCRYPTED Then res = BDE_PROTECTION_OFF Else res = BDE_PROTECTION_NONE End If Else res = BDE_PROTECTION_UNKNOWN End If Else res = val End If Else res = BDE_PROTECTION_UNKNOWN End If Exit For End If Next End If Set objVolumes = Nothing End If Set objWMIService = Nothing End If On Error GoTo 0 GetBDEstate = res End Function Function DisablingBDE(ByVal disableCount,returnCode) Dim res,objWMIService,objVolumes,objVolume,bootDrive,val,errCode res = "Undefined" returnCode = 0 If disableCount < 1 Then disableCount = 1 On Error Resume Next Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2\Security\MicrosoftVolumeEncryption") If Err.Number = 0 Then Set objVolumes = objWMIService.InstancesOf("Win32_EncryptableVolume") If Err.Number = 0 Then bootDrive = UCase(objShell.ExpandEnvironmentStrings("%SystemDrive%")) If(Len(bootDrive) <> 2)Or(Right(bootDrive,1) <> ":")Then bootDrive = "C:" For Each objVolume In objVolumes If UCase(objVolume.DriveLetter) = bootDrive Then res = bootDrive & " " errCode = objVolume.GetProtectionStatus(val) If errCode = 0 Then If val = BDE_PROTECTION_OFF Then res = res & "Unprotected" ElseIf val = BDE_PROTECTION_ON Then errCode = objVolume.GetConversionStatus(val) If errCode = 0 Then If val = BDE_FULLY_ENCRYPTED Then errCode = objVolume.DisableKeyProtectors(disableCount) If errCode = 0 Then res = res & "Disabled" Else returnCode = errCode res = res & "Disable Error" End If Else res = res & "Not Fully Encrypted" End If Else returnCode = errCode res = res & "Conversion Error" End If Else res = res & "Unknown" End If Else returnCode = errCode res = res & "Protection Error" End If Exit For End If Next End If Set objVolumes = Nothing End If Set objWMIService = Nothing On Error GoTo 0 DisablingBDE = res End Function Function Cleaning(ByVal cleanFolder,ByVal delMe) Dim errFlg,delMeFlg,UCcurFolder,UCcleanFolder,retryCount,loopCount Dim objFolder,objSubFolder,objFile,target errFlg = False delMeFlg = delMe On Error Resume Next With objFS If .FolderExists(cleanFolder)Then DebugMessage"Cleaning: cleanFolder = " & cleanFolder errFlg = .GetFolder(cleanFolder).IsRootFolder If Not errFlg Then errFlg = (Not StringCheck(cleanFolder,"\\_cab.+\.tmp$",True))And(Not StringCheck(cleanFolder,"\\" & BrandName & "\\" & strPackageFolder & "$",True)) End If If Not errFlg Then Set objMsgBox = Nothing Set objHelper = Nothing UCcurFolder = UCase(curFolder) UCcleanFolder = UCase(cleanFolder) While InStr(UCcurFolder,UCcleanFolder) = 1 curFolder = .GetParentFolderName(curFolder) UCcurFolder = UCase(curFolder) WEnd IfNot .FolderExists(curFolder)Then curFolder = .GetSpecialFolder(2).Path If .FolderExists(curFolder)Then objWshShell.CurrentDirectory = curFolder DebugMessage"Cleaning: Current folder = " & objWshShell.CurrentDirectory retryCount = 5 Do Set objFolder = .GetFolder(cleanFolder) For Each objSubFolder In objFolder.SubFolders target = objSubFolder.Path objSubFolder.Delete True If .FolderExists(target)Then errFlg = True Next For Each objFile In objFolder.Files target = objFile.Path If objFile.Name = strCloseFlgName Then loopCount = 5 Do WScript.Sleep(50) If Not .FileExists(target)Then Exit Do loopCount = loopCount - 1 Loop WhileloopCount > 0 End If If .FileExists(target)Then objFile.Delete True If .FileExists(target)Then errFlg = True End If Next If delMeFlg Then .DeleteFolder cleanFolder,True If .FolderExists(cleanFolder)Then errFlg = True End If If errFlg Then retryCount = retryCount - 1 DebugMessage"Cleaning: retryCount = " & retryCount If retryCount = 0 Then Exit Do errFlg = False WScript.Sleep(1000) Else DebugMessage"Cleaning: Succeeded." Exit Do End If Loop WhileTrue End If End If End With On Error GoTo 0 Cleaning = (Not errFlg) DebugMessage"Cleaning: res = " & Cleaning End Function Sub Reboot For Each objSys In GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}").InstancesOf("Win32_OperatingSystem") objSys.Win32Shutdown 2 Next End Sub Const CTWH_Server32Name = "TosWshHelper.exe" Const CTWH_Server64Name = "TosWshHelper64.exe" Const CTWH_ClassName = "TosWshHelper" Const CTWH_IMutex = "Mutex" Const CTWH_IPopup = "Popup" Const CTWH_IMachine = "Machine" Const CTWH_IProcess = "Process" Const POPUP_BUTTON1 = 1 Const POPUP_BUTTON2 = 2 Const POPUP_BUTTON3 = 3 Const FONT_STYLE_NONE = & H00 Const FONT_STYLE_BOLD = & H01 Const FONT_STYLE_ITALIC = & H02 Const FONT_STYLE_UNDERLINE = & H04 Const FONT_STYLE_STRIKEOUT = & H08 Const FONT_STYLE_BLINK = & H80 Class CTosWshHelper Private Server,bComFound,bComActivated Private objMutex,objMachine Private Sub Class_Initialize Server = "" bComFound = False bComActivated = False End Sub Public Default Function Init(ByVal x64,ByVal MutexName) Dim ClsidKey,Clsid,BaseKey,TypeLibKey,VersionKey,LibVer,LibPath,LibID,LibKey Dim ServerPath,ServerVer,exeParam,FolderBase,FolderName Set Init = Me If bComActivated Or bComFound Or(Server <> "")Then Exit Function With objFS If x64 Then ServerPath = CTWH_Server64Name Else ServerPath = CTWH_Server32Name ServerPath = .BuildPath(.GetParentFolderName(WScript.ScriptFullName),ServerPath) ClsidKey = "SOFTWARE\Classes\" & CTWH_ClassName & "." & CTWH_IMutex & "\Clsid" If .FileExists(ServerPath)And ExistsRegKey(RegHKLM,ClsidKey)Then ServerVer = .GetFileVersion(ServerPath) Clsid = GetRegStringValue(RegHKLM,ClsidKey,"") BaseKey = "SOFTWARE\Wow6432Node\Classes" If Not ExistsRegKey(RegHKLM,BaseKey)Then BaseKey = "SOFTWARE\Classes" TypeLibKey = BaseKey & "\CLSID\" & Clsid & "\TypeLib" VersionKey = BaseKey & "\CLSID\" & Clsid & "\Version" LibVer = "" LibPath = "" If ExistsRegKey(RegHKLM,TypeLibKey)And ExistsRegKey(RegHKLM,VersionKey)Then LibID = GetRegStringValue(RegHKLM,TypeLibKey,"") LibVer = GetRegStringValue(RegHKLM,VersionKey,"") LibKey = BaseKey & "\TypeLib\" & LibID & "\" & LibVer & "\0\win32" If ExistsRegKey(RegHKLM,LibKey)Then LibPath = GetRegStringValue(RegHKLM,LibKey,"") End If If(InStr(ServerVer,".") > 1)And(InStr(LibVer,".") > 1)And .FileExists(LibPath)Then If CompareVersion(ServerVer,LibVer) > 0 Then If RegServer(LibPath,False)Then FolderBase = .GetParentFolderName(LibPath) FolderName = LCase(.GetFileName(FolderBase)) If(Left(FolderName,4) = "_cab")And(Right(FolderName,4) = ".tmp")Then On Error Resume Next .DeleteFolder FolderBase,True On Error GoTo 0 End If End If End If End If End If End With With WScript Server = "" bComFound = False bComActivated = False On Error Resume Next Set objMutex = .CreateObject(CTWH_ClassName & "." & CTWH_IMutex) If Err.Number = 0 Then bComFound = True On Error GoTo 0 If Not bComFound Then If RegServer(ServerPath,True)Then Server = ServerPath If Server <> "" Then On Error Resume Next Set objMutex = .CreateObject(CTWH_ClassName & "." & CTWH_IMutex) If Err.Number = 0 Then bComFound = True On Error GoTo 0 End If End If If bComFound Then On Error Resume Next bComActivated = objMutex.Create(MutexName) On Error GoTo 0 If bComActivated Then On Error Resume Next Set objMachine = .CreateObject(CTWH_ClassName & "." & CTWH_IMachine) If Err Then Set objMachine = Nothing On Error GoTo 0 End If End If End With End Function Private Sub Class_Terminate Dim n On Error Resume Next If bComFound Then Set objMachine = Nothing objMutex.Close Set objMutex = Nothing End If RegServer Server,False On Error GoTo 0 End Sub Public Property Get Activated Activated = bComActivated End Property Public Function IsPopup(objPopup) IsPopup = (TypeName(objPopup) = CTWH_IPopup) End Function Public Function CreatePopup Set CreatePopup = Nothing On Error Resume Next Set CreatePopup = WScript.CreateObject(CTWH_ClassName & "." & CTWH_IPopup) On Error GoTo 0 If Not IsPopup(CreatePopup)Then Set CreatePopup = Nothing End Function Public Function OnButtonClick(ByVal Click,ByVal Num) If(Click <> 0)And(Num > 0)Then OnButtonClick = ((Click And(2 ^ (Num - 1))) <> 0) Else OnButtonClick = False End If End Function Public Function IsMachine(objMachine) IsMachine = (TypeName(objMachine) = CTWH_IMachine) End Function Public Function MachineInfo(ByVal Name) MachineInfo = "" If bComFound And IsMachine(objMachine)Then On Error Resume Next With objMachine MachineInfo = .Info(Name) End With On Error GoTo 0 End If End Function Public Function UpdatableFW(ByVal BIOSver,ByVal ECver) UpdatableFW = True If bComFound And IsMachine(objMachine)Then On Error Resume Next If objMachine.Func("CompFW",ECver,BIOSver) = "False" Then UpdatableFW = False On Error GoTo 0 End If End Function Public Function PowerCheck(ByVal withBattChk) Dim res,ACLineStatus,BatteryLifePercent ACLineStatus = MachineInfo("ACLineStatus") res = (ACLineStatus = "Online") If withBattChk Then BatteryLifePercent = MachineInfo("BatteryLifePercent") If BatteryLifePercent = "Unknown" Then BatteryLifePercent = 0 res = res And(StrToInt(BatteryLifePercent) >= MinimumBatteryLifePercent) End If PowerCheck = res End Function Public Function IsProcess(objProcess) IsProcess = (TypeName(objProcess) = CTWH_IProcess) End Function Public Function CreateProcess Set CreateProcess = Nothing On Error Resume Next Set CreateProcess = WScript.CreateObject(CTWH_ClassName & "." & CTWH_IProcess) On Error GoTo 0 If Not IsProcess(CreateProcess)Then Set CreateProcess = Nothing End Function End Class Function MutexExist(ByVal MutexName) Dim objMutex MutexExist = False On Error Resume Next Set objMutex = WScript.CreateObject(CTWH_ClassName & "." & CTWH_IMutex) If Err.Number = 0 Then If objMutex.Create(MutexName)Then objMutex.Close Else MutexExist = True End If Set objMutex = Nothing End If On Error GoTo 0 End Function Function RegServer(ByVal Server,ByVal fRegister) Dim Regsvr,exeParam RegServer = False If Server <> "" Then With objFS exeParam = "" If LCase(.GetExtensionName(Server)) = "exe" Then If .FileExists(Server)Then JoinParam exeParam,Server,False If fRegister Then JoinParam exeParam,"/regserver",False Else JoinParam exeParam,"/unregserver",False End If End If ElseIf LCase(.GetExtensionName(Server)) = "dll" Then Regsvr = .BuildPath(.GetSpecialFolder(1).Path,"regsvr32.exe") If .FileExists(Regsvr)And .FileExists(Server)Then exeParam = "" JoinParam exeParam,Regsvr,False JoinParam exeParam,"/s",False If Not fRegister Then JoinParam exeParam,"/u",False JoinParam exeParam,Server,False End If End If End With If exeParam <> "" Then On Error Resume Next With objWshShell.Exec(exeParam) Do While.Status = 0 WScript.Sleep 50 Loop RegServer = (.ExitCode = 0) End With On Error GoTo 0 End If End If End Function Dim objRegProvCache Function RegProv If Not IsObject(objRegProvCache)Then Set objRegProvCache = GetObject("winmgmts:\\.\root\default:StdRegProv") Set RegProv = objRegProvCache End Function Function RegHKLM RegHKLM = & H80000002 End Function Function ExistsRegKey(ByVal RegHKEY,ByVal strKeyPath) Dim arrSubKeys ExistsRegKey = (RegProv.EnumKey(RegHKEY,strKeyPath,arrSubKeys) = 0) End Function Function GetRegStringValue(ByVal RegHKEY,ByVal strKeyPath,ByVal strValueName) Dim strValue If RegProv.GetStringValue(RegHKEY,strKeyPath,strValueName,strValue) = 0 Then GetRegStringValue = strValue Else GetRegStringValue = Null End If End Function Function StrToInt(ByVal str) Dim val,tmp val = 0 On Error Resume Next If Len(str) > 2 Then If Left(str,2) = "0x" Then str = "&H" & Mid(str,3) tmp = CCur(str) If Err.Number = 0 Then If tmp > 2147483647 Then If tmp <= 4294967295 Then val = CLng(tmp - 4294967296) Else If tmp >= - 2147483648 Then val = CLng(tmp) End If If Err.Number <> 0 Then val = 0 End If On Error GoTo 0 StrToInt = val End Function Function IsValidVersionFormat(ByVal vers) Dim flg flg = ((Len(vers) >= 4)And(Len(vers) <= 6)) If flg Then flg = (LCase(Left(vers,1)) = "v") If flg Then flg = (InStr(vers,".") > 2) IsValidVersionFormat = flg End Function Function CompareVersion(ByVal verA,ByVal verB) Dim arrA,arrB,num,flg,a,b arrA = Split(verA,".") arrB = Split(verB,".") num = 0 flg = 0 Do a = StrToInt(Trim(arrA(num))) b = StrToInt(Trim(arrB(num))) If a > b Then flg = 1 ElseIf a < b Then flg = - 1 End If num = num + 1 Loop While(flg = 0)And(num <= UBound(arrA))And(num <= UBound(arrB)) CompareVersion = flg End Function Function CompareFirmwareVersion(ByVal verA,ByVal verB) Dim arrA,arrB,num,flg,a,b If LCase(Left(verA,1)) = "v" Then verA = Mid(verA,2) If LCase(Left(verB,1)) = "v" Then verB = Mid(verB,2) arrA = Split(verA,".") arrB = Split(verB,".") flg = 0 a = arrA(0) b = arrB(0) If a > b Then flg = 1 ElseIf a < b Then flg = - 1 ElseIf(UBound(arrA) > 0)And(UBound(arrB) > 0)Then verA = Left(arrA(1) & " ",3) verB = Left(arrB(1) & " ",3) a = Left(verA,1) b = Left(verB,1) If a > b Then flg = 1 ElseIf a < b Then flg = - 1 Else a = Mid(verA,2,1) b = Mid(verB,2,1) If a > b Then flg = 1 ElseIf a < b Then flg = - 1 Else a = Mid(verA,3,1) b = Mid(verB,3,1) If a > b Then flg = 1 ElseIf a < b Then flg = - 1 End If End If End If End If CompareFirmwareVersion = flg End Function
Attached Files
To refer to attachments on a page, use attachment:filename, as shown below in the list of files. Do NOT use the URL of the [get] link, since this is subject to change and can break easily.You are not allowed to attach a file to this page.