test
Archive - June 2010 

** work in progress

 ◄.Contents.►
 bar1
Create Shortcut File Link
Create Shortcut Folder Link
iTunes Silent Uninstall
iTunes Silent Installation
Offline Search Engine In HTA
 		 ............                        
bar1




Δ Wednesday June 2nd 2010
bar1


Δ Turn UAC On And Off

 * How to turn Vista/Windows UAC on and off via script *
  
Dim strArg
Set objApp = CreateObject("Shell.Application")
strArg = "0"'TURN OFF UAC
'strArg = "1"'TURN ON UAC
objApp.shellExecute "cmd.exe", " /c %windir%\System32\reg.exe ADD HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System /v EnableLUA /t REG_DWORD /d " & strArg & " /f", , "runas", 1
Set objApp = Nothing





Δ Create Shortcut To A Folder
* How to create a shortcut to a folder, in vbscript, to be used in your deployments *
   
'How to create a desktop shortcut to a folder


On error resume next

DIM filesys, oShortCut, sWinSysDir, sAllUsersDesktopPath
SET oShell = CreateObject("WScript.Shell")
SET filesys = CreateObject("Scripting.FileSystemObject")
sAllUsersDesktopPath = oShell.SpecialFolders("AllUsersDesktop")
Set oShortCut = oShell.CreateShortcut(sAllUsersDesktopPath & "\YourShortCutName.lnk")

If filesys.FileExists("C:\YourFolderName\token.txt") THEN
On error resume next
oShortCut.TargetPath = "c:\YourFolderName"
oShortCut.Arguments = chr(34)&"c:\YourFolderName"&chr(34)
oShortCut.IconLocation = "C:\Windows\System32\shell32.dll,19"
oShortCut.Save

WScript.Quit
END IF

If NOT filesys.FileExists("C:\YourFolderName\token.txt") THEN
On error resume next
filesys.DeleteFile sAllUsersDesktopPath & "\YourShortCutName.lnk", FALSE
WScript.Quit
END IF




Δ VBScript Create Shortcut To A File

 * How to create a shortcut to a file, in vbscript, to be used in your deployments *
   
'How to create shortcut to a file

On error resume next
DIM filesys, oShortCut
SET oShell = CreateObject("WScript.Shell")
SET filesys = CreateObject("Scripting.FileSystemObject")
sAllUsersDesktopPath = oShell.SpecialFolders("AllUsersDesktop")
Set oShortCut = oShell.CreateShortcut(sAllUsersDesktopPath & "\YourShortcutName.lnk")


If filesys.FileExists("C:\Program Files\YourProgram.exe") THEN
oShortCut.TargetPath = chr(34)&"C:\Program Files\YourProgram.exe"&chr(34)
oShortCut.Arguments = chr(34)&"C:\Program Files\YourProgram.exe"&chr(34)
''' "C:\Windows\System32\shell32.dll,19"
oShortCut.IconLocation = "C:\Program Files\YourProgram.exe"
oShortCut.Save

WScript.Quit
END IF

If NOT filesys.FileExists("C:\Program Files\YourProgram.exe") THEN
filesys.DeleteFile sAllUsersDesktopPath & "\YourShortcutName.lnk", FALSE
WScript.Quit
END IF





Δ iTunes Silent Uninstall

 * Silently uninstall full iTunes package *

 bar1
Here are our specs:
Uninstall iTunes silently
Uinstall QuickTime silently
Uninstall Bonjour silently
Unnstall Mobile Me silently
Uninstall Apple Update silently
Uninstall Device Support silently
Uninstall Application Support silently
Remove Shortcuts
bar1
wmic product where name='iTunes' call uninstall
wmic product where name='QuickTime' call uninstall
wmic product where name='Apple Software Update' call uninstall
wmic product where name='Apple Mobile Device Support' call uninstall
wmic product where name='Bonjour' call uninstall
wmic product where name='Apple Application Support' call uninstall
wmic product where name='MobileMe Control Panel' call uninstall

bar1





Δ Tuesday June 1st 2010
bar1


Δ iTunes Silent Installation

 * Silently install full iTunes package *

 bar1
Here are our specs:
Install iTunes silently
Install QuickTime silently
Install Bonjour silently
Install Mobile Me silently
Install Apple Update silently
Install Device Support silently
Install Application Support silently
Accept iTunes EULA
Copy customized QuickTime Settings
Stop self-healing desktop icons
Make sure all current users get settings
Make sure all new users get settings
bar1
On error resume next
Dim WshShell, objFSO, SystemDrive, AllUsersProgramsPath, AllUsersDesktopPath, oShortCut, oShell
SET filesys = CreateObject("Scripting.FileSystemObject")
SET oShell = CreateObject("WScript.Shell")

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

SystemDrive = WshShell.ExpandEnvironmentStrings("%Systemdrive%")
AllUsersProgramsPath = SystemDrive & "\Documents and Settings\All Users\Start Menu\Programs"
AllUsersDesktopPath = SystemDrive & "\Documents and Settings\All Users\Desktop"


'THIS WILL BE THE CATCH FOR UNINSTALLATION
If NOT filesys.FileExists("C:\_ResourceFiles\iTunes\AppleApplicationSupport.msi") THEN WSCRIPT.QUIT

'else

'ENTER MAIN INSTALLATION ROUTINE
'INSTALLS APPLICATION SUPPORT.
WshShell.Run "c:\windows\system32\msiexec /i ""C:\_ResourceFiles\iTunes\AppleApplicationSupport.msi"" /qn /norestart", 1, True

'INSTALLS MOBILE DEVICE SUPPORT.
WshShell.Run "c:\windows\system32\msiexec /i ""C:\_ResourceFiles\iTunes\AppleMobileDeviceSupport.msi"" /qn /norestart", 1, True

'INSTALLS SOFTWARE UPDATE.
WshShell.Run "c:\windows\system32\msiexec /i ""C:\_ResourceFiles\iTunes\AppleSoftwareUpdate.msi"" /qn /norestart", 1, True

'INSTALLS BONJOUR.
WshShell.Run "c:\windows\system32\msiexec /i ""C:\_ResourceFiles\iTunes\Bonjour.msi"" /qn /norestart", 1, True

'INSTALLS MOBILE ME.
WshShell.Run "c:\windows\system32\msiexec /i ""C:\_ResourceFiles\iTunes\MobileMe.msi"" /qn /norestart", 1, True

'INSTALLS QUICKTIME.
WshShell.Run "c:\windows\system32\msiexec /i ""C:\_ResourceFiles\iTunes\QuickTime.msi"" /qn /norestart", 1, True

'REMOVES THE QUICKTIME TASKBAR ICON.
WshShell.RegWrite "HKLM\SOFTWARE\Apple Computer, Inc.\QuickTime\ActiveX\QTTaskRunFlags", 2, "REG_DWORD"

'Uses TaskKill to remove the taskbar icon right away instead of waiting for a restart.
WshShell.Run "%COMSPEC% /C TASKKILL /F /IM qttask.exe", 0, False

'INSTALLS ITUNES.
WshShell.Run "c:\windows\system32\msiexec /i ""C:\_ResourceFiles\iTunes\iTunes.msi"" DESKTOP_SHORTCUTS=0 /qn", 1, True


'CREATE QUICKTIME SHORTCUT
AllUsersDesktopPath = oShell.SpecialFolders("AllUsersDesktop")
Set oShortCut = oShell.CreateShortcut(AllUsersDesktopPath & "\QuickTime Player.lnk")
oShortCut.TargetPath = "C:\Program Files\QuickTime\QuickTimePlayer.exe"
oShortCut.IconLocation = "C:\Program Files\QuickTime\QuickTimePlayer.exe"
oShortCut.Save

SetPreferenceFiles

If objFSO.FileExists (AllUsersProgramsPath & "\iTunes\iTunes.lnk") Then
On error resume next
objFSO.CopyFile (AllUsersProgramsPath & "\iTunes\iTunes.lnk"), (AllUsersProgramsPath & "\Accessories\Entertainment\iTunes.lnk"), True
objFSO.DeleteFolder (AllUsersProgramsPath & "\iTunes"), True
End If

If objFSO.FileExists (AllUsersDesktopPath & "\iTunes.lnk") Then
On error resume next
objFSO.DeleteFile (AllUsersDesktopPath & "\iTunes.lnk"), True
End If

'CREATE ITUNE SHORTCUT
AllUsersDesktopPath = oShell.SpecialFolders("AllUsersDesktop")
Set oShortCut = oShell.CreateShortcut(AllUsersDesktopPath & "\iTunes.lnk")
oShortCut.TargetPath = "C:\Program Files\iTunes\iTunes.exe"
oShortCut.IconLocation = "C:\Program Files\iTunes\iTunes.exe"
oShortCut.Save

'COPIES A SHORTCUT TO ITUNES TO PREVENT THE MSI INSTALLER FROM BEING INVOKED FOR EACH USER - WHICH GENERATES THE DESKTOP AND START MENU ICONS AGAIN.
If objFSO.FileExists ("c:\_ResourceFiles\iTunes\iTunes.lnk") Then
On error resume next
objFSO.CopyFile ("c:\_ResourceFiles\iTunes\iTunes.lnk"), (AllUsersProgramsPath & "\Accessories\Entertainment\iTunes.lnk"), True
End If

Wscript.Quit

'SUBROUTINES ARE SHOWN BELOW
Sub SetPreferenceFiles
' Sets the needed preference files, creating the folder structure if it does not already exist.
Dim Subfolder, UserPaths

On error resume next

Set UserPaths = objFSO.GetFolder(SystemDrive & "\Documents and Settings\").Subfolders

'THIS CYCLES THROUGH EACH USER PROFILE - COPIES CUSTOMIZED ITUNES EULA AND QUICKTIME FILES TO EACH USER PROFILE
For Each Subfolder in UserPaths
On error resume next
'msgbox Subfolder
If Subfolder = (SystemDrive & "\Documents and Settings\LocalService") Then
On error resume next
'DOES NOTHING.
Else
If Subfolder = (SystemDrive & "\Documents and Settings\NetworkService") Then
On error resume next
'DOES NOTHING.
Else
If Subfolder = (SystemDrive & "\Documents and Settings\All Users") Then
On error resume next
'DOES NOTHING.
Else

'CREATES NECESSARY FOLDERS FOR CUSTOM FILES TO BE COPIED OVER
If Not objFSO.FolderExists (Subfolder & "\Local Settings\Application Data\Apple Computer") Then
On error resume next
objFSO.CreateFolder (Subfolder & "\Local Settings\Application Data\Apple Computer")
End If

If Not objFSO.FolderExists (Subfolder & "\Local Settings\Application Data\Apple Computer\iTunes") Then
On error resume next
objFSO.CreateFolder (Subfolder & "\Local Settings\Application Data\Apple Computer\iTunes")
End If

If Not objFSO.FolderExists (Subfolder & "\Local Settings\Application Data\Apple Computer\QuickTime") Then
On error resume next
objFSO.CreateFolder (Subfolder & "\Local Settings\Application Data\Apple Computer\QuickTime")
End If

If Not objFSO.FolderExists (Subfolder & "\Application Data\Apple Computer") Then
On error resume next
objFSO.CreateFolder (Subfolder & "\Application Data\Apple Computer")
End If

If Not objFSO.FolderExists (Subfolder & "\Application Data\Apple Computer\iTunes") Then
On error resume next
objFSO.CreateFolder (Subfolder & "\Application Data\Apple Computer\iTunes")
End If

If Not objFSO.FolderExists (Subfolder & "\Application Data\Apple Computer\QuickTime") Then
On error resume next
objFSO.CreateFolder (Subfolder & "\Application Data\Apple Computer\QuickTime")
End If

'THIS FILE ACCEPTS THE LICENSE AGREEMENT FOR ITUNES; ACCEPT EULA
'NOTE::THIS GETS COPIES TO ALL USER PROFILES INCLUDING THE DEFAULT USER
If objFSO.FileExists ("c:\_ResourceFiles\iTunes\localset\Application Data\Apple Computer\iTunes\iTunesPrefs.xml") Then
On error resume next
objFSO.CopyFile "c:\_ResourceFiles\iTunes\localset\Application Data\Apple Computer\iTunes\iTunesPrefs.xml", (Subfolder & "\Local Settings\Application Data\Apple Computer\iTunes\iTunesPrefs.xml"), True
End If

If objFSO.FileExists ("c:\_ResourceFiles\iTunes\appdata\Apple Computer\iTunes\iTunesPrefs.xml") Then
On error resume next
objFSO.CopyFile "c:\_ResourceFiles\iTunes\appdata\Apple Computer\iTunes\iTunesPrefs.xml", (Subfolder & "\Application Data\Apple Computer\iTunes\iTunesPrefs.xml"), True
End If

'COPIES CUSTOMIZED QUICKTIME SETTINGS
'NOTE::THIS GETS COPIES TO ALL USER PROFILES INCLUDING THE DEFAULT USER
If objFSO.FileExists ("c:\_ResourceFiles\iTunes\appdata\Apple Computer\QuickTime\QTPlayerSession.xml") Then
On error resume next
objFSO.CopyFile "c:\_ResourceFiles\iTunes\appdata\Apple Computer\QuickTime\QTPlayerSession.xml", (Subfolder & "\Application Data\Apple Computer\QuickTime\QTPlayerSession.xml"), True
End If

If objFSO.FileExists ("c:\_ResourceFiles\iTunes\localset\Application Data\Apple Computer\Quicktime\QuickTime.qtp") Then
On error resume next
objFSO.CopyFile "c:\_ResourceFiles\iTunes\localset\Application Data\Apple Computer\Quicktime\QuickTime.qtp", (Subfolder & "\Local Settings\Application Data\Apple Computer\QuickTime\QuickTime.qtp"), True
End If

End If
End If
End If
Next
End Sub
Wscript.Quit




Δ Offline Search Engine in HTA

 * Create a searchable, offline HTA engine that queries a dictionary file and returns valid links *
bar1
Here are our specs:
Create HTA to act as an offline search engine
Read site hyperlinks from a text file
Return valid links inside of a HTA
bar1
<!--
============================================
Name: Offline Search Engine
Author: Eddie Jackson
Contact:
Created on: 06/01/2010
Modified:
Modified by:
Description:
============================================-->
<HTML>
<HEAD>
<TITLE>&nbsp;</TITLE>
<HTA:APPLICATION ID="Search Engine"
BORDER="thick"
INNERBORDER="yes"
SCROLL="no"
CAPTION="yes"
SHOWINTASKBAR="no"
SINGLEINSTANCE="yes"
SYSMENU="no"
WINDOWSTATE="normal"

>
<STYLE> body {margin:2}
</STYLE>

</HEAD>

<BODY bgcolor="black">

<SCRIPT Language="VBScript">


On error resume next
Sub Window_Onload

On error resume next
strComputer = "."
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

End Sub

sub launch(pgm)
On error resume next
set shell = createobject("wscript.shell")
shell.run pgm
end sub
Sub Window_OnLoad
On error resume next
w = 700
h = 800
Return = ResizeWindow(w, h)
Return = CenterWindow(w, h)



End Sub

Function ResizeWindow(w, h)
On error resume next
width = w
height = h
window.resizeTo width, height
End Function

Function CenterWindow(w, h)
On error resume next
x = (screen.width-w)/2
y = (screen.height-h)/2
window.moveTo x, y
End Function
</SCRIPT>



<SCRIPT LANGUAGE="VBScript">
Sub funcSEARCH
on error resume next
Dim strTextToFind, strInputFile, strOutputFile, boolMatchCaseSensitive
Dim objFSO, objInputFile, strFoundText, strLine, objOutputFile, strFinal


Dim inet, strContents, myFSO, WebPage
set inet = createobject("InetCtls.Inet")
inet.Url = "http://eddiejackson.22web.net/data/test.txt"
inet.RequestTimeOut = 10

strContents = inet.OpenUrl()
Set myFSO = CreateObject("Scripting.FileSystemObject")
Set WebPage = myFSO.OpenTextFile("c:\dictionary.txt", 2, True)'for writing
'Set WebPage = myFSO.OpenTextFile("c:\testfile.txt", 8, True)'for appending
'Set WebPage = myFSO.OpenTextFile("c:\testfile.txt", 1, True)'for reading
LCaseContents = LCase(strContents)
WebPage.WriteLine(lCaseContents)
WebPage.close
SET WebPage = NOTHING
SET myFSO = NOTHING
on error goto 0

On error resume next



DataArea.InnerHTML = ""
DataArea.InnerHTML = strFinal
strFinal = ""

strInputFile = "C:\dictionary.txt"

Set objFSO = CreateObject("Scripting.FilesystemObject")
Const intForReading = 1

if Search1.value <> "" then
Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
Do until objInputFile.atEndOfStream
strLine = objInputFile.ReadLine

Dim strAryWords
Dim strValue


strAryWords = Split(Search1.value, " ")
' - strAryWords is now an array
Dim i
For i = 0 to Ubound(strAryWords)
'msgbox strAryWords(i)
Searching = strAryWords(i)
LCaseSearch = LCase(Searching)
If InStr(strLine,LCaseSearch) > 0 Then
strLine = "<a href="&chr(34) & strLine &chr(34)&">"&strLine & "</a><br>"&chr(10)
'msgbox strLine
strFinal = strLine & strFinal
'msgbox strFinal
'DataArea.InnerHTML = strFinal
end if

Next

Loop
DataArea.InnerHTML = strFinal
objInputFile.Close
end if

'if Search2.value <> "" then
' Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
' Do until objInputFile.atEndOfStream
' strLine = objInputFile.ReadLine
' If InStr(strLine,Search2.value) > 0 Then
' strLine = "<a href="&chr(34) & strLine &chr(34)&">"&strLine & "</a><br>"
' 'msgbox strLine
' strFinal = strLine & strFinal
' 'msgbox strFinal
' 'DataArea.InnerHTML = strFinal
' end if
' Loop
' DataArea.InnerHTML = strFinal & "<br>"
'objInputFile.Close
'End if

'if Search3.value <> "" then
' Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
' Do until objInputFile.atEndOfStream
' strLine = objInputFile.ReadLine
' If InStr(strLine,Search3.value) > 0 Then
' strLine = "<a href="&chr(34) & strLine &chr(34)&">"&strLine & "</a><br>"
' 'msgbox strLine
' strFinal = strLine & strFinal
' 'msgbox strFinal
' 'DataArea.InnerHTML = strFinal
' end if
' Loop
' DataArea.InnerHTML = strFinal
' objInputFile.Close
'end if


Set objInputFile = Nothing
end sub

</SCRIPT>


<body alink="lightgreen" link="green" vlink="lightgreen">
<center>
<IMG src="http://eddiejackson.22web.net/data/scanner.gif" application="yes" width="100%" height="1%" marginwidth="0" marginheight="0" frameborder="0">
</IMG>
</center>
<br>
<br>
<center>
<td height="15"><input type="text" name="Search1" size="45">

</td></tr>
<br>
<br>
<Input id=runbutton class="button" type="button" value="Search" name="search_button" onClick="funcSEARCH">
</center>
</br>

<center>
<h5>
<font color="lightgreen">
<font size="3">
<span id="DataArea"></span>
</font></font>
</h5>
</center>



</body>

</BODY>
</HTML>

bar1


..About

..I'm a Computer
..Systems Engineer

..Living and loving life
........................................


..Author
...



..Archives

 ... < June 2010
... < May 2010
... < March 2010
 ... < February 2010
 ... < January 2010
 ... < December 2009
 ... < November 2009
 ... < October 2009
 ... < September 2009
... < August 2009
 ... < July 2009