' 1) Check for presence of required documents. ' 2) Check SFN files in MSI folder ' 3) Check shortcuts working DIR ' 4) Script with proper standards ' 5) Check for SL No (Script Library) ' 6) Check MSI file for refrence of uninstall word in filename ' 7) Check for Installdir permission through customAction and lockpermission table. ' 8) Check for startup shortcut and files going to startup folder. ' 9) Check for Run key through CustomAction and Registry. ' 10) Check for Files getting installed on C:\Drive ' 11) Check if services/hosts file is present ' 12) Check if certificates are installed ' 13) Check if there is any file which might cause issue on 64bit platform ' 14) Check for validation errors. '============================================================================================================================ On Error Resume Next forReading = 1 ForWriting = 2 Dim Error_log(10) Dim i Dim captured Dim Found(12) Dim Done Dim MAX Dim prod_error Dim cmdPath Dim prodname Dim ver Dim type1 Dim b12 Dim entity Dim lang Dim pckg Dim vendor_msi Dim Docs_result(12) Dim Objapp Dim upgrade_chk Dim final_result1 Dim mst_name_req Dim Currentfolder Dim french_peertest Dim msi_err Dim Sfn_err(100) Dim sfn_cnt Dim Displayed : Displayed = "False" Dim Directory_Count Dim Directory_Presence Dim Directory_Found : Directory_Found = "False" Dim Display_Correct : Display_Correct = 0 Dim inf : inf = 0 Dim interror : interror = 0 Dim aok_inf(3) Dim aok_error(3) Dim OSCLIENTPLATFORMS Dim OSDETAILS Dim OSSPLEVEL Dim strSubpack Dim strcurrentFileLocation : strcurrentFileLocation ="" Dim strCheckFor : strCheckFor = ".ini;.bat;.cmd;.txt;.xml;.reg;.vbs" Dim Check64biterr_cnt : Check64biterr_cnt = 0 Dim Check64biterr_found(90) Dim strTemp Dim Found_Validation : Found_Validation = "False" Dim Error_Count Dim Peer_test_Error_Count Dim Validation_Error(1090) Dim Peer_test_Error(50) Dim filename_ism(90) Dim VERSION(90) Dim dest(90) Dim registered(90) Dim company(90) Dim merge(90) Dim mmfile(90) Dim mmdest(90) Dim msmfilename(90) Dim sourceVersionup(90) Dim sourceInstalldirup(90) Dim filenameup(90) Dim VERSIONup(90) Dim A(50) Dim installdirup(90) Dim message(90) Dim total Dim total1 Dim total2 Dim Extra(90) Dim Count_scan Dim scan_one Dim scan_two Dim already_done : already_done = "False" Dim Found_ScanFolder : Found_ScanFolder = "False" Dim Found_ScanISM : Found_ScanISM = "False" Const OVERWRITE = TRUE french_peertest = 0 mst_name_req = "" strComputer = "." sfn_cnt = 0 Max = 12 Done = "None" i = 0 j = 0 captured = 0 prod_error = 0 vendor_msi = "True" objapp = 0 total = -1 total1 = -1 '*********************** set o_installer = CreateObject("WindowsInstaller.Installer") set o_database = o_Installer.OpenDatabase("C:\sample.msi", 1) s_SQL = "INSERT INTO Property (Property, Value) Values( 'mmm', 'amus')" s_SQL = "INSERT INTO Property (Property, Value) Values( 'ALLUSERS', '1')" s_SQL = "INSERT INTO Property (Property, Value) Values( 'REBOOT', 'ReallySuppress')" s_SQL = "INSERT INTO Property (Property, Value) Values( 'SOURCELIST', 'aaa')" s_SQL = "INSERT INTO Property (Property, Value) Values( 'madhukar', 'aaa')" Set o_MSIView = o_DataBase.OpenView( s_SQL) o_MSIView.Execute o_DataBase.Commit '********************************* '*************************************************************************************** Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor") For Each objItem in colItems intHorizontal = objItem.ScreenWidth intVertical = objItem.ScreenHeight Next '*************************************************************************************** Set Fso = CreateObject("Scripting.FileSystemObject") Set WShell = CreateObject("WScript.Shell") strTemp = WShell.ExpandEnvironmentStrings("%Temp%") Set objExplorer = CreateObject _ ("InternetExplorer.Application") 'intHorizontal = 1000 'intVertical = 800 objExplorer.Left = (intHorizontal - 800) / 2 'objExplorer.Left = 800 objExplorer.Top = (intVertical - 600) / 2 'objExplorer.Top = 800 fname=WScript.Arguments(0) If fname = "" Then 'fname = InputBox("Enter the name and location of Quality Monitoring Report","Quality Monitoring ERRORS") If fname = "" Then Wscript.Quit Else If Fso.FileExists(fname) Then Else Wscript.Quit End If End If End If If Fso.FileExists(fname) Then pos = InstrREv(fname,"\") currentfolder = Left(fname,pos) cmdPath = Currentfolder & "QualityMonitoringError.htm" End If set objfile1=fso.opentextfile(fname,forReading) ' Find if vendor msi or repackaged Do Until objFile1.AtEndOfStream strChr1 = objFile1.ReadLine If Instr(strChr1,"HSBC_Repackaging_Template") then vendor_msi = "False" End If Loop objfile1.Close set objfile=fso.opentextfile(fname,forReading) Do Until objFile.AtEndOfStream strChr = objFile.ReadLine 'MsgBox strChr If flag=1 then If Instr(strChr,"AgreeToLicense") then pos= Instr(strChr,"::") license_value = Mid(strchr,pos+2) license_value = Replace(license_value,"<br>","") license_value = Replace(license_value," ","") If license_value = "No" Then Error_log(i)= " AgreeToLicense :: No" i = i + 1 End If Found(0) = "True" End If If Instr(strChr,"ALLUSERS") and (vendor_msi = "False") then pos= Instr(strChr,"::") users_value = Mid(strchr,pos+2) users_value = Replace(users_value ,"<br>","") users_value = Replace(users_value ," ","") If users_value <> "1" Then Error_log(i)= " Property ALLUSERS has incorrect value " i = i + 1 End If Found(1) = "True" End If If Instr(strChr,"INSTALLLEVEL") and (vendor_msi = "False") then pos= Instr(strChr,"::") lvl_value = Mid(strchr,pos+2) lvl_value = Replace(lvl_value ,"<br>","") lvl_value = Replace(lvl_value ," ","") If lvl_value <> "100" Then Error_log(i)= " Property INSTALLLEVEL has incorrect value " i = i + 1 End If Found(2) = "True" End If If Instr(strChr,"REBOOT") then pos= Instr(strChr,"::") rboot_val = Mid(strchr,pos+2) rboot_val = Replace(rboot_val ,"<br>","") rboot_val = Replace(rboot_val ," ","") If rboot_val <> "ReallySuppress" Then Error_log(i)= " Property REBOOT has incorrect value" i = i + 1 End If Found(3) = "True" End If If Instr(strChr,"PackageVersion") then pos= Instr(strChr,"::") pkg_ver = Mid(strchr,pos+2) pkg_ver = Replace(pkg_ver ,"<br>","") pkg_ver = Replace(pkg_ver ," ","") 'MsgBox pkg_ver Found(4) = "True" pkg_ver1 = Instr(pkg_ver,".") pkg_ver1 = Mid(pkg_ver,1,pkg_ver1-1) pkg_ver1_int =cint(pkg_ver1) If pkg_ver1_int > 1 Then upgrade_chk = "TRUE" End If len1 = Len(pkg_ver1) If len1 = 1 Then pkg_ver1 = "0" & pkg_ver1 Else pkg_ver1 = pkg_ver1 End If End If If Instr(strChr,"ProductName") then pos= Instr(strChr,"::") prod_name = Mid(strchr,pos+2) prod_name = Replace(prod_name ,"<br>","",2) 'prod_name = Replace(prod_name ," ","",1) 'MsgBox "ProductName:" & prod_name prod_name1 = Replace(prod_name ," ","") Found(5) = "True" End If If Instr(strChr,"Manufacturer") then pos= Instr(strChr,"::") manu_val = Mid(strchr,pos+2) manu_val = Replace(manu_val ,"<br>","",2) 'manu_val = Replace(manu_val ," ","") 'MsgBox manu_val Found(6) = "True" End If If Instr(strChr,"ProductVersion") then pos= Instr(strChr,"::") prod_ver = Mid(strchr,pos+2) prod_ver = Replace(prod_ver ,"<br>","") prod_ver = Replace(prod_ver ," ","") 'MsgBox prod_ver cnt = Count(".",prod_ver) If cnt<> 3 and (vendor_msi = "False") Then Error_log(i)= " Property ProductVersion is not 4 Digit" i = i + 1 prod_error = 1 End If Found(7) = "True" End If If Instr(strChr,"Author") then pos= Instr(strChr,"::") name = Mid(strchr,pos+2) name = Replace(name ,"<br>","",2) 'name = Replace(name ," ","") 'MsgBox prod_ver Found(8) = "True" End If If Instr(strChr,"Country") then pos= Instr(strChr,"::") country = Mid(strchr,pos+2) country = Replace(country ,"<br>","",2) 'country = Replace(country ," ","") 'MsgBox prod_ver Found(9) = "True" End If Else If flag = 2 and Done = "None" then for k = 0 to MAX 'MsgBOx Found(9) 'MsgBox "Found ("& k &") = " & Found(k) If Found(k) = "" then Select Case k Case "0" If vendor_msi = "False" Then Error_log(i)= " Did not find AgreeToLicense Property" Else i = i -1 End If Case "1" If vendor_msi = "False" Then Error_log(i)= " Did not find ALLUSERS" Else i = i -1 End If Case "2" If vendor_msi = "False" Then Error_log(i)= " Did not find INSTALLLEVEL" Else i = i -1 End If Case "3" Error_log(i)= " Did not find REBOOT" Case "4" Error_log(i)= " Did not find PackageVersion" Case "5" Error_log(i)= " Did not find ProductName" Case "6" Error_log(i)= " Did not find Manufacturer" Case "7" Error_log(i)= " Did not find ProductVersion" Case "8" Error_log(i)= " Did not find Author" Case "9" Error_log(i)= " Did not find Country" End Select i = i + 1 End If Done ="Once" Next Else If flag = 2 Then If Instr(strChr,"Title")and (vendor_msi = "False") then dot_pos = InstrREv(prod_ver,".") prod_last = Mid(prod_ver,dot_pos+1) If prod_last = "0" Then prod_ver = Mid(prod_ver,1,dot_pos-1) dot_pos = InstrREv(prod_ver,".") prod_last = Mid(prod_ver,dot_pos+1) If prod_last = "0" Then prod_ver = Mid(prod_ver,1,dot_pos-1) End If End If If Instr(1,prod_name,manu_val,vbTextCompare) = 1 Then TITLE_req = prod_name & chr(32) & prod_ver & chr(32) & "Package Version" & chr(32) & pkg_ver Else TITLE_req = manu_val & chr(32) & prod_name & chr(32) & prod_ver & chr(32) & "Package Version" & chr(32) & pkg_ver End If pos= Instr(strChr,"::") title = Mid(strchr,pos+2) title = Replace(title ,"<br>","",2) 'title = Replace(title ," ","") If title <> TITLE_req and prod_error = 0 Then Error_log(i)= " Title :: " & "Required title is :: " & TITLE_req i = i + 1 End If End If End If If flag = 3 Then If upgrade_chk = "TRUE" AND Instr(strChr,"No Upgrades in the Application") Then Error_log(i)= " No Upgrade details found in Quality Monitoring " i = i + 1 End If End If End If End If If Instr(strChr,"MSI Properties") then flag = 1 Else If Instr(strChr,"MSI summary information") then flag = 2 End If If Instr(strChr,"Upgrade Details") then flag = 3 End If End If Loop objFile.close prod_name1 = Replace(prod_name1,"_","") prod_name1 = Replace(prod_name1,".","") prod_name1 = Replace(prod_name1,"(","") prod_name1 = Replace(prod_name1,")","") prod_name1 = Replace(prod_name1,"-","") If objapp = 1 Then result = OBjRegExpTest(prod_name1) If result = 1 Then 'Means its an OBJ application pos_no = Instr(fname,"-") obj_msi_name = Mid(fname,pos_no+1) obj_msi_name = Replace(obj_msi_name,".htm",".msi") obj_len = Len(obj_msi_name) If obj_len > 41 Then Error_log(i)= "Msi Naming incorrect. Should be less than 40 characters for OBJ applications " i = i + 1 End If End If End If '********** 'MsgBOx prod_name1 & " : " & prodname 'MsgBox prod_ver & " : " & ver 'MsgBOx DescAbv & " : " & type1 'MSgBOx country & " : " & entity 'MsgBOx pkg_ver1 & " : " & pckg 'MsgBox lang1 & " : " & lang 'MSgBox "Objapp:" & objapp If StrComp(prod_name1,prodname,1) = 0 and (prod_ver = ver) and (DescAbv = type1) and (country = entity) and (pkg_ver1 = pckg) and (lang1 = lang) then 'MsgBox "first" msi_name_req = prod_name1 & "_" & prod_ver & "_" & DescAbv & middle & country & "_" & lang1 & "_" & pkg_ver1 & "-0.msi" mst_name_req = prod_name1 & "_" & prod_ver & "_" & DescAbv & middle & country & "_" & lang1 & "_" & pkg_ver1 & "-0.mst" Else If strComp(prod_name1,prodname,1) = 0 And (prod_ver = ver) and (DescAbv = type1) and (country = entity) and (pkg_ver1 = pckg) and (lang1 = lang) and objapp = 1 then 'MsgBox "second" mst_name_req = prod_name1 & "_" & prod_ver & "_" & DescAbv & middle & country & "_" & lang1 & "_" & pkg_ver1 & "-0.mst" mst_name_req = prod_name1 & "_" & prod_ver & "_" & DescAbv & middle & country & "_" & lang1 & "_" & pkg_ver1 & "-0.mst" Else 'MsgBox "third" msi_name_req = prod_name1 & "_" & prod_ver & "_" & DescAbv & middle & country & "_" & lang1 & "_" & pkg_ver1 & "-0.msi" mst_name_req = prod_name1 & "_" & prod_ver & "_" & DescAbv & middle & country & "_" & lang1 & "_" & pkg_ver1 & "-0.mst" 'MsgBOx vendor_msi If vendor_msi = "False" Then Error_log(i)= "Msi Naming incorrect. Should be : " & msi_name_req i = i + 1 Else '********** Yet to be implemented part since no benchmark for vendor msi to find mst name 'Error_log(i)= "Mst Naming incorrect. Should be : " & mst_name_req 'i = i + 1 End If End If End If 'MSgBOx msi_name_req 'MSgBOx mst_name_req release_doc_name = prod_name & " v" & prod_ver & " R" & pkg_ver1 'Name to check later for naming of release document release_doc_name = Replace(release_doc_name ,"(","") release_doc_name = Replace(release_doc_name ,")","") peer_doc_name = prod_name & " v" & Replace(prod_ver,".","_") 'Name to check later for naming of peer test document peer_doc_name = Ucase(Replace(peer_doc_name," ","_")) peer_doc_name = Replace(peer_doc_name,"(","") peer_doc_name = Replace(peer_doc_name,")","") final_result = Find_Files(fname,vendor_msi,msi_name_req,mst_name_req,release_doc_name,peer_doc_name) 'Call to Function to check if the required documents are present in the Documents Folder If vendor_msi = "False" Then docs_count = 12 Else docs_count = 6 End If '------------------------------------------------------------------------------ 'This section of code will convert the first character of each node to uppercase '------------------------------------------------------------------------------ name_req1 = Lcase(prod_name) splitArray=Split(name_req1," ",-1,1) For limit = 0 to Ubound(splitArray) splitArray(limit) = Ucase(Mid(splitArray(limit), 1, 1)) & Mid(splitArray(limit), 2, Len(splitArray(limit))) Next For limit = 0 to Ubound(splitArray) - 1 name_req_final = name_req_final & splitArray(limit) Next name_req_final = name_req_final & splitArray(limit) name_req_final = Replace(name_req_final,"(","") name_req_final = Replace(name_req_final,")","") name_req_final = Replace(name_req_final,"-","") name_req_final = name_req_final & "_" & prod_ver & "_" & DescAbv & middle & country & "_" & lang1 & "_" & pkg_ver1 & "-0" '------------------------------------------------------------------------------ 'End '------------------------------------------------------------------------------ for k = 0 to docs_count - 1 If final_result(k) = "Found" Then 'MsgBOx "files no" & k+1 & "Found" Else Select Case k Case "0" Docs_result(j)= " Release Doc - " & release_doc_name &".doc" Case "1" If french_peertest = 1 then Docs_result(j)= " Peer_Test_" & peer_doc_name & "_FR.xls" Else Docs_result(j)= " Peer_Test_" & peer_doc_name & ".xls" End If Case "2" Docs_result(j)= " ITSR/GSR Doc" Case "3" Docs_result(j)= " QualityMonitoring - " & name_req_final & ".htm" Case "4" Docs_result(j)= " ACE Report - " & name_req_final & ".xls" Case "5" Docs_result(j)= " Validation Report - " & name_req_final & ".txt" Case "6" Docs_result(j)= " Build Report - " & name_req_final & ".htm" Case "7" Docs_result(j)= " Build Report - " & name_req_final & ".txt" Case "8" Docs_result(j)= " Upgrade Code Report - " & name_req_final & ".xls" Case "9" Docs_result(j)= " Build Log - " & name_req_final & ".txt" Case "10" Docs_result(j)= " ScanFolder - " & name_req_final & ".xls" Case "11" Docs_result(j)= " ScanISM - " & name_req_final & ".xls" End Select j = j + 1 End If Next final_result1 = Check_zip(fname,vendor_msi) 'Call to function to check if the intermediate is zipped array_size = Ubound(final_result1) '********************************************************************************** ' Code to check for the shorcut's Working DIR msi_err = Check_shortcut(fname,middle) msi_err_array = Ubound(msi_err) 'MsgBox "OUT chck_shrtcut" ' Code to check for the existence of SFN file_SFN = checkSFN(fname) SFN_size = sfn_cnt 'MsgBox "OUT check SFN" '********************************************************************************** strCAbList = Check64Bit(fname) '********************************************************************************** '*********************************** Added Validation Report and Peer test Form************ set objfolder = Fso.getfolder(currentfolder) Set objFiles = objFolder.Files Set objSubFolder = objFolder.SubFolders for each parentfold in objfiles path = parentfold.path strname = parentfold.name If Instr(1,strname, "Validation Report",vbTextCompare) then ValidationPath = path ValidationName = strname End If If Instr(1,strname, "Peer_Test_",vbTextCompare) then PeertestFormPath = path PeertestFormName = strname End If if Instr(1,strname, "QualityMonitoring -", vbTextCompare) then QualityMonitoringexcelpath = path set objfile1 = Fso.opentextfile(QualityMonitoringexcelpath,1) ' Find if vendor msi or repackaged Do Until objFile1.AtEndOfStream strChr1 = objFile1.ReadLine If Instr(strChr1,"HSBC_Repackaging_Template") then vendor_msi = "False" End If Loop objfile1.Close If NOT Fso.FolderExists("C:\temp\ValidationDatabase") Then Fso.CreateFolder("C:\temp\ValidationDatabase") End If If vendor_msi = "False" Then Database = "\\fl01.in.hsbc\Package_Tools\Others\ICE_TOLERATION_LIST_REPACKAGE.xls" Fso.CopyFile Database,"C:\temp\ValidationDatabase\",OVERWRITE Database = "c:\temp\ValidationDatabase\ICE_TOLERATION_LIST_REPACKAGE.xls" Else Database = "\\fl01.in.hsbc\Package_Tools\Others\ICE_TOLERATION_LIST_VENDOR.xls" Fso.CopyFile Database,"C:\temp\ValidationDatabase\",OVERWRITE Database = "c:\temp\ValidationDatabase\ICE_TOLERATION_LIST_VENDOR.xls" End If End If Next If NOT ValidationPath = "" Then Check_Validation_Error ValidationPath,Database End If If NOT PeertestFormPath = "" Then Check_PeerTestForm ValidationName,PeertestFormPath,PeertestFormName End If '******************************************************************************************* Set objTextFile = FSO.OpenTextFile(cmdPath,ForWriting,True) objTextFile.WriteLine("<html>") objTextFile.WriteLine("<body bgcolor=#254117>") If i=0 and j=0 and array_size=0 and total <= -1 and total1 <= -1 and msi_err_array =0 and SFN_size = 0 and Display_Correct = 0 and inf = 0 and interror = 0 and Check64biterr_cnt = 0 Then objTextFile.WriteLine("<font face=Times New Roman size=5 color=#FFFFFF>") objTextFile.WriteLine("!!! No Errors FOund in Quality Monitoring Report and all the required Documents were present in the Documents Folder !!!" & "<br>") objTextFile.WriteLine("!!! No Merge Modules needs to be created and upgraded !!!") objTextFile.WriteLine("!!! No issues found related to 64bit platform !!!") objTextFile.WriteLine("</font>") objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Width = intHorizontal - 400 objExplorer.Height = intVertical - 200 objExplorer.Visible = 1 Else If i > 0 Then objTextFile.WriteLine("<font face=Times New Roman size=5 color=#FFFFFF>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("Following are the errors found in the Quality Monitoring Report: " & "<br>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("</font>") For k = 0 to i-1 objTextFile.WriteLine("<font face=Times New Roman size=4 color=#EAC117>") objTextFile.WriteLine((k+1) & " : " & Error_log(k) & "<br>" & "<br>") objTextFile.WriteLine("</font>") Next objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Width = intHorizontal - 400 objExplorer.Height = intVertical - 200 objExplorer.Visible = 1 End If If j > 0 Then objTextFile.WriteLine("<font face=Times New Roman size=5 color=#FFFFFF>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("Following were not found in Documents Folder"& "<br>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("</font>") For k = 0 to j-1 objTextFile.WriteLine("<font face=Times New Roman size=4 color=#EAC117>") objTextFile.WriteLine((k+1) & " : " & Docs_result(k) & "<br>" & "<br>") objTextFile.WriteLine("</font>") Next objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Width = intHorizontal - 400 objExplorer.Height = intVertical - 200 objExplorer.Visible = 1 End If If array_size > 0 then objTextFile.WriteLine("<font face=Times New Roman size=5 color=#FFFFFF>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("Following regarding the INTERMEDIATE folder"& "<br>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("</font>") For k = 0 to array_size - 1 objTextFile.WriteLine("<font face=Times New Roman size=4 color=#EAC117>") objTextFile.WriteLine((k+1) & " : " & final_result1(k) & "<br>" & "<br>") objTextFile.WriteLine("</font>") Next objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Width = intHorizontal - 400 objExplorer.Height = intVertical - 200 objExplorer.Visible = 1 End If If msi_err_array > 0 Then objTextFile.WriteLine("<font face=Times New Roman size=5 color=#FFFFFF>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("Following errors were found in MSI"& "<br>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("</font>") For k = 0 to msi_err_array - 1 objTextFile.WriteLine("<font face=Times New Roman size=4 color=#E41B17>") objTextFile.WriteLine((k+1) & " : " & msi_err(k) & "<br>" & "<br>") objTextFile.WriteLine("</font>") Next objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Width = intHorizontal - 400 objExplorer.Height = intVertical - 200 objExplorer.Visible = 1 End If If SFN_size > 0 Then objTextFile.WriteLine("<font face=Times New Roman size=5 color=#FFFFFF>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("Following regarding SFN Files in MSI Folder"& "<br>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("</font>") For k = 0 to SFN_size - 1 objTextFile.WriteLine("<font face=Times New Roman size=4 color=#EAC117>") objTextFile.WriteLine((k+1) & " : " & Sfn_err(k) & "<br>" & "<br>") objTextFile.WriteLine("</font>") Next objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Width = intHorizontal - 400 objExplorer.Height = intVertical - 200 objExplorer.Visible = 1 End If If Found_scanISM = "True" Then if total <= -1 then objTextFile.WriteLine("<font face=Times New Roman size=5 color=#FFFFFF>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("No Merge Modules needs to be created " & "<br>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("</font>") objTextFile.WriteLine("<table border=0 CELLSPACING=5") objTextFile.WriteLine("</table>") objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Width = intHorizontal - 400 objExplorer.Height = intVertical - 200 objExplorer.Visible = 1 End If if total2 >= 0 then Count_scan = 0 objTextFile.WriteLine("<font face=Times New Roman size=5 color=#FFFFFF>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("Following are the Merge Modules that needs to be created " & "<br>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("</font>") objTextFile.WriteLine("<table border=0 CELLSPACING=5") For k = 0 to total if extra(k) = 0 then Count_scan = Count_scan + 1 objTextFile.WriteLine("<tr><td><FONT COLOR=#EAC117><b>" & (Count_scan) & " : " & filename_ism(k) & "<td><FONT COLOR=#EAC117><b>       " & VERSION(k) & "<td><FONT COLOR=#EAC117><b>        " & company(k) & "<td><FONT COLOR=#EAC117><b>        " & dest(k) & "<td><FONT COLOR=#EAC117><b> " &"<br>") End if Next objTextFile.WriteLine("</table>") objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Width = intHorizontal - 400 objExplorer.Height = intVertical - 200 objExplorer.Visible = 1 End if End If If Found_scanFolder = "True" Then if total1 <= -1 then objTextFile.WriteLine("<font face=Times New Roman size=5 color=#FFFFFF>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("No Merge Modules needs to be Upgraded " & "<br>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("</font>") objTextFile.WriteLine("<table border=0 CELLSPACING=5") objTextFile.WriteLine("</table>") objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Width = intHorizontal - 400 objExplorer.Height = intVertical - 200 objExplorer.Visible = 1 End If if total1 > -1 then objTextFile.WriteLine("<font face=Times New Roman size=5 color=#FFFFFF>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("Following are the Merge Modules that needs to be Upgraded " & "<br>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("</font>") objTextFile.WriteLine("<table border=0 CELLSPACING=5") For k = 0 to total1 objTextFile.WriteLine("<tr><td><FONT COLOR=#EAC117><b>" & (k+1) & " : " & filenameup(k) & "<td><FONT COLOR=#EAC117><b>       " & VERSIONup(k) & "<td><FONT COLOR=#EAC117><b>       " & msmfilename(k) & "<td><FONT COLOR=#EAC117><b>       " & sourceVersionup(k) & "<td><FONT COLOR=#EAC117><b>       " & sourceInstalldirup(k) & "<td><FONT COLOR=#EAC117><b>       " & message(k) & "<td><FONT COLOR=#EAC117><b> " &"<br>") Next objTextFile.WriteLine("</table>") objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Width = intHorizontal - 400 objExplorer.Height = intVertical - 200 objExplorer.Visible = 1 End If if total > -1 then Count_scan = 0 For k = 0 to total if extra(k) = 1 then if already_done = "False" Then objTextFile.WriteLine("<font face=Times New Roman size=5 color=#FFFFFF>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("Junk Entries and Can be removed " & "<br>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("</font>") objTextFile.WriteLine("<table border=0 CELLSPACING=5") Count_scan = Count_scan + 1 objTextFile.WriteLine("<tr><td><FONT COLOR=#EAC117><b>" & (Count_scan) & " : " & filename_ism(k) & "<td><FONT COLOR=#EAC117><b>       " & VERSION(k) & "<td><FONT COLOR=#EAC117><b>        " & company(k) & "<td><FONT COLOR=#EAC117><b>        " & dest(k) &"<td><FONT COLOR=#EAC117><b> " & "<br>") already_done = "True" Else Count_scan = Count_scan + 1 objTextFile.WriteLine("<tr><td><FONT COLOR=#EAC117><b>" & (Count_scan) & " : " & filename_ism(k) & "<td><FONT COLOR=#EAC117><b>       " & VERSION(k) & "<td><FONT COLOR=#EAC117><b>        " & company(k) & "<td><FONT COLOR=#EAC117><b>        " & dest(k) & "<td><FONT COLOR=#EAC117><b> " &"<br>") End If End if Next objTextFile.WriteLine("</table>") objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Width = intHorizontal - 400 objExplorer.Height = intVertical - 200 objExplorer.Visible = 1 End if End If If Error_Count = 0 Then objTextFile.WriteLine("<font face=Times New Roman size=5 color=#FFFFFF>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("No Validation Error's" & "<br>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("</font>") objTextFile.WriteLine("<table border=0 CELLSPACING=5") objTextFile.WriteLine("</table>") objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Width = intHorizontal - 400 objExplorer.Height = intVertical - 200 objExplorer.Visible = 1 End If If Error_Count > 0 Then objTextFile.WriteLine("<font face=Times New Roman size=5 color=#FFFFFF>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("Following are the Validation Error's that needs to be Solved" & "<br>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("</font>") objTextFile.WriteLine("<table border=0 CELLSPACING=5") For k = 0 to Error_Count If NOT Validation_Error(k) = "" Then objTextFile.WriteLine("<tr><td WIDTH=2000><font face=Times New Roman size=4 color=#EAC117>" & (k+1) & " : " & Validation_Error(k)) End If Next objTextFile.WriteLine("</table>") objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Width = intHorizontal - 400 objExplorer.Height = intVertical - 200 objExplorer.Visible = 1 End If If Peer_test_Error_Count > 0 Then objTextFile.WriteLine("<font face=Times New Roman size=5 color=#FFFFFF>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("Following are the Error's Found in Peer test Form" & "<br>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("</font>") objTextFile.WriteLine("<table border=0 CELLSPACING=5") For k = 0 to Peer_test_Error_Count If NOT Peer_test_Error(k) = "" Then objTextFile.WriteLine("<tr><td WIDTH=2000><font face=Times New Roman size=4 color=#EAC117>" & (k+1) & " : " & Peer_test_Error(k)) End If Next objTextFile.WriteLine("</table>") objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Width = intHorizontal - 400 objExplorer.Height = intVertical - 200 objExplorer.Visible = 1 End If If inf > 0 or interror > 0 Then objTextFile.WriteLine("<font face=Times New Roman size=5 color=#FFFFFF>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("AOK Information "& "<br>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("</font>") 'MsgBox inf & ":" & interror If inf > 0 Then For k = 0 to inf - 1 objTextFile.WriteLine("<font face=Times New Roman size=4 color=#EAC117>") objTextFile.WriteLine((k+1) & " : " & aok_inf(k) & "<br>" & "<br>") objTextFile.WriteLine("</font>") NExt End If If interror > 0 Then For l = 0 to interror - 1 objTextFile.WriteLine("<font face=Times New Roman size=4 color=#EAC117>") objTextFile.WriteLine((k+1) & " : " & aok_error(l) & " (NOT FOUND) <br>" & "<br>") objTextFile.WriteLine("</font>") NExt End If objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Width = intHorizontal - 400 objExplorer.Height = intVertical - 200 objExplorer.Visible = 1 End If If Check64biterr_cnt > 0 Then objTextFile.WriteLine("<font face=Times New Roman size=5 color=#FFFFFF>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("64 bit Platform check"& "<br>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("</font>") 'MsgBox inf & ":" & interror For k = 0 to Check64biterr_cnt - 1 objTextFile.WriteLine("<font face=Times New Roman size=4 color=#EAC117>") objTextFile.WriteLine((k+1) & " : " & Check64biterr_found(k) & "<br>" & "<br>") objTextFile.WriteLine("</font>") NExt objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Width = intHorizontal - 400 objExplorer.Height = intVertical - 200 objExplorer.Visible = 1 End If End If If strSubpack <> "" or strtaskseq <> "" Then objTextFile.WriteLine("<font face=Times New Roman size=5 color=#FFFFFF>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("Application Part of Sub-Pack/Task Sequencer : "& "<br>") objTextFile.WriteLine("==============================================================================" & "<br>") objTextFile.WriteLine("</font>") If strSubpack <> "" Then objTextFile.WriteLine("<font face=Times New Roman size=4 color=#EAC117>") objTextFile.WriteLine("Application seems to be part of Global Subpack : " & strSubpack & "<br>" & "<br>") objTextFile.WriteLine("</font>") End If If strtaskseq <> "" Then objTextFile.WriteLine("<font face=Times New Roman size=4 color=#EAC117>") objTextFile.WriteLine("Application seems to be part of Task Sequencer : " & strtaskseq & "<br>" & "<br>") objTextFile.WriteLine("</font>") End If End If objTextFile.WriteLine("</body>") objTextFile.WriteLine("</html>") objTextFile.Close objExplorer.Navigate cmdpath '------------------------------------------------------------------------------------- ' FUNCTIONS AND SUB-ROUTINES USED '------------------------------------------------------------------------------------- '************************************************************************************** 'Function to calculate the occurences of Pattern '************************************************************************************** Function Count(strMatchPattern1, strPhrase1) 'create variables Dim objRegEx, Match, Matches, StrReturnStr Count=0 'create instance of RegExp object Set objRegEx = New RegExp 'find all matches objRegEx.Global = True 'set case insensitive objRegEx.IgnoreCase = False 'set the pattern objRegEx.Pattern = strMatchPattern1 'create the collection of matches Set Matches = objRegEx.Execute(strPhrase1) 'print out all matches For Each Match in Matches If Match = strMatchPattern1 Then Count = Count + 1 End If Next End Function '************************************************************************************** 'End '************************************************************************************** '************************************************************************************** 'Function which used regular expressions '************************************************************************************** Function RegExpTest(strMatchPattern, strPhrase) 'create variables Dim objRegEx, Match, Matches, StrReturnStr RegExpTest=0 'create instance of RegExp object Set objRegEx = New RegExp 'find all matches objRegEx.Global = True 'set case insensitive objRegEx.IgnoreCase = False 'set the pattern objRegEx.Pattern = strMatchPattern 'create the collection of matches Set Matches = objRegEx.Execute(strPhrase) 'print out all matches For Each Match in Matches RegExpTest=1 Next End Function '************************************************************************************** 'End '************************************************************************************** '************************************************************************************** 'End '************************************************************************************** '************************************************************************************** 'Function for checking if the required documents are present '************************************************************************************** Function Find_Files(flname,vendormsi,msi_name_req,mst_name_req,release_doc_name,peer_doc_name) Dim Files_scanned(12) Dim found_txt found_txt = 0 Set objFSO = CreateObject("Scripting.FileSystemObject") parent_folder = objFso.GetParentFoldername(flname) If vendormsi = "False" Then Docs = "Release Doc,Peer_Test,ITSR,QualityMonitoring,ACE Report,Validation Report,Build Report.htm,Build Report.txt,Upgrade Code Report,Build Log,ScanFolder,ScanISM" name_req = Replace(msi_name_req,".msi","") Else Docs = "Release Doc,Peer_Test,ITSR,QualityMonitoring,ACE Report,Validation Report" name_req = Replace(mst_name_req,".mst","") End If count_no = CharCount(Docs,",") count_no = count_no + 1 for k = 0 to count_no pos = Instr(Docs,",") if pos = 0 Then 'Last entry in list report_name = Docs Else report_name = Left(Docs,pos-1) Docs = Mid(Docs,pos+1) End If Set objFolder = objFSO.GetFolder(parent_folder) Set objFiles = objFolder.Files For each fileIdx In objFiles If report_name = "Build Report.txt" Then If Instr(1,fileIdx.Name,"Build Report - " & name_req,vbTextCompare) Then If Instr(fileIdx.Name,".txt") Then Files_scanned(k) = "Found" End If End If Else If report_name ="Build Report.htm" Then If Instr(1,fileIdx.Name,"Build Report - " & name_req,vbTextCompare) Then If Instr(fileIdx.Name,".htm") Then Files_scanned(k) = "Found" End If End If Else If report_name="Release Doc" or report_name="Peer_Test" or report_name = "ITSR" Then Select Case report_name Case "Release Doc" If StrComp(fileIdx.Name,report_name & " - " & release_doc_name & ".doc",1) = 0 Then Files_scanned(k) = "Found" End If Case "Peer_Test" If app_lang = "1036" Then french_peertest = 1 If StrComp(fileIdx.Name,report_name & "_" & peer_doc_name & "_FR.xls",1) = 0 Then Files_scanned(k) = "Found" End If Else If StrComp(fileIdx.Name,report_name & "_" & peer_doc_name & ".xls",1) = 0 Then Files_scanned(k) = "Found" End If End If Case "ITSR" If Instr(1,fileIdx.Name,report_name,vbTextCompare) OR Instr(1,fileIdx.Name,"GSR",vbTextCompare)Then Files_scanned(k) = "Found" End If End Select End If If Instr(1,fileIdx.Name,report_name & " - " & name_req,vbTextCompare) Then Files_scanned(k) = "Found" End If End If End If Next Next Find_Files = Files_scanned End Function '************************************************************************************** 'End '************************************************************************************** '************************************************************************************** 'Function for no. of occurences '************************************************************************************** Function CharCount(OrigString ,Chars) sInput = OrigString If sInput = "" Then Exit Function Else lLen = Len(sInput) lCharLen = Len(Chars) lEndOfLoop = (lLen - lCharLen) + 1 For lCtr = 1 To lEndOfLoop sChar = Mid(sInput, lCtr, lCharLen) If StrComp(sChar, Chars, bytCompareType) = 0 Then lAns = lAns + 1 End If Next CharCount = lAns End If End Function '************************************************************************************** 'End '************************************************************************************** '******************************************************************************************* 'Function which uses concept of regular expressions for finding particular pattern existence '******************************************************************************************* Function OBjRegExpTest(strPhrase) 'create variables Dim objRegEx, Match, Matches, StrReturnStr OBjRegExpTest=0 'create instance of RegExp object 'Set objRegEx = New RegExp Set objRegEx = CreateObject("Vbscript.RegExp") 'find all matches objRegEx.Global = True 'set case insensitive objRegEx.IgnoreCase = False 'set the pattern objRegEx.Pattern = "OBJ[1-9][1-9][1-9]" 'create the collection of matches Set Matches = objRegEx.Execute(strPhrase) 'print out all matches For Each Match in Matches OBjRegExpTest=1 Next If OBjRegExpTest= 0 then objRegEx.Pattern = "OBJ.[1-9][1-9][1-9]" Set Matches = objRegEx.Execute(strPhrase) For Each Match in Matches OBjRegExpTest=1 Next End If End Function '************************************************************************************** 'End '************************************************************************************** '************************************************************************************** 'Function to find if the intermediate is zipped '************************************************************************************** Function Check_zip(flname,vendor_msi) Dim objFolder Dim interpath Dim objShell Dim objFiles Dim zipfile Dim zip_check() Dim objSource Dim zipcheck_error(5) Dim i : i=0 zipfile = "" Set objShell = CreateObject( "Shell.Application" ) Set objFSO = CreateObject("Scripting.FileSystemObject") parent_folder = objFso.GetParentFoldername(flname) parent_folder = objFso.GetParentFoldername(parent_folder) interpath = parent_folder & "\INTERMEDIATE" If Fso.FolderExists(interpath) Then Set objFolder = Fso.GetFolder(interpath) Set objFiles = objFolder.Files filecount = objFiles.count For each fileIdx In objFiles Set objFile = objFSO.GetFile(fileIdx) If Instr(objFile.name,".zip") Then zipfile = objfile.name zippath = objfile.Path End If Next If (filecount > 1 OR objFolder.SubFolders.Count > 0) AND zipfile = "" Then zipcheck_error(i) = " Zip the files inside INTERMEDIATE Folder and name it INTERMEDIATE.zip." i= i + 1 End If If Instr(zipfile,"INTERMEDIATE.zip") Then Set objSource = objShell.NameSpace(zippath).Items() For each fol in objSource If fol.IsFolder Then Set objFolder = objShell.NameSpace(zippath & "\" & fol).Items() For each fl in objFolder If Instr(1,fl.Name,"Context.ism",vbTextCompare) AND vendor_msi ="False" Then zipcheck_error(i) = " Context.ism found in INTERMEDIATE.zip. Please delete it. " i= i + 1 End If If fl.Size = 0 AND NOT fl.IsFolder Then zipcheck_error(i) =" (" & fl.Name & ") 0kb file found in " & fol.Name & " of INTERMEDIATE.zip. Please delete it. " i= i + 1 End If Next Else If Instr(1,fol.Name,"Context.ism",vbTextCompare) AND vendor_msi ="False" Then zipcheck_error(i) = " Context.ism found in INTERMEDIATE.zip. Please delete it. " i= i + 1 End If If fol.Size = 0 AND NOT fol.IsFolder Then zipcheck_error(i) = " 0 kb file found in INTERMEDIATE.zip. Please delete it. " i= i + 1 End If If InStr(1,fol.Name,".768",vbTextCompare) Then zipcheck_error(i) = " File with extension .768 created by InstallShield on upgrading previous version is present. Delete it " i= i + 1 End If End If Next If filecount > 1 Then zipcheck_error(i) = " Clean the INTERMEDIATE Folder and just keep INTERMEDIATE.zip." i = i + 1 End If End If ReDim zip_check(i) For l = 0 to i-1 zip_check(l) = zipcheck_error(l) Next Check_zip = zip_check End If End Function '************************************************************************************** 'End '************************************************************************************** '************************************************************************************** 'Function to check for shortcuts working DIR and also refrence of sql.ini '************************************************************************************** Function Check_shortcut(flname,middle) 'MSgBox middle Dim objFso Dim parent_folder Dim Msi_Path Dim objFolder Dim subFolder Dim folder_count Dim objFiles Dim FS, TS, WI, DB, View, Rec Dim msi_fullpath Dim msi_errors(100) Dim final_msierrors() Dim lockreport : lockreport = 0 Dim isscriptreport : isscriptreport = 0 Dim i : i = 0 Set objFSO = CreateObject("Scripting.FileSystemObject") parent_folder = objFso.GetParentFoldername(flname) parent_folder = objFso.GetParentFoldername(parent_folder) Msi_Path = parent_folder & "\MSI" Set objFolder = objFSO.GetFolder(msi_path) Set subFolder = objFolder.SubFolders folder_count = subFolder.Count If folder_count = 1 Then For each folIdx In subFolder '************* TRANSFORMS CHECK INCLUDED ***************** 'MsgBOx "1" Set objFiles = (objFSO.GetFolder(folIdx.Path)).Files Set inner_subFolder = (objFSO.GetFolder(folIdx.Path)).SubFolders For each fileIdx in objFiles If StrComp(Right(fileIdx.Path,4),".msi",1) = 0 Then 'MsgBox fileIdx.Path If InStr(1,fileIdx.Path,middle,vbTextCompare) = 0 Then TransFol = objFso.GetParentFoldername(fileIdx.Path) 'MsgBOx "TransFol : " & TransFol Set strTransFol = objFSO.GetFolder(TransFol) Set strTransFile = strTransFol.Files For Each strTra in strTransFile 'MsgBox strTra If StrComp(Right(strTra.Path,4),".mst",1) = 0 AND InStr(1,strTra.Path,middle,vbTextCompare) Then Set fileRefMSI = objFso.GetFile(fileIdx.Path) TempMSI = fileRefMSI.ParentFolder & "\" & objfso.GetTempName TempMSI = Replace(TempMSI,".tmp",".msi") 'MsgBOx TempMSI fileRefMSI.Copy (TempMSI) 'Make a backup of the MSI to work on On Error Resume Next Err.Clear Set oInstaller = CreateObject("WindowsInstaller.Installer") Set oDatabase = oInstaller.OpenDatabase(TempMSI, 1) oDatabase.ApplyTransform strTra.Path,32 oDatabase.Commit if Err.Number <> 0 then Set oInstaller = Nothing Set oDatabase = Nothing 'MsgBOx "CANNOT APPLY TRANSFORM : " & strTra.Path & " TO MSI : " & fileIdx.Path & "Exception :: Error number - " & Err.Number & " (" & Err.Description & ")" Set File = objfso.GetFile(TempMSI) File.Delete Else 'MsgBOx "APPLIED TRANSFORM : " & strTra.Path & " TO MSI : " & fileIdx.Path msi_fullpath = TempMSI Set oInstaller = Nothing Set oDatabase = Nothing Exit For End If End If Next Else msi_fullpath = fileIdx.Path 'Msi Name and Path Found End If If msi_fullpath <> "" Then 'MsgBox "WILL OPEN MSI : " & msi_fullpath On Error Resume Next Err.Clear Set WI = CreateObject("WindowsInstaller.Installer") Set DB = WI.OpenDatabase(msi_fullpath,0) Set View = DB.OpenView("Select Shortcut.Component_,Shortcut.WkDir,Shortcut.Name,Component.Component,Component.Directory_ From Shortcut,Component Where Shortcut.Component_ = Component.Component") if Err.Number <> 0 then Set View = Nothing Set DB = Nothing Set WI = Nothing 'MsgBOx "Exception :: Error number - " & Err.Number & " (" & Err.Description & ")" Else View.Execute set rec = view.Fetch Do While not Rec is Nothing If StrComp(Rec.stringdata(2),Rec.stringdata(5),1) = 0 Then else msi_errors(i) = "Mismatch in WorkingDir of shortcut and its component. Shortcut : '" & Rec.stringdata(3) & "' has WorkingDir '" & Rec.stringdata(2) & "' While Component (" & Rec.stringdata(1)& ") has its Directory : '" & Rec.stringdata(5) & "'." i = i + 1 End If set rec = view.Fetch Loop Set View = Nothing Set DB = Nothing Set WI = Nothing End If 'MsgBOx TempMSI If TempMSI <> "" Then Set File = objfso.GetFile(TempMSI) File.Delete End If msi_fullpath = "" End If End If Next Next For each folIdx In subFolder '************* TRANSFORMS CHECK INCLUDED ***************** 'MsgBOx "2" Set objFiles = (objFSO.GetFolder(folIdx.Path)).Files Set inner_subFolder = (objFSO.GetFolder(folIdx.Path)).SubFolders For each fileIdx in objFiles If StrComp(Right(fileIdx.Path,4),".msi",1) = 0 Then 'MsgBox fileIdx.Path If InStr(1,fileIdx.Path,middle,vbTextCompare) = 0 Then TransFol = objFso.GetParentFoldername(fileIdx.Path) 'MsgBOx "TransFol : " & TransFol Set strTransFol = objFSO.GetFolder(TransFol) Set strTransFile = strTransFol.Files For Each strTra in strTransFile 'MsgBox strTra If StrComp(Right(strTra.Path,4),".mst",1) = 0 AND InStr(1,strTra.Path,middle,vbTextCompare) Then Set fileRefMSI = objFso.GetFile(fileIdx.Path) TempMSI = fileRefMSI.ParentFolder & "\" & objfso.GetTempName TempMSI = Replace(TempMSI,".tmp",".msi") 'MsgBOx TempMSI fileRefMSI.Copy (TempMSI) 'Make a backup of the MSI to work on On Error Resume Next Err.Clear Set oInstaller = CreateObject("WindowsInstaller.Installer") Set oDatabase = oInstaller.OpenDatabase(TempMSI, 1) oDatabase.ApplyTransform strTra.Path,32 oDatabase.Commit if Err.Number <> 0 then Set oInstaller = Nothing Set oDatabase = Nothing 'MsgBOx "CANNOT APPLY TRANSFORM : " & strTra.Path & " TO MSI : " & fileIdx.Path & "Exception :: Error number - " & Err.Number & " (" & Err.Description & ")" Set File = objfso.GetFile(TempMSI) File.Delete Else 'MsgBOx "APPLIED TRANSFORM : " & strTra.Path & " TO MSI : " & fileIdx.Path msi_fullpath = TempMSI Set oInstaller = Nothing Set oDatabase = Nothing Exit For End If End If Next Else msi_fullpath = fileIdx.Path 'Msi Name and Path Found End If If msi_fullpath <> "" Then 'MsgBox "WILL OPEN MSI : " & msi_fullpath On Error Resume Next Err.Clear Set WI = CreateObject("WindowsInstaller.Installer") Set DB = WI.OpenDatabase(msi_fullpath,0) Set View = DB.OpenView("Select Action,Target,Source From CustomAction") if Err.Number <> 0 then Set View = Nothing Set DB = Nothing Set WI = Nothing 'MsgBOx "Exception :: Error number - " & Err.Number & " (" & Err.Description & ")" Else View.Execute set rec = view.Fetch 'msgbox "Inside" Do While not Rec is Nothing If InStr(1,Rec.stringdata(2),"ExpandEnvironmentStrings",vbTextCompare) Then msi_errors(i) = "Custom Action : '" & Rec.stringdata(1) & "' has usage of enviromental variables. Please remove it and Use Session Properties strictly !!" i = i + 1 End If If InStr(1,Rec.stringdata(2),"cacls",vbTextCompare) Then msi_errors(i) = "Custom Action : '" & Rec.stringdata(1) & "' has usage of cacls Command. Please make sure No Permissions are given to any Files or Folders !!" i = i + 1 Display_Correct = 1 End If If InStr(1,Rec.stringdata(2),"Microsoft\Windows\CurrentVersion\Run",vbTextCompare) Then msi_errors(i) = "Custom Action : '" & Rec.stringdata(1) & "' seems to creating entry under Run key. Please remove it from package if present !!" i = i + 1 Display_Correct = 1 End If If InStr(1,Rec.stringdata(1),"GLTi_CA_",vbTextCompare) Then If Instr(1,Rec.stringdata(1),"GLTi_CA_CHECK_LaptopOnlyInstall",vbTextCompare) Or Instr(1,Rec.stringdata(1),"GLTi_CA_MSG_ERROR_LaptopOnlyInstall",vbTextCompare) Then Else sl_Found = SLTest(Rec.stringdata(2)) If sl_Found = 0 Then msi_errors(i) = "Custom Action : '" & Rec.stringdata(1) & "' does not have Script Library Number(SL number) reference. Please make sure that standard scripts from script library are being used." i = i + 1 End If End If End If If InStr(1,Rec.stringdata(2),"drivers\etc\hosts",vbTextCompare) Or InStr(1,Rec.stringdata(2),"etc\hosts",vbTextCompare) OR InStr(1,Rec.stringdata(2),"hosts",vbTextCompare)Then msi_errors(i) = "Custom Action : '" & Rec.stringdata(1) & "' has reference of HOSTS file. Please ensure that '" & "C:\WINDOWS\system32\drivers\etc\hosts" & "' file is not changed by the msi." i = i + 1 End If If InStr(1,Rec.stringdata(2),"drivers\etc\services",vbTextCompare) Or InStr(1,Rec.stringdata(2),"etc\services",vbTextCompare) OR InStr(1,Rec.stringdata(2),"services",vbTextCompare)Then msi_errors(i) = "Custom Action : '" & Rec.stringdata(1) & "' has reference of services file. Please ensure that '" & "C:\WINDOWS\system32\drivers\etc\services" & "' file is not changed by the msi." i = i + 1 End If If InStr(1,Rec.stringdata(3),"ISScriptBridge.dll",vbTextCompare) AND isscriptreport = 0 Then msi_errors(i) = "There is reference of ISScript in the application. Please ensure that the custom action GLTi_CA_Delete_Registry_Runas.vbs is used for script library to delete the runas key created by IsScript.dll" i = i + 1 isscriptreport = 1 End If set rec = view.Fetch Loop Set View = Nothing Set DB = Nothing Set WI = Nothing End If 'MsgBOx TempMSI If TempMSI <> "" Then Set File = objfso.GetFile(TempMSI) File.Delete End If msi_fullpath = "" End If End If Next Next For each folIdx In subFolder '************* TRANSFORMS CHECK INCLUDED ***************** Set objFiles = (objFSO.GetFolder(folIdx.Path)).Files Set inner_subFolder = (objFSO.GetFolder(folIdx.Path)).SubFolders For each fileIdx in objFiles If StrComp(Right(fileIdx.Path,4),".msi",1) = 0 Then 'MsgBox fileIdx.Path If InStr(1,fileIdx.Path,middle,vbTextCompare) = 0 Then TransFol = objFso.GetParentFoldername(fileIdx.Path) 'MsgBOx "TransFol : " & TransFol Set strTransFol = objFSO.GetFolder(TransFol) Set strTransFile = strTransFol.Files For Each strTra in strTransFile 'MsgBox strTra If StrComp(Right(strTra.Path,4),".mst",1) = 0 AND InStr(1,strTra.Path,middle,vbTextCompare) Then Set fileRefMSI = objFso.GetFile(fileIdx.Path) TempMSI = fileRefMSI.ParentFolder & "\" & objfso.GetTempName TempMSI = Replace(TempMSI,".tmp",".msi") 'MsgBOx TempMSI fileRefMSI.Copy (TempMSI) 'Make a backup of the MSI to work on On Error Resume Next Err.Clear Set oInstaller = CreateObject("WindowsInstaller.Installer") Set oDatabase = oInstaller.OpenDatabase(TempMSI, 1) oDatabase.ApplyTransform strTra.Path,32 oDatabase.Commit if Err.Number <> 0 then Set oInstaller = Nothing Set oDatabase = Nothing 'MsgBOx "CANNOT APPLY TRANSFORM : " & strTra.Path & " TO MSI : " & fileIdx.Path & "Exception :: Error number - " & Err.Number & " (" & Err.Description & ")" Set File = objfso.GetFile(TempMSI) File.Delete Else 'MsgBOx "APPLIED TRANSFORM : " & strTra.Path & " TO MSI : " & fileIdx.Path msi_fullpath = TempMSI Set oInstaller = Nothing Set oDatabase = Nothing Exit For End If End If Next Else msi_fullpath = fileIdx.Path 'Msi Name and Path Found End If If msi_fullpath <> "" Then 'MsgBox "WILL OPEN MSI : " & msi_fullpath On Error Resume Next Err.Clear Set WI = CreateObject("WindowsInstaller.Installer") Set DB = WI.OpenDatabase(msi_fullpath,0) Set View = DB.OpenView("Select FileName From File") if Err.Number <> 0 then Set View = Nothing Set DB = Nothing Set WI = Nothing 'MsgBOx "Exception :: Error number - " & Err.Number & " (" & Err.Description & ")" Else View.Execute set rec = view.Fetch Do While not Rec is Nothing If InStr(1,Rec.stringdata(1),"sql.ini",vbTextCompare) Then msi_errors(i) = "File Table : Msi has refrence of sql.ini in File table. Please Use Custom Action for making changes in sql.ini" i = i + 1 End If If InStr(1,Rec.stringdata(1),"uninstall",vbTextCompare) Then msi_errors(i) = "File Table : Msi has refrence of uninstall in File Name (" & Rec.stringdata(1) & "). Please check if it can be removed." i = i + 1 End If If InStr(1,Rec.stringdata(1),"thumbs.db",vbTextCompare) Then msi_errors(i) = "File Table : MSI has refrence of thumbs.db in File Name (" & Rec.stringdata(1) & "). Please Remove the file from package." i = i + 1 Display_Correct = 1 End If If InStr(1,Rec.stringdata(1),".cer",vbTextCompare) Then msi_errors(i) = "File Table : Msi has reference of certificates (.cer) in File Name (" & Rec.stringdata(1) & "). Please check if dispensation is required." i = i + 1 End If If InStr(1,Rec.stringdata(1),"importpfx.exe",vbTextCompare) OR InStr(1,Rec.stringdata(1),"mscert.exe",vbTextCompare) Then msi_errors(i) = "File Table : Msi has reference of exe (importpfx.exe/mscert.exe) used for importing certificates. Please check if dispensation is required." i = i + 1 End If set rec = view.Fetch Loop Set View = Nothing Set DB = Nothing Set WI = Nothing End If 'MsgBOx TempMSI If TempMSI <> "" Then Set File = objfso.GetFile(TempMSI) File.Delete End If msi_fullpath = "" End If End If Next Next For each folIdx In subFolder '************* TRANSFORMS CHECK INCLUDED ***************** Set objFiles = (objFSO.GetFolder(folIdx.Path)).Files Set inner_subFolder = (objFSO.GetFolder(folIdx.Path)).SubFolders For each fileIdx in objFiles If StrComp(Right(fileIdx.Path,4),".msi",1) = 0 Then 'MsgBox fileIdx.Path If InStr(1,fileIdx.Path,middle,vbTextCompare) = 0 Then TransFol = objFso.GetParentFoldername(fileIdx.Path) 'MsgBOx "TransFol : " & TransFol Set strTransFol = objFSO.GetFolder(TransFol) Set strTransFile = strTransFol.Files For Each strTra in strTransFile 'MsgBox strTra If StrComp(Right(strTra.Path,4),".mst",1) = 0 AND InStr(1,strTra.Path,middle,vbTextCompare) Then Set fileRefMSI = objFso.GetFile(fileIdx.Path) TempMSI = fileRefMSI.ParentFolder & "\" & objfso.GetTempName TempMSI = Replace(TempMSI,".tmp",".msi") 'MsgBOx TempMSI fileRefMSI.Copy (TempMSI) 'Make a backup of the MSI to work on On Error Resume Next Err.Clear Set oInstaller = CreateObject("WindowsInstaller.Installer") Set oDatabase = oInstaller.OpenDatabase(TempMSI, 1) oDatabase.ApplyTransform strTra.Path,32 oDatabase.Commit if Err.Number <> 0 then Set oInstaller = Nothing Set oDatabase = Nothing 'MsgBOx "CANNOT APPLY TRANSFORM : " & strTra.Path & " TO MSI : " & fileIdx.Path & "Exception :: Error number - " & Err.Number & " (" & Err.Description & ")" Set File = objfso.GetFile(TempMSI) File.Delete Else 'MsgBOx "APPLIED TRANSFORM : " & strTra.Path & " TO MSI : " & fileIdx.Path msi_fullpath = TempMSI Set oInstaller = Nothing Set oDatabase = Nothing Exit For End If End If Next Else msi_fullpath = fileIdx.Path 'Msi Name and Path Found End If If msi_fullpath <> "" Then 'MsgBox "WILL OPEN MSI : " & msi_fullpath On Error Resume Next Err.Clear Set WI = CreateObject("WindowsInstaller.Installer") Set DB = WI.OpenDatabase(msi_fullpath,0) Set View = DB.OpenView("Select FileName From IniFile") if Err.Number <> 0 then Set View = Nothing Set DB = Nothing Set WI = Nothing 'MsgBOx "Exception :: Error number - " & Err.Number & " (" & Err.Description & ")" Else View.Execute set rec = view.Fetch Do While not Rec is Nothing If InStr(1,Rec.stringdata(1),"sql.ini",vbTextCompare) Then msi_errors(i) = "IniFile Table : Msi has refrence of sql.ini in IniFile table. Please Use Custom Action for making changes in sql.ini" i = i + 1 End If set rec = view.Fetch Loop Set View = Nothing Set DB = Nothing Set WI = Nothing End If 'MsgBOx TempMSI If TempMSI <> "" Then Set File = objfso.GetFile(TempMSI) File.Delete End If msi_fullpath = "" End If End If Next Next For each folIdx In subFolder '************* TRANSFORMS CHECK INCLUDED ***************** Set objFiles = (objFSO.GetFolder(folIdx.Path)).Files Set inner_subFolder = (objFSO.GetFolder(folIdx.Path)).SubFolders For each fileIdx in objFiles If StrComp(Right(fileIdx.Path,4),".msi",1) = 0 Then 'MsgBox fileIdx.Path If InStr(1,fileIdx.Path,middle,vbTextCompare) = 0 Then TransFol = objFso.GetParentFoldername(fileIdx.Path) 'MsgBOx "TransFol : " & TransFol Set strTransFol = objFSO.GetFolder(TransFol) Set strTransFile = strTransFol.Files For Each strTra in strTransFile 'MsgBox strTra If StrComp(Right(strTra.Path,4),".mst",1) = 0 AND InStr(1,strTra.Path,middle,vbTextCompare) Then Set fileRefMSI = objFso.GetFile(fileIdx.Path) TempMSI = fileRefMSI.ParentFolder & "\" & objfso.GetTempName TempMSI = Replace(TempMSI,".tmp",".msi") 'MsgBOx TempMSI fileRefMSI.Copy (TempMSI) 'Make a backup of the MSI to work on On Error Resume Next Err.Clear Set oInstaller = CreateObject("WindowsInstaller.Installer") Set oDatabase = oInstaller.OpenDatabase(TempMSI, 1) oDatabase.ApplyTransform strTra.Path,32 oDatabase.Commit if Err.Number <> 0 then Set oInstaller = Nothing Set oDatabase = Nothing 'MsgBOx "CANNOT APPLY TRANSFORM : " & strTra.Path & " TO MSI : " & fileIdx.Path & "Exception :: Error number - " & Err.Number & " (" & Err.Description & ")" Set File = objfso.GetFile(TempMSI) File.Delete Else 'MsgBOx "APPLIED TRANSFORM : " & strTra.Path & " TO MSI : " & fileIdx.Path msi_fullpath = TempMSI Set oInstaller = Nothing Set oDatabase = Nothing Exit For End If End If Next Else msi_fullpath = fileIdx.Path 'Msi Name and Path Found End If If msi_fullpath <> "" Then 'MsgBox "WILL OPEN MSI : " & msi_fullpath On Error Resume Next Err.Clear Set WI = CreateObject("WindowsInstaller.Installer") Set DB = WI.OpenDatabase(msi_fullpath,0) Set View = DB.OpenView("Select * From Registry") if Err.Number <> 0 then Set View = Nothing Set DB = Nothing Set WI = Nothing 'MsgBOx "Exception :: Error number - " & Err.Number & " (" & Err.Description & ")" Else View.Execute set rec = view.Fetch Do While not Rec is Nothing If InStr(1,Rec.stringdata(3),"CurrentVersion\Run",vbTextCompare) Then msi_errors(i) = "There seem to be presence of Run key in component '" & Rec.stringdata(6) & "' .Please remove it from the application !!" i = i + 1 Display_Correct = 1 End If set rec = view.Fetch Loop Set View = Nothing Set DB = Nothing Set WI = Nothing End If 'MsgBOx TempMSI If TempMSI <> "" Then Set File = objfso.GetFile(TempMSI) File.Delete End If msi_fullpath = "" End If End If Next Next For each folIdx In subFolder '************* TRANSFORMS CHECK INCLUDED ***************** Set objFiles = (objFSO.GetFolder(folIdx.Path)).Files Set inner_subFolder = (objFSO.GetFolder(folIdx.Path)).SubFolders For each fileIdx in objFiles If StrComp(Right(fileIdx.Path,4),".msi",1) = 0 Then 'MsgBox fileIdx.Path If InStr(1,fileIdx.Path,middle,vbTextCompare) = 0 Then TransFol = objFso.GetParentFoldername(fileIdx.Path) 'MsgBOx "TransFol : " & TransFol Set strTransFol = objFSO.GetFolder(TransFol) Set strTransFile = strTransFol.Files For Each strTra in strTransFile 'MsgBox strTra If StrComp(Right(strTra.Path,4),".mst",1) = 0 AND InStr(1,strTra.Path,middle,vbTextCompare) Then Set fileRefMSI = objFso.GetFile(fileIdx.Path) TempMSI = fileRefMSI.ParentFolder & "\" & objfso.GetTempName TempMSI = Replace(TempMSI,".tmp",".msi") 'MsgBOx TempMSI fileRefMSI.Copy (TempMSI) 'Make a backup of the MSI to work on On Error Resume Next Err.Clear Set oInstaller = CreateObject("WindowsInstaller.Installer") Set oDatabase = oInstaller.OpenDatabase(TempMSI, 1) oDatabase.ApplyTransform strTra.Path,32 oDatabase.Commit if Err.Number <> 0 then Set oInstaller = Nothing Set oDatabase = Nothing 'MsgBOx "CANNOT APPLY TRANSFORM : " & strTra.Path & " TO MSI : " & fileIdx.Path & "Exception :: Error number - " & Err.Number & " (" & Err.Description & ")" Set File = objfso.GetFile(TempMSI) File.Delete Else 'MsgBOx "APPLIED TRANSFORM : " & strTra.Path & " TO MSI : " & fileIdx.Path msi_fullpath = TempMSI Set oInstaller = Nothing Set oDatabase = Nothing Exit For End If End If Next Else msi_fullpath = fileIdx.Path 'Msi Name and Path Found End If If msi_fullpath <> "" Then 'MsgBox "WILL OPEN MSI : " & msi_fullpath On Error Resume Next Err.Clear Set WI = CreateObject("WindowsInstaller.Installer") Set DB = WI.OpenDatabase(msi_fullpath,0) Set View = DB.OpenView("Select * From Component") Set View1 = DB.OpenView("Select * From Directory") if Err.Number <> 0 then Set View = Nothing Set DB = Nothing Set WI = Nothing 'MsgBOx "Exception :: Error number - " & Err.Number & " (" & Err.Description & ")" Else Directory_Count = 0 Directory_Presence = 0 data = "WindowsVolume" View.Execute set rec = view.Fetch View1.Execute set rec1 = view1.Fetch Do While not Rec is Nothing If Rec.stringdata(3) = "WindowsVolume" Then Directory_Count = 5 Directory_Found = "True" End If set rec = view.Fetch Loop Do While not Rec1 is Nothing If Rec1.stringdata(2) = "WindowsVolume" Then Directory_Presence = 1 Directory_Count = 0 Else if Directory_Presence = 0 Then Directory_Count = 5 End If End If set rec1 = view1.Fetch Loop View.Execute set rec = view.Fetch View1.Execute set rec1 = view1.Fetch Do While Directory_Count < 5 If Rec1.stringdata(2) = Data Then Directory_Name = Rec1.stringdata(1) data = Directory_Name Directory_Count = Directory_Count + 1 View.Execute set rec = view.Fetch Do While NOT Rec is Nothing If Rec.stringdata(3) = data Then Directory_Found = "True" Directory_Count = 5 End If set rec = view.Fetch Loop End If set rec1 = view1.Fetch Loop If Directory_Found = "True" Then msi_errors(i) = "It seems Files and Folders are getting Installed on C:\ Drive. Check if can be Changed to C:\Program Files !!" i = i + 1 Display_Correct = 1 End If Set View = Nothing Set View1 = Nothing Set DB = Nothing Set WI = Nothing End If 'MsgBOx TempMSI If TempMSI <> "" Then Set File = objfso.GetFile(TempMSI) File.Delete End If msi_fullpath = "" End If End If Next Next For each folIdx In subFolder '************* TRANSFORMS CHECK INCLUDED ***************** Set objFiles = (objFSO.GetFolder(folIdx.Path)).Files Set inner_subFolder = (objFSO.GetFolder(folIdx.Path)).SubFolders For each fileIdx in objFiles If StrComp(Right(fileIdx.Path,4),".msi",1) = 0 Then 'MsgBox fileIdx.Path If InStr(1,fileIdx.Path,middle,vbTextCompare) = 0 Then TransFol = objFso.GetParentFoldername(fileIdx.Path) 'MsgBOx "TransFol : " & TransFol Set strTransFol = objFSO.GetFolder(TransFol) Set strTransFile = strTransFol.Files For Each strTra in strTransFile 'MsgBox strTra If StrComp(Right(strTra.Path,4),".mst",1) = 0 AND InStr(1,strTra.Path,middle,vbTextCompare) Then Set fileRefMSI = objFso.GetFile(fileIdx.Path) TempMSI = fileRefMSI.ParentFolder & "\" & objfso.GetTempName TempMSI = Replace(TempMSI,".tmp",".msi") 'MsgBOx TempMSI fileRefMSI.Copy (TempMSI) 'Make a backup of the MSI to work on On Error Resume Next Err.Clear Set oInstaller = CreateObject("WindowsInstaller.Installer") Set oDatabase = oInstaller.OpenDatabase(TempMSI, 1) oDatabase.ApplyTransform strTra.Path,32 oDatabase.Commit if Err.Number <> 0 then Set oInstaller = Nothing Set oDatabase = Nothing 'MsgBOx "CANNOT APPLY TRANSFORM : " & strTra.Path & " TO MSI : " & fileIdx.Path & "Exception :: Error number - " & Err.Number & " (" & Err.Description & ")" Set File = objfso.GetFile(TempMSI) File.Delete Else 'MsgBOx "APPLIED TRANSFORM : " & strTra.Path & " TO MSI : " & fileIdx.Path msi_fullpath = TempMSI Set oInstaller = Nothing Set oDatabase = Nothing Exit For End If End If Next Else msi_fullpath = fileIdx.Path 'Msi Name and Path Found End If If msi_fullpath <> "" Then 'MsgBox "WILL OPEN MSI : " & msi_fullpath On Error Resume Next Err.Clear Set WI = CreateObject("WindowsInstaller.Installer") Set DB = WI.OpenDatabase(msi_fullpath,0) Set View = DB.OpenView("Select * From Directory") Set View1 = DB.OpenView("Select * From Shortcut") Set View2 = DB.OpenView("Select * From Component") if Err.Number <> 0 then Set View = Nothing Set View1 = Nothing Set View2 = Nothing Set DB = Nothing Set WI = Nothing 'MsgBOx "Exception :: Error number - " & Err.Number & " (" & Err.Description & ")" Else View.Execute set rec = view.Fetch Do While not Rec is Nothing 'Added check for McAfee and WinsXs If InStr(1,Rec.stringdata(3),"McAfee",vbTextCompare) OR InStr(1,Rec.stringdata(3),"WinSxS",vbTextCompare) Then If InStr(1,Rec.stringdata(3),"McAfee",vbTextCompare) Then msi_errors(i) = "Directory table has reference of '" & "McAfee" & "' folder. Please ensure that no files should be installed to this folder and its subfolders." i = i + 1 Else msi_errors(i) = "Directory table has reference of '" & "WinSxS" & "' folder. Please ensure that no files should be installed to this folder and its subfolders." i = i + 1 End If End If If InStr(1,Rec.stringdata(3),".:StartUp",vbTextCompare) Then Directory_Name = Rec.stringdata(1) 'msgbox Directory_Name View1.Execute set rec1 = view1.Fetch Do While not Rec1 is Nothing 'Checking for shortcut table entry If InStr(1,Rec1.stringdata(2),Directory_Name,vbTextCompare) Then msi_errors(i) = "There seems to be presence of Startup Shortcut in Component : '" & Rec1.stringdata(4) & "' Please remove it from package if present !!" i = i + 1 Display_Correct = 1 End If set rec1 = view1.Fetch Loop View2.Execute set rec2 = view2.Fetch Do While not Rec2 is Nothing 'Checking for Cmponent table entry If InStr(1,Rec2.stringdata(3),Directory_Name,vbTextCompare) Then msi_errors(i) = "Component : '" & Rec2.stringdata(1) & "' has a destination to Startup folder. Please remove it from package if present !!" i = i + 1 Display_Correct = 1 End If set rec2 = view2.Fetch Loop End If set rec = view.Fetch Loop Set View = Nothing Set View1 = Nothing Set View2 = Nothing Set DB = Nothing Set WI = Nothing End If 'MsgBOx TempMSI If TempMSI <> "" Then Set File = objfso.GetFile(TempMSI) File.Delete End If msi_fullpath = "" End If End If Next Next For each folIdx In subFolder '************* TRANSFORMS CHECK INCLUDED ***************** Set objFiles = (objFSO.GetFolder(folIdx.Path)).Files Set inner_subFolder = (objFSO.GetFolder(folIdx.Path)).SubFolders For each fileIdx in objFiles If StrComp(Right(fileIdx.Path,4),".msi",1) = 0 Then 'MsgBox fileIdx.Path If InStr(1,fileIdx.Path,middle,vbTextCompare) = 0 Then TransFol = objFso.GetParentFoldername(fileIdx.Path) 'MsgBOx "TransFol : " & TransFol Set strTransFol = objFSO.GetFolder(TransFol) Set strTransFile = strTransFol.Files For Each strTra in strTransFile 'MsgBox strTra If StrComp(Right(strTra.Path,4),".mst",1) = 0 AND InStr(1,strTra.Path,middle,vbTextCompare) Then Set fileRefMSI = objFso.GetFile(fileIdx.Path) TempMSI = fileRefMSI.ParentFolder & "\" & objfso.GetTempName TempMSI = Replace(TempMSI,".tmp",".msi") 'MsgBOx TempMSI fileRefMSI.Copy (TempMSI) 'Make a backup of the MSI to work on On Error Resume Next Err.Clear Set oInstaller = CreateObject("WindowsInstaller.Installer") Set oDatabase = oInstaller.OpenDatabase(TempMSI, 1) oDatabase.ApplyTransform strTra.Path,32 oDatabase.Commit if Err.Number <> 0 then Set oInstaller = Nothing Set oDatabase = Nothing 'MsgBOx "CANNOT APPLY TRANSFORM : " & strTra.Path & " TO MSI : " & fileIdx.Path & "Exception :: Error number - " & Err.Number & " (" & Err.Description & ")" Set File = objfso.GetFile(TempMSI) File.Delete Else 'MsgBOx "APPLIED TRANSFORM : " & strTra.Path & " TO MSI : " & fileIdx.Path msi_fullpath = TempMSI Set oInstaller = Nothing Set oDatabase = Nothing Exit For End If End If Next Else msi_fullpath = fileIdx.Path 'Msi Name and Path Found End If If msi_fullpath <> "" Then 'MsgBox "WILL OPEN MSI : " & msi_fullpath On Error Resume Next Err.Clear Set WI = CreateObject("WindowsInstaller.Installer") Set DB = WI.OpenDatabase(msi_fullpath,0) Set View = DB.OpenView("Select * FRom LockPermissions") if Err.Number <> 0 then Set View = Nothing Set DB = Nothing Set WI = Nothing 'MsgBOx "Exception :: Error number - " & Err.Number & " (" & Err.Description & ")" Else View.Execute set rec = view.Fetch 'msgbox "Inside" Do While not Rec is Nothing if Displayed = "False" Then msi_errors(i) = "Lock Permission Table Present in MSI, Please make sure No Permissions are given to any Files, Folder or Registry !!" i = i + 1 Displayed = "True" Display_Correct = 1 End If set rec = view.Fetch Loop Do While not Rec is Nothing If Rec.stringdata(3) <> "" AND lockreport = 0 Then msi_errors(i) = "Domain column of LockPermissions table has '" & Rec.stringdata(3) & "'. Please delete it to avoid failure to set permissions on client's machine." i = i + 1 lockreport = 1 End If set rec = view.Fetch Loop Set View = Nothing Set DB = Nothing Set WI = Nothing End If 'MsgBOx TempMSI If TempMSI <> "" Then Set File = objfso.GetFile(TempMSI) File.Delete End If msi_fullpath = "" End If End If Next Next End If Redim final_msierrors(i) For l = 0 to i - 1 final_msierrors(l) = msi_errors(l) Next Check_shortcut = final_msierrors End Function '************************************************************************************** 'Function to check for SL No (Script Library) '************************************************************************************** Function SLTest(strPhrase) 'create variables Dim objRegEx, Match, Matches, StrReturnStr SLTest=0 'create instance of RegExp object 'Set objRegEx = New RegExp Set objRegEx = CreateObject("Vbscript.RegExp") 'find all matches objRegEx.Global = True 'set case insensitive objRegEx.IgnoreCase = False 'set the pattern objRegEx.Pattern = "SL[0-9][0-9][0-9][0-9][0-9][0-9]" 'create the collection of matches Set Matches = objRegEx.Execute(strPhrase) 'print out all matches For Each Match in Matches SLTest=1 Next If SLTest= 0 then objRegEx.Pattern = "SL[1-9][1-9][1-9]" Set Matches = objRegEx.Execute(strPhrase) For Each Match in Matches SLTest=1 Next End If End Function
Comments