'   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>&nbsp &nbsp &nbsp &nbsp" &  VERSION(k) & "<td><FONT COLOR=#EAC117><b>&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp" & company(k) & "<td><FONT COLOR=#EAC117><b>&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp" & dest(k) & "<td><FONT COLOR=#EAC117><b>&nbsp" &"<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>&nbsp &nbsp &nbsp &nbsp" & VERSIONup(k) & "<td><FONT COLOR=#EAC117><b>&nbsp &nbsp &nbsp &nbsp" & msmfilename(k) & "<td><FONT COLOR=#EAC117><b>&nbsp &nbsp &nbsp &nbsp" & sourceVersionup(k) & "<td><FONT COLOR=#EAC117><b>&nbsp &nbsp &nbsp &nbsp" & sourceInstalldirup(k) & "<td><FONT COLOR=#EAC117><b>&nbsp &nbsp &nbsp &nbsp" & message(k) & "<td><FONT COLOR=#EAC117><b>&nbsp" &"<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>&nbsp &nbsp &nbsp &nbsp" &  VERSION(k) & "<td><FONT COLOR=#EAC117><b>&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp" & company(k) & "<td><FONT COLOR=#EAC117><b>&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp" & dest(k) &"<td><FONT COLOR=#EAC117><b>&nbsp" & "<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>&nbsp &nbsp &nbsp &nbsp" &  VERSION(k) & "<td><FONT COLOR=#EAC117><b>&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp" & company(k) & "<td><FONT COLOR=#EAC117><b>&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp" & dest(k) & "<td><FONT COLOR=#EAC117><b>&nbsp" &"<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