Read Any File Line by Line

Option Explicit

Dim objFSO
Dim filePath,arrLines(),y,strComputer

Set objFSO = CreateObject("Scripting.FileSystemObject")

filePath = "ip_list.txt"

readEntireFile(filePath)

For y=0 To UBound(arrLines)
strComputer = arrLines(y)
MsgBox strComputer,0,"Array Element: " & y
Next


'*******************************************************
Function readEntireFile(path)

Const ForReading = 1
Dim myFile, x
Set myFile = objFSO.OpenTextFile(path, ForReading, False)
x=0

Do While myFile.AtEndOfStream <> True
ReDim Preserve arrLines(x)
arrLines(x) = myFile.ReadLine
x=x+1
Loop

myFile.Close

readEntireFile = arrLines

End Function
'*********************************************|

Increase Icon Cache / Remember Folder View / Registry Favorites

--------------------------------------------------------------
"HKLM\SOFTWARE\Microsoft\Windows\Current Version\Explorer"
Max Cached Icons
Reg_SZ or DWORD
value can be set from 100 to 4096
-------------------------------------------------|

*** FORCE REMEMBER ICON TYPE ***
--------------------------------------------------------------
Windows Registry Editor Version 5.00


[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer]
"Max Cached Icons"=dword:000007d0
; 000007d0 = 2000 decimal
-------------------------------------------------|

*** FORCE REMEMBER FOLDER VIEWS ***
--------------------------------------------------------------
Windows Registry Editor Version 5.00


[-HKEY_CURRENT_USER\Software\Microsoft\Windows\ShellNoRoam\BagMRU]
[-HKEY_CURRENT_USER\Software\Microsoft\Windows\ShellNoRoam\Bags]

[HKEY_CURRENT_USER\Software\Microsoft\Windows\Shell]
"BagMRU Size"=dword:00001f40
; 00001f40 = 8000 decimal

[HKEY_CURRENT_USER\Software\Microsoft\Windows\ShellNoRoam]
"BagMRU Size"=dword:00001f40

[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer]
"NoSaveSettings"=dword:00000000

;Look up Disabled Desktop icon on M.E. PC
;http://www.kellys-korner-xp.com/xp_tweaks.htm
-------------------------------------------------|

*** REGISTRY FAVORITES ***
--------------------------------------------------------------
Windows Registry Editor Version 5.00


[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Applets\Regedit\Favorites]
"RecycleBinIcon"="My Computer\\HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\CLSID\\{645FF040-5081-101B-9F08-00AA002F954E}\\DefaultIcon"

"HKLMRun"="My Computer\\HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Run"

"Time Servers"="My Computer\\HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\DateTime\\Servers"

"HKLM Home"="My Computer\\HKEY_LOCAL_MACHINE"

"IE Restrictions"="My Computer\\HKEY_CURRENT_USER\\Software\\Policies\\Microsoft\\Internet Explorer"

"HKUAdminRun"="My Computer\\HKEY_USERS\\*** GUID ***\\Software\\Microsoft\\Windows\\CurrentVersion\\Run"

"HKCU Run"="My Computer\\HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Run"

"HKLM WSH"="My Computer\\HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows Script Host\\Settings"

"HKLM RunOnce"="My Computer\\HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\RunOnce"

"IE Proxy Settings"="My Computer\\HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Internet Settings"

"Group Policy SIDS"="My Computer\\HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Group Policy\\*** GUID ***"

"View Source Editor"="My Computer\\HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Internet Explorer\\View Source Editor"

"Local NTP Server"="My Computer\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\W32Time\\Parameters"

"Change NIC MAC"="My Computer\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Control\\Class\\{4D36E972-E325-11CE-BFC1-08002bE10318}\\0001"

"EnableOpLocks1"="My Computer\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\lanmanserver\\parameters"

"OpLocksEnabled2"="My Computer\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\MRxSmb\\Parameters"

"Classic Shell/Disable Quicklaunch"="My Computer\\HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Policies\\Explorer"

"Enable DCOM"="My Computer\\HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Ole"

"ODBC.INI"="My Computer\\HKEY_LOCAL_MACHINE\\SOFTWARE\\ODBC\\ODBC.INI"

"Max Cached Icons"="My Computer\\HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Explorer"

"Min Outlook to SysTray"="My Computer\\HKEY_CURRENT_USER\\Software\\Microsoft\\Office\\10.0\\Outlook\\Preferences"
------------------------------------------------|

Timer HTA

<html>
<head>
<title>Elapsed Time Timer Countdown Countup Count</title>

<HTA:APPLICATION
ID="objTimer"
APPLICATIONNAME="Timer"
SCROLL="yes"
SINGLEINSTANCE="no"
WINDOWSTATE="normal">
</head>

<script language="vbs">
Dim x : x = 1
Dim iTimerId

Sub Window_Onload
Const iWIDTH = 525
Const iHEIGHT = 250
Window.ResizeTo iWIDTH, iHEIGHT
Window.MoveTo (Screen.availWidth-iWIDTH)/2,_
(Screen.availHeight-iHEIGHT)/2
last.InnerHTML = "Current Time: " & now() & " -- Last Modified: " & document.lastModified
End Sub

Function myTime
timerArea01.innerHTML = x
If x=60 Then
stopTimer
timerArea01.innerHTML = "<a style='color:red;'>DONE!</a>"
End If
x=x+1
End Function

Sub stopTimer
window.clearInterval(iTimerId)
End Sub

Sub RunScriptHTARefresh
StopTimer
Location.Reload(True)
End Sub

Function startTimer
iTimerId=window.setInterval("myTime", 1000)
End Function

' (window.innerWidth/2)px
</script>
<BODY>

<center>
<span id="timerArea01" style="font: bold 3 em/2 arial, helvetica, sans-serif;"
name="timerarea">
</span>
</center>

<input id=start01 class="button" type="button"
value="Start" name="start" style="position:absolute; left:10px; top:10px"
onClick="startTimer">

<input id=stop01 class="button" type="button"
value="Stop" name="stop" style="position:absolute; right:10px; top:10px"
onClick="stopTimer">

<input id=refresh01 class="button" type="button"
value="Refresh" name="refresh" style="position:absolute; left:10px; bottom:20px;"
onClick="RunScriptHTARefresh">

<a id="last" style="position:absolute; bottom:5px; font:bold 0.5em/1 'courier new', helvetic, serif;"></a>
</body>
</html>

Easy Copy

<a style="font: 0.75em/1 'courier new', serif; color: black">

Write NewLine Local File/Enum Folders

Option Explicit

Dim objShell,objFSO,objWMIService
Dim arrFolders(),rmtFile()
Dim strComputer,folder01,folder02,y,temp

'strComputer="tower" '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@remote WMI@@@@@@@
strComputer = "."

Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")

folder01 = "c:\bootdrv\alohaqs" 'change this for server
folder02 = "\\tower" 'remote WMI

ReadRmtFolder folder01,arrFolders

' ~~~~~~~~~~ this section for remote WMI @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'For y=0 To UBound(arrFolders)
' ReDim Preserve rmtFile(y)
' temp = objFSO.BuildPath(arrFolders(y),"\ftp.ucf")
' rmtFile(y) = folder02 & Replace(temp,"c:","")
'Next
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@@@@@@@@@@@@@@@@

' ~~~~~~~~~~ this section to run locally only
For y=0 To UBound(arrFolders)
ReDim Preserve rmtFile(y)
temp = objFSO.BuildPath(arrFolders(y),"\ftp.ucf")
rmtFile(y) = temp
Next
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

For y=0 To UBound(rmtFile)
MsgBox rmtFile(y)
If objFSO.FileExists(rmtFile(y)) Then
readEntireFile(rmtFile(y))
Else
MsgBox "no file there!",0,rmtFile(y)
End If
Next

quitscript



'******************************************************************************
Function readRmtFolder(path,arr)

Dim x,y,colSubfolders,objFolder
x=0

Set colSubfolders = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='" _
& path & "'} " _
& "WHERE AssocClass = Win32_Subdirectory " _
& "ResultRole = PartComponent")

For Each objFolder in colSubfolders
ReDim Preserve arr(x)
arr(x) = objFolder.Name
x=x+1
Next

End Function
'*******************************************************************|

'******************************************************************************
Function readEntireFile(path)

Const ForReading = 1
Dim myFile,x,arrLines(),t,z
Set myFile = objFSO.OpenTextFile(path,ForReading,False)
x=0

If myFile.AtEndOfStream = True Then
MsgBox "Nothing in this file!",0,path
Exit Function
End If

Do While myFile.AtEndOfStream <> True
t = myFile.ReadLine
ReDim Preserve arrLines(x)
arrLines(x) = t
x=x+1
Loop

myFile.Close

writeNewTextToFile path,arrLines

End Function
'*******************************************************************|

'******************************************************************************
Function writeNewTextToFile(path,arr)

Const ForWriting = 2
Dim myFile,x
Set myFile = objFSO.OpenTextFile(path,ForWriting,False)
x=0

Do
If (InStr(1,arr(x),"user blank1 blank2",1)) Then
MsgBox "I'm here!"
myFile.WriteLine "user BLANK1 BLANK2"
Else
myFile.WriteLine arr(x)
End If
x=x+1
Loop Until x=(UBound(arr)+1)

myFile.Close

End Function
'*******************************************************************|
'******************************************************************************
Function quoteMe(x)

quoteMe = Chr(34) & x & Chr(34)

End Function
'*******************************************************************|
'******************************************************************************
Function singleMe(x)

singleMe = Chr(39) & x & Chr(39)

End Function
'*******************************************************************|
'******************************************************************************
Function dbbl

dbbl = vbCr & vbCr

End Function
'*******************************************************************|
'******************************************************************************
Sub quitscript

MsgBox "Quitting Now"
Wscript.Quit

End Sub
'*******************************************************************|

Query Index Service

Option Explicit
Dim objShell
Dim command,srchWord,fileType,strToCopy
Set objShell = CreateObject("WScript.Shell")
command = "mmc %windir%\system32\ciadv.msc"
'advanced query sample = @all keyboard & (@filename = *.url)
srchWord = askme("Enter search word","Search For...")
fileType = askme("Enter file type" & dbbl & "Example: *.vbs","File Type...")
strToCopy = "@all " & srchWord & " & (@filename = " & fileType & ")"
copyToClipboard(strToCopy)
shellRun command,Null

'******************************************************************************
Sub copyToClipboard(vartext)
Dim objIE
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
objIE.document.parentwindow.clipboardData.SetData "text", vartext
objIE.Quit
End Sub
'*******************************************************************|

'******************************************************************************
Function shellRun(cmd,path)
objShell.Run cmd,3,False
End Function
'*******************************************************************|

'******************************************************************************
Function askMe(x,y)
askMe = InputBox(x,y)
End Function
'*******************************************************************|

'******************************************************************************
Function quoteMe(x)
quoteMe = Chr(34) & x & Chr(34)
End Function
'*******************************************************************|

'******************************************************************************
Function dbbl
dbbl = vbCr & vbCr
End Function
'*******************************************************************|

'*******************************************************
Sub quitscript
MsgBox "Quitting Now"
Wscript.Quit
End Sub
'*********************************************|

Double LOJ #2

strSQL = "SELECT DISTINCT i.ItemId " _
 & "FROM Item AS i " _
 & "LEFT OUTER JOIN ModifierItem AS m " _ 
 & "ON i.ItemId = m.ItemId " _
 & "LEFT OUTER JOIN SubMenuItem AS s "_
 & "ON i.ItemId = s.ItemId " _
 & "WHERE (m.ItemId IS NULL) AND (s.ItemId IS NULL) " _
 & "ORDER by i.ItemId" 

Left Outer Join SQL

SELECT DISTINCT i.ItemId
FROM Item AS i
LEFT OUTER JOIN ModifierItem AS m
ON i.ItemId = m.ItemId
LEFT OUTER JOIN SubMenuItem AS s
ON i.ItemId = s.ItemId
WHERE (m.ItemId IS NULL) AND (s.ItemId IS NULL)

strSQL = "SELECT DISTINCT i.ItemId " _
 & "FROM Item AS i " _
 & "LEFT OUTER JOIN ModifierItem AS m " _ 
 & "ON i.ItemId = m.ItemId " _
 & "LEFT OUTER JOIN SubMenuItem AS s " _
 & "ON i.ItemId = s.ItemId " _
 & "WHERE (m.ItemId IS NULL) AND (s.ItemId IS NULL)"

Double LEFT OUTER JOIN

SELECT DISTINCT i.ItemId

FROM Item AS i

LEFT OUTER JOIN ModifierItem AS m

ON i.ItemId = m.ItemId

LEFT OUTER JOIN SubMenuItem AS s

ON i.ItemId = s.ItemId

WHERE (m.ItemId IS NULL) AND (s.ItemId IS NULL)

LEFT OUTER JOIN

Option Explicit

Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

Dim objShell, objFSO, objOutputFile
Dim arr1(),arr2(),arr3(),arr4(),arr5,arr6(),arr7(),arr8()
Dim userDesktop,myFile1,myFile2,myFile3
Dim fullPath1,fullPath2,fullPath3,crapset
Dim strSQL,connString

Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

userDesktop = objShell.SpecialFolders("Desktop")
myFile1 = "itemsONLY_not_on_submenus.txt"
myFile2 = "itemsONLY_not_on_modpanels.txt"
myFile3 = "items_niu.txt"
fullPath1 = objFSO.BuildPath(userDesktop,myFile1)
fullPath2 = objFSO.BuildPath(userDesktop,myFile2)
fullPath3 = objFSO.BuildPath(userDesktop,myFile3)

createFile(fullPath1)
'connString = "Provider=SQLNCLI;Server=servername;DataBase=POS;"
connString = "DSN=SQL2005"
strSQL = "SELECT DISTINCT i.ItemId " _
& "FROM Item AS i " _
& "LEFT OUTER JOIN SubMenuItem AS s " _
& "ON i.ItemId = s.ItemId " _
& "WHERE (s.ItemId IS NULL)"
crapset = 1
connect_adodb connString,fullPath1,strSQL,"ItemId",null,null,null,null,null,null,Null
writeToFile arr1,arr2,objOutputFile


createFile(fullPath2)
'connString = "Provider=SQLNCLI;Server=servername;DataBase=POS;"
connString = "DSN=SQL2005"
strSQL = "SELECT DISTINCT i.ItemId " _
& "FROM Item AS i " _
& "LEFT OUTER JOIN SubMenuItem AS s " _
& "ON i.ItemId = s.ItemId " _
& "WHERE (s.ItemId IS NULL)"
crapset = 1
connect_adodb connString,fullPath1,strSQL,"ItemId",null,null,null,null,null,null,Null
writeToFile arr1,arr2,objOutputFile


'Connects to the database, then performs SQL statement
'******************************************************************************
Function connect_adodb(constr,path,sql,r1,r2,r3,r4,r5,r6,r7,r8)

Dim objConnection,objRecordset
Dim i,adUseClient,adPromptAlways
Dim result1,result2,result3,result4,result5,result6,result7,result8

i=0
adUseClient = 3
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open constr
Set objRecordset = CreateObject("ADODB.Recordset")
objRecordset.CursorLocation = adUseClient
objRecordset.Open sql, objConnection,3,3
Do While NOT objRecordset.EOF
Select Case crapset
Case 1
result1 = objRecordset.fields(r1)
ReDim Preserve arr1(i)
arr1(i) = result1
Case 2
result1 = objRecordset.fields(r1)
result2 = objRecordset.fields(r2)
If result2 = "" Then
result2 = "~~NULL~~"
End If
ReDim Preserve arr1(i)
ReDim Preserve arr2(i)
arr1(i) = result1
arr2(i) = result2
Case 3
result1 = objRecordset.fields(r1)
result2 = objRecordset.fields(r2)
result3 = objRecordset.fields(r3)
ReDim Preserve arr1(i)
ReDim Preserve arr2(i)
ReDim Preserve arr3(i)
arr1(i) = result1
arr2(i) = result2
arr3(i) = result3
Case 4
result1 = objRecordset.fields(r1)
result2 = objRecordset.fields(r2)
result3 = objRecordset.fields(r3)
result4 = objRecordset.fields(r4)
ReDim Preserve arr1(i)
ReDim Preserve arr2(i)
ReDim Preserve arr3(i)
ReDim Preserve arr4(i)
arr1(i) = result1
arr2(i) = result2
arr3(i) = result3
arr4(i) = result4
Case 5
result1 = objRecordset.fields(r1)
result2 = objRecordset.fields(r2)
result3 = objRecordset.fields(r3)
result4 = objRecordset.fields(r4)
result5 = objRecordset.fields(r5)
ReDim Preserve arr1(i)
ReDim Preserve arr2(i)
ReDim Preserve arr3(i)
ReDim Preserve arr4(i)
ReDim Preserve arr5(i)
arr1(i) = result1
arr2(i) = result2
arr3(i) = result3
arr4(i) = result4
arr5(i) = result5
Case 6
result1 = objRecordset.fields(r1)
result2 = objRecordset.fields(r2)
result3 = objRecordset.fields(r3)
result4 = objRecordset.fields(r4)
result5 = objRecordset.fields(r5)
result6 = objRecordset.fields(r6)
ReDim Preserve arr1(i)
ReDim Preserve arr2(i)
ReDim Preserve arr3(i)
ReDim Preserve arr4(i)
ReDim Preserve arr5(i)
ReDim Preserve arr6(i)
arr1(i) = result1
arr2(i) = result2
arr3(i) = result3
arr4(i) = result4
arr5(i) = result5
arr6(i) = result6
Case 7
result1 = objRecordset.fields(r1)
result2 = objRecordset.fields(r2)
result3 = objRecordset.fields(r3)
result4 = objRecordset.fields(r4)
result5 = objRecordset.fields(r5)
result6 = objRecordset.fields(r6)
result7 = objRecordset.fields(r7)
ReDim Preserve arr1(i)
ReDim Preserve arr2(i)
ReDim Preserve arr3(i)
ReDim Preserve arr4(i)
ReDim Preserve arr5(i)
ReDim Preserve arr6(i)
ReDim Preserve arr7(i)
arr1(i) = result1
arr2(i) = result2
arr3(i) = result3
arr4(i) = result4
arr5(i) = result5
arr6(i) = result6
arr7(i) = result7
Case 8
result1 = objRecordset.fields(r1)
result2 = objRecordset.fields(r2)
result3 = objRecordset.fields(r3)
result4 = objRecordset.fields(r4)
result5 = objRecordset.fields(r5)
result6 = objRecordset.fields(r6)
result7 = objRecordset.fields(r7)
result8 = objRecordset.fields(r8)
ReDim Preserve arr1(i)
ReDim Preserve arr2(i)
ReDim Preserve arr3(i)
ReDim Preserve arr4(i)
ReDim Preserve arr5(i)
ReDim Preserve arr6(i)
ReDim Preserve arr7(i)
ReDim Preserve arr8(i)
arr1(i) = result1
arr2(i) = result2
arr3(i) = result3
arr4(i) = result4
arr5(i) = result5
arr6(i) = result6
arr7(i) = result7
arr8(i) = result8
End Select
i = i + 1
objRecordset.MoveNext
Loop

MsgBox "End of Query",0,"End"

If result1 = empty Then
MsgBox "No records",0,"No Records Returned"
End If

End Function
'********************************************|

'******************************************************
Function createFile(path)

Set objOutputFile = objFSO.CreateTextFile(path,True)

End Function
' ********************************************|


'*******************************************************
Function writeToFile(arr01,arr02,path)

Dim x, strText

Select Case crapset
Case 1
For x=0 To UBound(arr01)
strText = arr01(x) & vbCr
path.WriteLine strText
path.WriteLine "------------------"
Next
Case 2
For x=0 To UBound(arr01)
strText = arr01(x) & vbTab & arr02(x) _
& vbCr
path.WriteLine strText
Next
'#############HTML Format ######################
' For x=0 To UBound(arr01)
' strText = "pre" & arr01(x) & vbTab & arr02(x) _
' & "br-----------------------br/pre"
' path.WriteLine strText
' Next
'#############HTML Format ######################
Case 3
For x=0 To UBound(arr01)
strText = arr01(x)
path.WriteLine strText
Next
End Select

path.Close

End Function
'*********************************************|

'*******************************************************
Sub quitscript

MsgBox "Quitting Now"
Wscript.Quit

End Sub
'*********************************************|

Event Best Practices

Prior To Event

1. Setup many CHIMs
   
2. Setup Tiplines
   
3. Flag/Test Comps/Discounts Active
   
4. Keep track of button placement (event log)
   

After Event

1. Delete/Unflag Comps/Discounts
   
2. Delete/Unflag Event-Specific-Buttons
   
3. Remove CHIM names from domain
   
4. Remove Tiplines