Cross-Examiner

NeverAmI

NeverAmI

Satisclassifaction
Retired Staff
MBTI
INFP
Enneagram
5w4
Wrote this as a vbscript first for a quick and dirty method to take two lists, a source list and a criteria list, and split the source list based on matches with the entries in the criteria list.

I primarily used this when doing an export of commands to disable all the users in LDAP (eDirectory) then have a list of exception users. So the list with the commands to disable all users would have the exception users removed, actually split into another file for accountability purposes.

It doesn't sound like a big deal, but when you have to check a list of 10,000 entries and exclude a list of 300 criteria items, you can kind of start to see where it comes in handy.

So the basic flow here is this: Check each line in Source list to see if it contains a match of any line in the criteria list, if it matches, put that line from the source list into the matches file, if it doesn't match, put that line into the no-matches file.

I decided to make it into an HTA (HTA = Hypertext Application, VBscript with HTML GUI basically) so others could use it. However, it was programmed for Windows XP and the dialogues probably won't work in Windows Vista/7 because they did away with those user interface common dialogues. Haven't tried it on WinXP x64 either. The HTA is slower than the vbscript counterpart so if you want the vbscript instead, let me know, it just looks for statically named files in the same directory.

I am actually using this script as my first foray into Python scripting, which I will convert it to eventually.

So anyway, here is the code if you want to try it out. Just paste it into a text file and rename to .hta

HTML: 
 <html>
<head>
<title>Cross-Examiner</title>
<HTA:APPLICATION
 APPLICATIONNAME = 'Cross-Examiner'
 ID      = 'oCross-Examiner'
 BORDER    = 'Thin'
 BORDERSTYLE   = 'Normal'
 CAPTION    = 'Yes'
 CONTEXTMENU   = 'Yes'
 INNERBORDER   = 'Yes'
 MAXIMIZEBUTTON           = 'No'
 MINIMIZEBUTTON          = 'Yes'
 NAVIGABLE   = 'No'
 SCROLL    = 'No'
 SCROLLFLAT   = 'No'
 SELECTION   = 'Yes'
 SHOWINTASKBAR   = 'Yes'
 SINGLEINSTANCE   = 'Yes'
 SYSMENU    = 'Yes'
 VERSION    = '1.0'
 WINDOWSTATE   = 'Normal'>
<STYLE type="text/css">
#divmain {font-family: tahoma; font-size: 10pt; text-align: center; width: 200px; height: 300px;}
#tblNav         {font-family: tahoma; font-size: 10pt; text-align: left;}
BODY  {background-color: buttonface; font-family: tahoma; font-size: 10pt; margin-top: 1px; margin-left: 1px; margin-right: 1px; margin-bottom: 1px;}
#button         {font-family: tahoma; font-size: 8pt;}
#textarea {font-family: tahoma; font-size: 10pt;}
#select         {font-family: tahoma; font-size: 10pt;}
#td  {font-family: tahoma; font-size: 12pt;}
#Criteria  {font-family: tahoma; font-size: 10pt;}
#tdIndent {position: relative; left:10%;}
#tdCenter {position: relative; left:35%;}
</STYLE>
</head>
<script language='vbscript'>
  Const ForReading = 1
  Const ForAppending = 8
  on error resume next
  Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  intDebug = 0
sub window_onload
  WindowSize 600, 700
  set objShell = createobject("wscript.shell")
  strDir = objShell.CurrentDirectory
  txtCriteriaFile.value = strDir&"\Criteria.txt"
  txtCompareFile.value = strDir&"\Compare.txt"
  txtMatchFile.value = strDir&"\Match.txt"
  txtNoMatchFile.value = strDir&"\NoMatch.txt"
End Sub
Sub WindowSize(iWidth, iHeight)
On Error Resume Next
Dim posWidth, posHeight
posWidth   = (window.screen.width - iWidth) / 2
posHeight  = (window.screen.height - iHeight) / 2
If posWidth  < 0 Then posWidth = 0
If posHeight < 0 Then posHeight = 0
window.resizeTo iWidth, iHeight
window.moveTo posWidth, posHeight
On Error GoTo 0
End Sub
Sub subBrowseMatch
    strStartDir = ""
    strMatchFolder = PickFolder(strStartDir)
    If right(strMatchFolder,1) = "\" then
       txtMatchFile.value = strMatchFolder&"Match.txt"
    Else
       txtMatchFile.value = strMatchFolder&"\Match.txt"
    End If
End Sub
Sub subBrowseNoMatch
    strStartDir = ""
    strNoMatchFolder = PickFolder(strStartDir)
    If right(strMatchFolder,1) = "\" then
       txtMatchFile.value = strNoMatchFolder&"NoMatch.txt"
    Else
       txtMatchFile.value = strNoMatchFolder&"\NoMatch.txt"
    End If
End Sub
Function PickFolder(strStartDir)
  Dim SA, F
  Set SA = CreateObject("Shell.Application")
  Set F = SA.BrowseForFolder(0, "Choose a folder", 0,strStartDir)
  If (Not F Is Nothing) Then
    PickFolder = F.Items.Item.path
  End If
  Set F = Nothing
  Set SA = Nothing
End Function
Sub subBrowseCompare
  set objShell = createobject("wscript.shell")
  strDir = objShell.CurrentDirectory
  Set ObjFSO = CreateObject("UserAccounts.CommonDialog")
  ObjFSO.Filter = "Txt Files|*.txt"
  ObjFSO.InitialDir = strDir
  InitFSO = ObjFSO.ShowOpen
  If InitFSO = False Then
      exit sub
  Else
      txtCompareFile.value = objFSO.FileName
  End If
End Sub
Sub subBrowseCriteria
  set objShell = createobject("wscript.shell")
  strDir = objShell.CurrentDirectory
  Set ObjFSO = CreateObject("UserAccounts.CommonDialog")
  ObjFSO.Filter = "Txt Files|*.txt"
  ObjFSO.InitialDir = strDir
  InitFSO = ObjFSO.ShowOpen
  If InitFSO = False Then
      exit sub
  Else
      txtCriteriaFile.value = objFSO.FileName
  End If
End Sub
Sub vbsSubmit
        if intDebug = 1 then
           Msgbox "starting vbsSubmit"
        End if
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  strSourceList = txtCriteriaFile.value
  strCompareList = txtCompareFile.value
  strNoMatch = txtNoMatchFile.value
  strMatch = txtMatchFile.value
  intMatch = 0
  intNoMatch = 0
  strOverwriteMsg = ""
  'MsgBox strSourceList&vbcrlf&strCompareList
  if objFSO.FileExists(strMatch) AND objFSO.FileExists(strNoMatch) then
     strOverwriteMsg = Msgbox("Match file and NoMatch file both exist."&vbcrlf&"Overwrite?",vbYesNo)
     if strOverWriteMsg = vbYes Then
        if intDebug = 1 then
           Msgbox "Deleting Files"
        End if
        objFSO.DeleteFile(strMatch)
        objFSO.DeleteFile(strNoMatch)
     Else
        if intDebug = 1 then
           Msgbox "Exiting"
        End if
        Exit Sub
     End If
  ElseIf objFSO.FileExists(strMatch) then
     strOverwriteMsg = MsgBox("Match file exists."&vbcrlf&"Overwrite?" ,vbYesNo)
     if strOverWriteMsg = vbYes Then
         objFSO.DeleteFile(strMatch)
     Else
        Exit Sub
     End If
  ElseIf objFSO.FileExists(strNoMatch) then
     strOverwriteMsg = Msgbox("NoMatch file exists."&vbcrlf&"Overwrite?",vbYesNo)
     if strOverWriteMsg = vbYes Then
         objFSO.DeleteFile(strNoMatch)
     Else
        Exit Sub
     End If
  End If
  if intDebug = 1 then
    Msgbox "Calling Subprep"
  End if
  call subPrep(strSourceList,strCompareList,strMatch,strNoMatch)
End Sub
    
Sub subPrep(strSourceList,strCompareList,strMatch,strNoMatch)
  if intDebug = 1 then
     Msgbox "Starting Subprep"
  End if
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objShell = CreateObject("WScript.Shell")
  if objFSO.FileExists(strSourceList) then
     if intDebug = 1 then
       Msgbox "Source List Found"
     End if
     if objFSO.FileExists(strCompareList) then
        if intDebug = 1 then
          Msgbox "Compare List found"&vbcrlf&"Calling SubCompare"
        End if
        call subCompare(strSourceList,strCompareList,strMatch,strNoMatch)
     Else
       MsgBox "Compare.txt not found, exiting."
       exit sub
     End If
  Else
     MsgBox "Input.txt not found, exiting."
     exit sub
  End If
End Sub
Sub subCompare(strSourceList,strCompareList,strMatch,strNoMatch)
  If intDebug = 1 then
     Msgbox "Starting subCompare"
  End If
  dim objNoMatch : Set objNoMatch = objFSO.OpenTextFile (strNoMatch, ForAppending, True)
  dim objMatch : Set objMatch = objFSO.OpenTextFile (strMatch, ForAppending, True)
  dim intMatchCount : intMatchCount = 0
  'msgBox "Starting subCompare"
  Set objReadFile = objFSO.OpenTextFile(strSourceList, ForReading)
  'MsgBox "opened file"
  Do Until objReadFile.AtEndOfStream
         arrUsers = Split(objReadFile.ReadAll,vbCrLf)
  Loop
  objReadFile.Close
  Set objCompareFile = objFSO.OpenTextFile(strCompareList, ForReading)
  Do Until objCompareFile.AtEndOfStream
     strLine = objCompareFile.ReadLine
     'msgbox strLine
     intTest = 0
     if strLine <> " " and strLine <> "" then
        for each strUser in arrUsers
          if strUser <> " " and strUser <> "" then
             if regexptest(strLine,strUser) then
               objMatch.WriteLine(strLine)
               intTest = 1
               intMatchCount = intMatchCount + 1
             End If
          End If
        next
        If intTest = 0  then
          objNoMatch.WriteLine(strLine)
        End If
     End If
  Loop
  objCompareFile.close
  objNoMatch.Close
  MsgBox "Done." & vbcrlf & "Matches found: " & intMatchCount
End Sub
Function RegExpTest(strInput, strPattern)
    Dim objRegExp : Set objRegExp = New RegExp  
    objRegExp.IgnoreCase = True
    objRegExp.Global = False
    objRegExp.Pattern = strPattern  
    RegExpTest = objRegExp.Test(strInput)  
    objRegExp.Pattern = ""
end function
</script>
<body>
<center>
  <div id="divmain">
     <table>
       <tr>
          <td colspan="2" align=left>
             <h3>Input</h3>
          </td>
       </tr>
       <tr>
       <td>
       <table style="border: 2px solid black;">
        <tr>
    <td colspan="2">
        Criteria File:
           </td>
        </tr>
        <tr>
            <td></td>
            <td>
                <Input type="text" name="txtCriteriaFile" value="" size="55"><Input id="runbutton" class="button" type="button" value="...  " name="butBrowseCriteria" onClick="vbscript: subBrowseCriteria">
     </td>
     <td></td>
 </tr>
 <tr>
    <td style="height: 15px;"></td>
        </tr>
        <tr>
    <td colspan="2">
 Source List:
           </td>
        </tr>
        <tr>
            <td></td>
     <td id="#td">
  <Input type="text" name="txtCompareFile" value="" size="55"><Input id="runbutton" class="button" type="button" value="...  " name="butBrowseCompare" onClick="vbscript: subBrowseCompare">
            </td>
            <td></td>
 </tr>
 <tr>
    <td style="height: 25px;"></td>
        </tr>
      </table>
      </td>
      </tr>
      <tr>
        <td height="25px">
        </td>
      </tr>
      <tr>
          <td colspan="2" align=left id="#td">
             <h3>Output</h3>
          </td>
       </tr>
       <tr>
       <td>
       <table style="border: 2px solid black;">
        <tr>
    <td colspan="2">
 Match File:
           </td>
        </tr>
        <tr>
            <td></td>
            <td id="#td">
                <Input type="text" name="txtMatchFile" value="" size="55"><Input id="runbutton" class="button" type="button" value="...  " name="butBrowseMatch" onClick="vbscript: subBrowseMatch">
     </td>
     <td></td>
 </tr>
 <tr>
    <td style="height: 15px;"></td>
        </tr>
        <tr>
    <td colspan="2">
 No Match File:
           </td>
        </tr>
        <tr>
            <td></td>
     <td>
  <Input type="text" name="txtNoMatchFile" value="" size="55"><Input id="runbutton" class="button" type="button" value="...  " name="butBrowseNoMatch" onClick="vbscript: subBrowseNoMatch">
            </td>
            <td></td>
 </tr>
 <tr>
    <td style="height: 25px;"></td>
        </tr>
      </table>
      </td>
      </tr>
        <tr>
           <td style="height: 25px;"></td>
        </tr>
        <tr>
    <td id="tdCenter">
 <Input id=runbutton  class="button" type="button" value="Submit" name="vbsSubmit"  onClick="vbsSubmit">
         </td>
 </tr>
    </table>
  </div>
</center>
</body>
</html>
 
You must log in or register to reply here.
Back
Top