What's up with packaging these days? It seems every manufacturer, container shipper, and postal carrier entity is experimenting with new ways to package things. Some are borderline clever. Some are just outright dumb. This goes beyond the pack-and-ship aspects. I'm also talking about how desktop and laptop computers are assembled.
Since 2000, I've counted no less than two dozen unique assembly methods used by Dell and HP alone. Screws, thumb-screws, clips, snaps, notches, latches, folding, sliding, lifting, pulling. You name it. What's up with that? Why screws anyway? As if the little toy-like lock hasps are any deterrent to thieves and tinkerers. Just make the cases snap together and be done with it. And if you look at the insides of a computer, oh geez. One minute of gazing and you can easily spot a half-dozen fabrication head-scratchers. Things that make you ask "why do it that way?"
I'm not talking about complicated things either. This applies to simple boxes like the power supply, cd/dvd drives and backplanes. The costs being wasted by overly complicated fastening methods, attachment methods, alignment methods, and so on, is just insane. The reason in most cases is patent blocking. Someone holds patents on the simplest methods and won't play nice with the big players anymore. So they do their own and it ends up being a clusterf**k. Given that not one single manufacturer uses a common-sense assembly approach (except for maybe Apple, in some cases, pardon the pun) I am wondering if it's the patent holder that's to blame. Demanding too high of a price for licensing. Or maybe they just don't want to play at all. Who knows. We're paying the price, both literally and indirectly (ripping our fingers on the sharp edges, contorting to plug things in). Progress and innovation have been tossed into a cell and locked up by attorneys. The 20th century was all about making new things. The 21st century is shaping up to be about protecting things, pure and simple. RIP innovation.
Wednesday, July 15, 2009
Tuesday, July 14, 2009
VBScript Query All Domain Controllers for a User Account Status
Query all domain controllers for the status of a specified user account. This can come in handy when there are suspected replication problems in AD and some domain controllers are not up to date on a given account (locked, disabled, modified, etc.).
Const userid = "ServiceAccount20"
Const ou = "OU=ServiceAccounts,OU=IT,OU=Corp,DC=contoso,DC=com"
Const pageSize = 1000
Const ADS_SCOPE_SUBTREE = 2
Set dso = GetObject("LDAP:")
'----------------------------------------------------------------
Function Domain_LDAP()
Dim retval, objRootDSE
Set objRootDSE = GetObject("LDAP://RootDSE")
retval = objRootDSE.Get("defaultNamingContext")
Domain_LDAP = retval
End Function
'----------------------------------------------------------------
' function:
'----------------------------------------------------------------
Function CName(strval)
Dim tmp
tmp = Replace(strval, "CN=NTDS Settings,CN=", "")
CName = Split(tmp, ",")(0)
End Function
'----------------------------------------------------------------
' function:
'----------------------------------------------------------------
Function DomainControllers()
Dim objConnection, objCommand, objRecordSet
Dim dn, retval : retval = ""
dcn = Domain_LDAP()
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Properties("ADSI Flag") = 1
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = _
"SELECT distinguishedName FROM " & _
"'LDAP://cn=Configuration," & dcn & "' " & _
"WHERE objectClass='nTDSDSA'"
objCommand.Properties("Page Size") = pageSize
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
wscript.echo "info: querying for list of domain controllers..."
Do Until objRecordSet.EOF
dn = objRecordSet.Fields("distinguishedName").Value
If retval <> "" Then
retval = retval & vbTab & dn
Else
retval = dn
End If
objRecordSet.MoveNext
Loop
DomainControllers = retval
End Function
'----------------------------------------------------------------
wscript.echo "info: user account = " & userid
dclist = DomainControllers()
wscript.echo "info: querying user account status from each domain controller..."
For each strDC in Split(dclist, vbTab)
cn = CName(strDC)
dcn = Replace(strDC, "CN=NTDS Settings,", "")
Set objUser = GetObject("LDAP://" & cn & "/CN=" & userid & "," & ou)
On Error Resume Next
' refer to http://support.microsoft.com/kb/305144
uac = objUser.Get("userAccountControl")
If err.Number <> 0 Then
wscript.echo err.Number & " - " & err.Description
Else
' add more cases below if you prefer, or logand the results
Select Case uac
Case 512: wscript.echo "info: " & cn & " = normal"
Case 16: wscript.echo "info: " & cn & " = locked"
Case 2: wscript.echo "info: " & cn & " = disabled"
Case 65536: wscript.echo "info: " & cn & " = never-expires"
Case Else: wscript.echo "info: " & cn & " = unknown: " & uac
End Select
End If
Next
VBScript / ASP Secure LDAP Query of User Group Membership
Check if a user is a member of a specified domain security group using a secure LDAP query with ADsDSoObject provider. Works for ASP and VBScript using a specified domain service/proxy user account (when anonymous LDAP is disabled).
Example:
If IsMemberOf("SalesManagers", "JohnDoe") Then
Response.Write "is a member"
End If
Const ldap_user = "domain\useraccount"
Const ldap_pwd = "P@ssW0rd$"
Const ou = "OU=Sales,OU=North America,OU=Corp,DC=contoso,DC=com"
Const ADS_SCOPE_SUBTREE = 2
Function IsMemberOf(groupName, uid)
Dim objConnection, objCommand, objRecordSet
Dim retval : retval = False
Dim i, gplen : gplen = Len(groupName)+3
On Error Resume Next
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Properties("User ID") = ldap_user
objConnection.Properties("Password") = ldap_pwd
objConnection.Properties("Encrypt Password") = TRUE
objConnection.Properties("ADSI Flag") = 1
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT memberof FROM 'LDAP://" & ou & "' " & _
"WHERE objectCategory='user' AND sAMAccountName='" & uid & "'"
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
For i = 0 to objRecordSet.Fields.Count -1
For each m in objRecordSet.Fields("memberof").value
If Left(Ucase(m),gplen) = Ucase("CN=" & groupname) Then
retval = True
End If
Next
Next
objRecordSet.MoveNext
Loop
objRecordSet.Close
Set objRecordSet = Nothing
Set objCommand = Nothing
Set objConnection = Nothing
IsMemberOf = retval
End Function
VBScript / ASP Secure LDAP User Query
Query Active Directory using a service/proxy user account from within VBScript or an ASP web page. Returns results as a tab-delimited string, where each token is sub-delimited using a pipe character "|".
example:
x = GetUserData("JohnDoe", "ADsPath, mail, department, givenName, sn")
For each v in Split(x, vbTab)
response.write Replace(v, "|", " = ") & "<br/>"
Next
Const ldap_user = "domain\useraccount"
Const ldap_pwd = "P@ssW0rd$"
Const ou = "OU=Sales,OU=North America,OU=Corp,DC=contoso,DC=com"
Function GetUserData(uid, fields)
Const ADS_SCOPE_SUBTREE = 2
Dim objConnection, objComment, objRecordSet
Dim retval : retval = ""
Dim i, fieldname, strvalue
On Error Resume Next
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Properties("User ID") = ldap_user
objConnection.Properties("Password") = ldap_pwd
objConnection.Properties("Encrypt Password") = TRUE
objConnection.Properties("ADSI Flag") = 1
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT " & fields & _
" FROM 'LDAP://" & ou & "' " & _
"WHERE objectCategory='user' AND sAMAccountName='" & uid & "'"
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
For i = 0 to objRecordSet.Fields.Count -1
fieldname = objRecordSet.Fields(i).Name
strvalue = objRecordSet.Fields(i).Value
If retval <> "" Then
retval = retval & vbTab & fieldname & "|" & strValue
Else
retval = fieldname & "|" & strValue
End If
Next
objRecordSet.MoveNext
Loop
GetUserData = retval
End Function
Monday, July 13, 2009
VBScript Enumerate AD OUs and Containers
Dim objDSE, strDefaultDN, strDN, objContainer, objChild
Const enumContainersAlso = False
Set objRootDSE = GetObject("LDAP://rootDSE")
strDefaultDN = Domain_LDAP()
Set objContainer = GetObject("LDAP://" & strDefaultDN)
Call ListObjects(objContainer, "")
Function Domain_LDAP()
Dim retval
retval = objRootDSE.Get("defaultNamingContext")
Domain_LDAP = retval
End Function
Function Domain_NetBIOS(ldapdn)
Domain_NetBIOS = Replace(Replace(ldapdn,"DC=",""),",",".")
End Function
Sub ListObjects(objADObject, strSpace)
Dim objChild
For Each objChild in objADObject
Select Case objChild.Class
Case "organizationalUnit":
objName = Mid(objChild.Name,4)
objContainer = objChild.distinguishedName
wscript.echo strSpace & "(o) " & objName
Call ListObjects(objChild, "....")
Case "container":
If enumContainersAlso Then
objName = Mid(objChild.Name,4)
objContainer = objChild.distinguishedName
wscript.echo strSpace & "(c) " & objName
End If
Call ListObjects(objChild, "....")
End Select
Next
End Sub
VBScript Get Active Directory Environment Data
Set objRootDSE = GetObject("LDAP://rootDSE")
wscript.Echo "defaultNamingContext = " & objRootDSE.Get("defaultNamingContext")
wscript.Echo "rootdomainNamingContext = " & objRootDSE.Get("rootDomainNamingContext")
wscript.Echo "configurationNamingContext = " & objRootDSE.Get("configurationNamingContext")
wscript.Echo "dnsHostName = " & objRootDSE.Get("dnsHostName")
wscript.echo "CN: " & GetCN(objRootDSE.Get("defaultNamingContext"))
Function GetCN(dn)
Dim retval
retval = Split(dn, ",")
GetCN = Mid(retval(0),4)
End Function
Sunday, July 12, 2009
Editorial: Stupid Damn Apple iPhone Commerical
I have to step off the wagon for a moment to bitch about something irritating the living shit out of me: The latest Apple commercial for the iPhone. This is the one that brags about being able to copy and paste crap from one place to another. Such as phone numbers into emails, and so on.
Really? For real?!!
I've been doing that on my cheap, crappy old Blackberry for years. YEARS!!!! God damn years!!!
I have to assume Steve Jobs wasn't consulted about this idea before it went to press. I can't believe he would have consented to it. Of all the cool, innovative things the iPhone can do, copy-and-paste is an embarrassing late-comer to the party. Why would they make a whole commercial for just that one thing? What next, a commercial that they finally got a multi-button mouse?
Yes, I know about the stupid-as-hell "mighty mouse" product. Ironic that I learned to use a computer in the 1980's using a 16-button digitizer mouse. It was fantastic! I could program the buttons to do everything I needed and it saved me a ton of time and effort. But Apple faggoty fans kept saying that a one-button cyclops mouse was "elegant" and "genius". Then the Mighty Mouse comes out and those same two-face bastards go on a back-patting spree with testimonials of how Apple re-innovated the concept of a multi-button mouse. Holy f-ing crap.
I like Apple.
I fucking hate Apple fans.
Really? For real?!!
I've been doing that on my cheap, crappy old Blackberry for years. YEARS!!!! God damn years!!!
I have to assume Steve Jobs wasn't consulted about this idea before it went to press. I can't believe he would have consented to it. Of all the cool, innovative things the iPhone can do, copy-and-paste is an embarrassing late-comer to the party. Why would they make a whole commercial for just that one thing? What next, a commercial that they finally got a multi-button mouse?
Yes, I know about the stupid-as-hell "mighty mouse" product. Ironic that I learned to use a computer in the 1980's using a 16-button digitizer mouse. It was fantastic! I could program the buttons to do everything I needed and it saved me a ton of time and effort. But Apple faggoty fans kept saying that a one-button cyclops mouse was "elegant" and "genius". Then the Mighty Mouse comes out and those same two-face bastards go on a back-patting spree with testimonials of how Apple re-innovated the concept of a multi-button mouse. Holy f-ing crap.
I like Apple.
I fucking hate Apple fans.
LDAP Query for User Accounts Created Since a Specific Date
Just modify the date string to use the YYYYMMDDHHMMSS.0Z format. So, for June 1, 2009, you would specify "20090601000000.0Z"
(&(objectCategory=user)(whenCreated>=20090601000000.0Z))
LDAP Query for Printers = HP DesignJet Plotters
(&(&
(uncName=*)
(objectCategory=printQueue)
(objectCategory=printQueue)
(driverName=*DesignJet*)
))
LDAP Query for Windows Server 2003 SP1 Computers in AD
(&(&(&(&(&(&(&(&(&(&
(objectCategory=Computer)
(operatingSystem=Windows Server 2003*)
(operatingSystemServicePack=Service Pack 1)
))))))))))
ASP Get Page Input (Form or QueryString)
Function GetParam(strLabel)
Dim retval : retval = ""
retval = Trim(Request.Form(strLabel))
If retval = "" Then
retval = Trim(Request.QueryString(strLabel))
End If
GetParam = retval
End Function
VBScript / ASP Function to Convert Dates to/from MySQL
' MySqlDate(Now, 1) --> "2008-02-20"
' MySqlDate(Now, 2) --> "2/20/2008"
Function MySqlDate( d, dir )
If Not isDate( d ) Then d = Date()
Dim strNewDate
Select Case dir
Case 1:
'=== store in db
strNewDate = Year( d ) & "-" & Month( d ) & "-" & Day( d )
Case 2:
'=== use with asp
strNewDate = Month( d )& "/" & Day( d ) & "/" & Year( d )
strNewDate = cDate( strNewDate )
End Select
mysqlDate = strNewDate
End Function
PHP: Determine Zodiac Sign from Birth Date
function ZodiacSign($date){
list($year,$month,$day)=explode("-",$date);
if (($month==1 && $day>20)||($month==2 && $day<20)) {
return "Aquarius";
} else if (($month==2 && $day>18 )||($month==3 && $day<21)) {
return "Pisces";
} else if (($month==3 && $day>20)||($month==4 && $day<21)) {
return "Aries";
} else if (($month==4 && $day>20)||($month==5 && $day<22)) {
return "Taurus";
} else if (($month==5 && $day>21)||($month==6 && $day<22)) {
return "Gemini";
} else if (($month==6 && $day>21)||($month==7 && $day<24)) {
return "Cancer";
} else if (($month==7 && $day>23)||($month==8 && $day<24)) {
return "Leo";
} else if (($month==8 && $day>23)||($month==9 && $day<24)) {
return "Virgo";
} else if (($month==9 && $day>23)||($month==10 && $day<24)) {
return "Libra";
} else if (($month==10 && $day>23)||($month==11 && $day<23)) {
return "Scorpio";
} else if (($month==11 && $day>22)||($month==12 && $day<23)) {
return "Sagittarius";
} else if (($month==12 && $day>22)||($month==1 && $day<21)) {
return "Capricorn";
}
}
PHP: Generate List of U.S. State Abbreviations
For form select listbox populating...
function StateCodes($deft) {
$clist = "AL,AK,AS,AZ,AR,CA,CO,CT,DC,DE,FL,GA,HI,IA,ID,IL,IN,"
. "KS,KY,LA,MA,MD,ME,MI,MN,MO,MS,MT,NC,ND,NE,NH,NJ,NM,NY,"
. "OH,OK,OR,PA,RI,SC,SD,TN,TX,UT,VA,VT,WA,WI,WV,WY";
$tok = strtok($clist, ",");
while ($tok != false) {
if ($deft == $tok) {
echo "\n";
}
else {
echo "\n";
}
$tok = strtok(",");
}
}
Saturday, July 11, 2009
KiXtart: Customize OEM Support Information
? "[OEMSupportTag].....: Configuring OEM Support applet..."
Dim $oeminfo, $oemlogo, $oemsupp, $x, $regkey
Dim $logfile, $oemlogosrc, $oemsuppsrc
Dim $wmi, $wmi_compsys, $wmi_comp, $model, $desc, $asset
$weblink = "https://intranet.company.com/helpdesk"
$regkey = "HKLM\System\CurrentControlSet\Control\Windows"
$value = ReadValue($regkey,"SystemDirectory")
$windir = ExpandEnvironmentVars($value)
If $windir <> ""
$oeminfo = $windir+"\oeminfo.ini"
$oemlogo = $windir+"\oemlogo.bmp"
$oemsupp = $windir+"\web\support.htm"
$logfile = $windir+"\custom_oem.ini"
$oemlogosrc = @lserver+"\netlogon\oemlogo.bmp"
$oemsuppsrc = @lserver+"\netlogon\support.htm"
If Exist( $oeminfo ) = 1
? "[OEMSupportTag].....: removing existing oeminfo.ini file..."
Del( $oeminfo )
Else
? "[OEMSupportTag].....: no existing oeminfo.ini file found."
EndIf
? "[OEMSupportTag].....: attempting to create new oeminfo.ini file..."
If Open(2, $oeminfo, 5) = 0
? "[OEMSupportTag].....: file created successfully, updating contents..."
$wmi = "WINMGMTS:{IMPERSONATIONLEVEL=IMPERSONATE}!//"+@wksta
$wmi_compsys = "SELECT * FROM Win32_ComputerSystemProduct"
$wmi_comp = GetObject($wmi).ExecQuery($wmi_compsys)
For Each $objsys In $wmi_comp
$model = $objsys.Name
$desc = $objsys.Description
$asset = $objsys.IdentifyingNumber
Next
$=WriteLine(2,"[General]" + @crlf)
$=WriteLine(2,"Manufacturer=MY COMPANY, INC." + @crlf)
$=WriteLine(2,"Model="+$model + @crlf)
$=WriteLine(2,"SupportURL=$weblink" + @crlf)
$=WriteLine(2,"LocalFile=%windir%\web\support.htm" + @crlf + @crlf)
$=WriteLine(2,"[OEMSpecific]" + @crlf)
$=WriteLine(2,"SubModel=" + @crlf)
$=WriteLine(2,"SerialNo=" + @crlf)
$=WriteLine(2,"OEM1="+$asset + @crlf)
$=WriteLine(2,"OEM2=" + @crlf + @crlf)
$=WriteLine(2,"[ICW]" + @crlf)
$=WriteLine(2,"Product=Computer Asset" + @crlf + @crlf)
$=WriteLine(2,"[Support Information]" + @crlf)
$=WriteLine(2,"Line1=COMPUTER HELP DESK" + @crlf)
$=WriteLine(2,"Line2= " + @crlf)
$=WriteLine(2,"Line3=Contact Technical Support by web or phone:" + @crlf)
$=WriteLine(2,"Line4= " + @crlf)
$=WriteLine(2,"Line5= $weblink" + @crlf)
$=WriteLine(2,"Line6= 1-800-555-1212" + @crlf)
$=WriteLine(2,"Line7= " + @crlf)
$=WriteLine(2,"Line8=After hours/weekends/holidays..." + @crlf)
$=WriteLine(2,"Line9=support options may be limited." + @crlf)
$=WriteLine(2,"Line10=------------------------------" + @crlf)
$=WriteLine(2,"Line11=Computer Name: " + @wksta + @crlf)
If Trim($asset) <> ""
$=WriteLine(2,"Line12=Asset Tag: " + Trim($asset) + @crlf)
$=WriteLine(2,"Line13=IPAddress: " + @ipaddress0 + @crlf)
Else
$=WriteLine(2,"Line12=IPAddress: " + @ipaddress0 + @crlf)
EndIf
Close(2)
? "[OEMSupportTag].....: oeminfo.ini file has been successfully updated!"
Else
? "[OEMSupportTag].....: Error: failed to create new oeminfo.ini file!"
EndIf
? "[OEMSupportTag].....: oeminfo logo graphic updated already?..."
If Exist( $logfile ) = 0
? "[OEMSupportTag].....: attempting to create new oeminfo update log file..."
If Exist( $oemlogosrc ) = 1
? "[OEMSupportTag].....: downloading oeminfo logo graphic file..."
Copy $oemlogosrc $oemlogo
If Open(3, $logfile, 5) = 0
WriteLine(3,"[General]"+@crlf)
WriteLine(3,"DateAdded="+@date+@crlf)
Close(3)
? "[OEMSupportTag].....: oeminfo log updated."
EndIf
Else
? "[OEMSupportTag].....: oeminfo graphic file missing: "+$oemlogosrc
EndIf
Else
? "[OEMSupportTag].....: "+$logfile+" previously recorded."
EndIf
Else
? "[OEMSupportTag].....: Error: windir variable not set, aborting process."
EndIf
KiXtart: Get Asset Number
WMI query for asset number (e.g. Dell Asset, HP Serial number, etc.)
Function AssetNumber()
Dim $objWmi, $objWmiCS, $obj, $retval, $pc
$pc = @wksta
$objWmi = GetObject("winmgmts:{impersonationLevel=impersonate}!\\$pc\root\cimv2")
$objWmiCS = $objWmi.ExecQuery("select * from Win32_ComputerSystemProduct")
For Each $obj in $objWmiCS
$retval = $obj.IdentifyingNumber
Next
$AssetNumber = Trim($retval)
EndFunction
KiXtart: Open Browser / Display Web Page
Great for login banners and bulletins...
Function OpenWebPage($url, $show, Optional $height, $width, $fixed)
$ie = CreateObject("InternetExplorer.Application")
If $ie <> 0 and @ERROR = 0
$ie.Navigate($url)
If $show = 1
If $height > 0
$ie.Height = $height
EndIf
If $width > 0
$ie.Width = $width
EndIf
If $fixed = 1
$ie.Resizable = 0
$ie.StatusBar = 0
$ie.Toolbar = 0
EndIf
$ie.Visible = 1
Sleep 1
Else
? "(openwebpage): accessing document in silent-mode"
Sleep 1
$ie.Quit
$ie = 0
EndIf
Else
? "(openwebpage): error / unable to launch IE application object"
EndIf
EndFunction
Friday, July 10, 2009
KiXtart: Enumerate HOSTS file Entries
Break ON
$systemRoot = ExpandEnvironmentVars("%systemroot%")
$hostsFile = $systemRoot+"\system32\drivers\etc\hosts"
$fileHandle = FreeFileHandle()
$entries = 0
If Exist($hostsFile)
? "info: hosts file found at "+$hostsFile
If Open($fileHandle, $hostsFile, 1) = 0
? "info: reading file..."
$line = ReadLine($fileHandle)
While @ERROR = 0
If Left($line, 1) <> "#"
; ignore lines beginning with # as they are comments
? "line --> $line"
$entries = $entries + 1
EndIf
$line = ReadLine($fileHandle)
Loop
$=Close($fileHandle)
? "info: $entries entries found"
Else
? "fail: unable to open hosts file!"
EndIf
Else
? "fail: hosts file cannot be found!"
EndIf
VBScript: ADOX Create Access Database, Table and Insert Row
Adapted from portions of code on MSDN at http://msdn.microsoft.com/en-us/library/ms681497(VS.85).aspx
'----------------------------------------------------------------
' first we create the database file itself
'----------------------------------------------------------------
Const dbFile = "c:\database.mdb"
strDSN = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile
Const adVarWChar = 202
Const adSingle = 4
Const adLockOptimistic = 3
Const adOpenDynamic = 2
Const adCmdTable = &H0002
On Error Resume Next
wscript.echo "info: creating database..."
Dim objCatalog
Set objCatalog = CreateObject("ADOX.Catalog")
objCatalog.Create strDSN
If err.Number = 0 Then
wscript.echo "info: database created successfully"
Else
wscript.echo "fail: error = " & err.Number & " (" & err.Description & ")"
wscript.Quit(1)
End If
'----------------------------------------------------------------
' next we create a table in the new database
'----------------------------------------------------------------
wscript.echo "info: creating table..."
Set objTable = CreateObject("ADOX.Table")
objCatalog.ActiveConnection = strDSN
With objTable
.Name = "tbl_Employees"
.Columns.Append "empID", adVarWChar, 12
.Columns.Append "fname", adVarWChar, 50
.Columns.Append "lname", adVarWChar, 50
.Columns.Append "dept", adVarWChar, 50
.Columns.Append "phone", adVarWChar, 50
.Columns.Append "email", adVarWChar, 50
.Columns.Append "jobID", adSingle
.Columns.Append "birthDay", adVarWChar, 20
End With
objCatalog.Tables.Append objTable
If Err.Number <> 0 Then
wscript.echo "fail: " & err.Number & ": " & err.Description
Set objTable = Nothing
Set objCatalog = Nothing
wscript.Quit(1)
Else
wscript.echo "info: table created successfully"
End If
Set objTable = Nothing
Set objCatalog = Nothing
'----------------------------------------------------------------
' comment: SQL INSERT
'----------------------------------------------------------------
wscript.echo "info: entering a new row..."
On Error Resume Next
Set rs = CreateObject("ADODB.Recordset")
rs.Open "tbl_Employees", strDSN, adOpenDynamic, adLockOptimistic, adCmdTable
If err.Number <> 0 Then
rs.Close
Set rs = Nothing
wscript.echo "fail: error = " & err.Number & " (" & err.Description & ")"
wscript.Quit(1)
End If
rs.AddNew
rs("empID").value = "100400"
rs("fname").value = "JOHN"
rs("lname").value = "DOE"
rs("dept").value = "SALES"
rs("phone").value = "800-555-1212"
rs("email").value = "john_doe@dumbass.local"
rs("jobID").value = 4002
rs("birthDay").value = "#03/01/1966#"
rs.Update
If err.Number <> 0 Then
rs.Close
Set rs = Nothing
wscript.echo "fail: error = " & err.Number & " (" & err.Description & ")"
wscript.Quit(1)
End If
rs.Close
Set rs = Nothing
VBScript: Sort Start Menu Items
Const optionType = 1
Const regBase = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\MenuOrder"
Set objShell = CreateObject("Wscript.Shell")
If optionType = 1 Then
' a sloppy, cheap, but effective way to do this with Wscript
cmd1 = "start /wait reg delete """ & regBase & "\Start Menu"" /f"
cmd2 = "start /wait reg delete """ & regBase & "\Start Menu2"" /f"
cmd3 = "start /wait taskkill /im explorer.exe /F"
cmd4 = "explorer.exe"
objShell.Run "cmd.exe /c " & cmd1, 1, True
objShell.Run "cmd.exe /c " & cmd2, 1, True
objShell.Run "cmd.exe /c " & cmd3, 1, True
objShell.Run "cmd.exe /c " & cmd4, 1, True
Else
' a more elegant, poofy and girly way of doing this with style and ambiance
objShell.RegDelete regBase & "\Start Menu\"
objShell.RegDelete regBase & "\Start Menu2\"
objShell.Run "cmd.exe /c start /wait taskkill /im explorer.exe /F", 1, True
objShell.Run "cmd.exe /c explorer.exe", 1, True
End If
Set objShell = Nothing
Thursday, July 9, 2009
PowerShell: Update Desktop Shortcut Targets
# iterate shortcuts to find matching target paths and
# if found, replace with new target path and save link
$desktop = $home+"\desktop"
$oldPath = "\\server1\sharename1"
$newPath = "\\server2\sharename1"
$shell = New-Object -ComObject WScript.Shell
$Dir = get-childitem $desktop -recurse
foreach($file in $Dir) {
$fname = $file.Name
# write-host $fname
$lnk = $shell.CreateShortcut($desktop+"\"+$fname)
$target = $lnk.TargetPath
if ($target -eq $oldPath) {
write-host "Updating shortcut target..."
$lnk.TargetPath = $newPath
$lnk.Save()
}
}
Tuesday, July 7, 2009
ASP - Generate Alphabet List
<select name="letter" size="1">
<%
For i = Asc("A") to Asc("Z")
Response.Write "<option>" & Chr(i) & "</option>"
Next
%>
</select>
KiXtart: Update Desktop Shortcuts
Break ON
$oldPath = "\\server1\shareName1"
$newPath = "\\server2\shareName2"
$shell = CreateObject("WScript.Shell")
$DesktopPath = ExpandEnvironmentVars("%userprofile%")+"\Desktop"
$FileName = Dir("$DesktopPath\*.lnk")
While $FileName <> "" And @error = 0
? $FileName
$link = $shell.CreateShortcut("$DesktopPath\$FileName")
If Ucase($link.TargetPath) = Ucase($oldPath)
$link.TargetPath = $newPath
$link.Save
EndIf
$FileName = Dir()
Loop
KiXtart: Enumerate Access Database Tables with ADOX
$dbfile = "\\servername\share\folder\database.mdb"
Function ListTablesADOX($db)
Dim $Conn, $strConn, $Catalog, $Table, $Column
$strConn = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source=$db"
? "Database: $db @CRLF"
$Conn = CreateObject("ADODB.Connection")
$Catalog = CreateObject("ADOX.Catalog")
$Table = CreateObject("ADOX.Table")
$Column = CreateObject("ADOX.Column")
$Conn.Open($strConn)
$Catalog.ActiveConnection = $Conn
For Each $Table In $Catalog.Tables
? "Table: " + $Table.Name
For Each $Column In $Table.Columns
? Chr(9) + "Column: " + $Column.Name
Next
Next
$Conn.Close
EndFunction
$=ListTablesADOX($dbfile)
KiXtart: Enumerate Local Shares
Break ON
$strComputer = "."
$tab = Chr(9)
$objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\$strComputer\root\cimv2")
$colShares = $objWMIService.ExecQuery("Select * from Win32_Share")
$numshares = $colShares.Count
? "shares found: $numshares"
For each $objShare in $colShares
$n = $objShare.Name
If Right($n,1) = "$$"
$shareType = "HIDDEN"
Else
$shareType = "OPEN"
EndIf
? $objShare.Name + $tab + $shareType + $tab +
$objShare.Path + $tab + $objShare.Caption + $tab +
$objShare.Type
Next
Sunday, July 5, 2009
VBscript Outsourcing to KiXtart
If you register the Kixtart.dll component you can invoke the "KiXtart.Application" interface to handle some basic inventory chores. This does not work from PowerShell v2 by the way.
On Error Resume Next
Set objKiX = CreateObject("KiXtart.Application")
If err.Number = 0 Then
wscript.echo "Processor: " & vbTab & Trim(objKiX.CPU)
wscript.echo "UserName: " & vbTab & objKiX.UserId
wscript.echo "Domain: " & vbTab & objKiX.LDomain
wscript.echo "MAC id: " & vbTab & objKiX.Address
wscript.echo "Privilege: " & vbTab & objKiX.Priv
wscript.echo "Password Age: " & vbTab & objKiX.PwAge
wscript.echo "ProductType: " & vbTab & objKiX.ProductType
Set objKiX = Nothing
Else
wscript.echo "kixtart.dll has not been registered"
End If
KixTart: ScriptControl JScript to Outsource Expression
Use Jscript object to calculate Cosine of a value...
Test examples...
Function Cosine($numValue)
$sc = CreateObject("ScriptControl")
$sc.Language = "jscript"
$result = $sc.Eval("Math.cos("+$numValue+")")
$sc = 0
$Cosine = $result
EndFunction
Test examples...
$testvalue = 45
$test = Cosine($testvalue)
? "cosine of $testvalue is: "+$test
KiXtart: ScriptControl VBScript to Outsource Expressions
Function DaysOld($date)
Dim $sc, $result
$sc = CreateObject("ScriptControl")
$sc.Language = "vbscript"
$result = $sc.Eval("DateDiff("+Chr(34)+"d"+Chr(34)+", "+Chr(34)+$date+Chr(34)+", Now)")
$sc = 0
$DaysOld = $result
EndFunction
Function FormatDateTime($strDate, $format)
Dim $sc, $result
$sc = CreateObject("ScriptControl")
$sc.Language = "vbscript"
$result = $sc.Eval("FormatDateTime("+Chr(34)+$strDate+Chr(34)+","+$format+")")
$sc = 0
$FormatDateTime = $result
EndFunction
Test examples:
$testvalue = '2009/01/03 12:34:56'
$test1 = FormatDateTime($testvalue, 'vbShortDate')
$test2 = FormatDateTime($testvalue, 'vbLongDate')
$test3 = FormatDateTime($testvalue, 'vbLongTime')
? "shortdate: $test1"
? "longdate: $test2"
? "longtime: $test3"
$test4 = DaysOld($testvalue)
? "days old: $test4"
KiXtart: Array List Sorting
Function ArrayList()
; this code creates and populates an ArrayList
? "Example: ArrayList object"
$myArrayList = CreateObject("System.Collections.ArrayList")
$=$myArrayList.Add("Dog")
$=$myArrayList.Add("Chicken")
$=$myArrayList.Add("Rooster")
$=$myArrayList.Add("Hen")
; Now, to add an element and sort the ArrayList, all we need to do is:
; [1] add the new element to the ArrayList
$=$myArrayList.Add("Pig")
; [2] sort the ArrayList
$=$myArrayList.Sort()
For each $item in $myArrayList
? $item
Next
EndFunction
$x = ArrayList()
VBScript Scrape Links/IMG tags from URL
args = WScript.Arguments.Count
If args <> 1 Then
Wscript.Echo "usage: ScrapeLinks.vbs URL"
Wscript.Quit
End If
URL = WScript.Arguments.Item(0)
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate URL
Do Until ie.ReadyState = 4
Wscript.sleep 10
Loop
Wscript.Echo "DOCUMENT LINKS"
Wscript.Echo
For each link in ie.Document.Links
Wscript.Echo link, link.InnerText
Next
Wscript.Echo
Wscript.Echo "DOCUMENT IMAGE TAGS"
Wscript.Echo
For each pix in ie.Document.Images
Wscript.Echo pix.Src
Next
ie.Quit
Set ie = Nothing
VBScript Enumerate Shortcuts
Enumerate shortcuts under all-users profile and report in XML format...
Option Explicit
Const strComputer = "."
Const rKey = "Software\Microsoft\Windows NT\CurrentVersion\ProfileList"
Const rVal = "ProfilesDirectory"
Const HKCU = &H80000001
Const HKLM = &H80000002
Dim objShell, objFSO, oReg, objRootFolder, psub, p
Dim objFolder, objLink, objFsub, linkpath, uid, objLnk
Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
If err.Number <> 0 Then
wscript.echo "error: computer is not accessible"
wscript.Quit(1)
End If
oReg.GetExpandedStringValue HKLM, rKey, rVal, p
If VarType(p) = vbNull Then
wscript.echo "error: registry key not found"
wscript.Quit(1)
End If
Set objRootFolder = objFSO.GetFolder(p)
wscript.echo ""
wscript.echo "" "
For each objFolder in objRootFolder.SubFolders
uid = objFolder.Name
psub = p & "\" & uid & "\desktop"
If objFSO.FolderExists(psub) Then
wscript.echo vbTab & "" "
Set objFsub = objFSO.GetFolder(psub)
For each objLink in objFsub.Files
If InStr(1, ".lnk .url", Lcase(Right(objLink.Name,4))) <> 0 Then
wscript.echo vbTab & vbTab & "" "
linkpath = psub & "\" & objLink.Name
Set objLnk = objShell.CreateShortcut(linkpath)
Select Case Lcase(Right(linkpath,4))
Case ".lnk":
ClosedTag 3, "name", objLnk.Name
ClosedTag 3, "fullname", objLnk.FullName
ClosedTag 3, "arguments", objLnk.Arguments
ClosedTag 3, "working", objLnk.WorkingDirectory
ClosedTag 3, "target", objLnk.TargetPath
ClosedTag 3, "icon", objLnk.IconLocation
ClosedTag 3, "hokey", objLnk.Hotkey
ClosedTag 3, "windowstyle", objLnk.WindowStyle
ClosedTag 3, "description", objLnk.Description
ClosedTag 3, "type", "filesystem"
Case ".url":
ClosedTag 3, "name", objLnk.Name
ClosedTag 3, "fullname", objLnk.FullName
ClosedTag 3, "target", objLnk.TargetPath
ClosedTag 3, "type", "internet"
End Select
wscript.echo vbTab & vbTab & "
End If
Next
wscript.echo vbTab & "
End If
Next
wscript.echo "
Sub ClosedTag(indent, label, val)
Dim i, s : s = ""
For i = 1 to indent
s = s & vbTab
Next
If Trim(val) = "" Then
s = s & "<" & label & ">_"
Else
s = s & "<" & label & ">" & val & ""
End If
wscript.echo s
End Sub
Set objFolder = Nothing
Set objFSO = Nothing
Set objShell = Nothing
VBScript / ASP Determine Next Pay Date
Function NextPayDate()
Dim wd, base : base = CDate("6/12/2009")
Dim today : today = Now
If IsPayDate(today) Then
NextPayDate = today
Else
wd = WeekDay(today)
Select Case wd
Case 6:
' if today is a friday
If IsPayDate(DateAdd("d", 14, today)) Then
NextPayDate = DateAdd("d", 14, today)
End If
Case 7:
' if today is a saturday
If IsPayDate(DateAdd("d", 6, today)) Then
NextPayDate = DateAdd("d", 6, today)
Else
NextPayDate = DateAdd("d", 13, today)
End If
Case Else:
If IsPayDate(DateAdd("d", 6-wd, today)) Then
NextPayDate = DateAdd("d", 6-wd, today)
Else
NextPayDate = DateAdd("d", 13-wd, today)
End If
End Select
End If
End Function
VBScript / ASP Is-PayDate (Crude Version)
Returns True if [dateval] is a multiple of 14 days (two weeks) from a known base pay date in the past (I picked June 12, 2009).
Example...
Function IsPayDate(dateval)
Dim days
Dim base : base = CDate("6/12/2009")
If WeekDay(dateval) = 6 Then
days = DateDiff("d", base, dateval)
If (days Mod 14) = 0 Then
IsPayDate = True
End If
End If
End Function
Example...
For each d in Split("7/2/2009,7/3/2009,7/10/2009,7/24/2009", ",")
If IsPayDate(d) Then
wscript.echo d & " is a pay date"
Else
wscript.echo d & " is not a pay date"
End If
Next
Friday, July 3, 2009
VBScript / ASP String Validate
Check if string contains a value (not Null and not empty)
Function StringVal(strval)
If Not(IsNull(strval)) And Trim(strval) <> "" Then
StringVal = True
End If
End Function
VBScript / ASP Function Days-In-Month
Function DaysInMonth(dateval)
Dim nxt
Dim tmp : tmp = DateAdd("d", -(Day(dateval)-1), dateval) ' get first day of month
nxt = DateAdd("m", 1, tmp) ' get first day of next month
DaysInMonth = Day(DateAdd("d", -1, nxt))
End Function
VBScript / ASP Array_Slice Function
Almost as good as the PHP function Array_Slice()
Function Array_Slice(arr, start, newArray)
Dim x : x = 0
For i = start-1 to Ubound(arr)-1
ReDim Preserve newArray(x)
newArray(x) = arr(i)
x = x + 1
Next
Array_Slice = Ubound(newArray)
End Function
ASP version of PHP [Die] Function
Sub Die(msg)
Response.Write "<hr/><div style=""font-family:verdana; font-size:10pt; color:red"">"
Response.Write msg & "</div><hr/>" & vbCRLF
Response.End
End Sub
ASP MailTo Link Generator
Function LinkMail(strval)
If StringVal(strval) Then
If InStr(1, strval, "@") <> 0 Then
LinkMail = "<a href='mailto:" & strval & "'>" & strval & "</a>"
Else
LinkMail = strval
End If
Else
LinkMail = strval
End If
End Function
ASP Google-Map Link Function
Spock: "Crude, but effective"
Function MapLink(strAddress, strCity, strStateZip)
Dim url
If StringVal(strAddress) And StringVal(strCity) And StringVal(strStateZip) Then
url = "http://maps.google.com/maps?hl=en&q=" & _
Replace(strAddress, " ", "+") & ",+" & _
Replace(strCity, " ", "+") & ",+" & strStateZip & _
"&ie=UTF8&split=0&gl=us&ei=OWlNStjaNo-Ztgfi5p2oBA&t=h&z=16&iwloc=A"
MapLink = "
<a href="http://www.blogger.com/%22%20&%20url%20&%20%22" target="_blank">View Map</a>" & vbCRLF
Else
MapLink = ""
End If
End Function
ASP ListBox for U.S. State Abbreviations
Sub StatesList(default)
Dim lst, x
lst = "AL,AK,AZ,AR,CA,CO,CT,DE,DC,FL," & _
"GA,HI,ID,IL,IN,IA,KS,KY,LA,ME," & _
"MD,MA,MI,MN,MS,MO,MT,NE,NV,NH," & _
"NJ,NM,NY,NC,ND,OH,OK,OR,PA,RI," & _
"SC,SD,TN,TX,UT,VT,VA,WA,WV,WI,WY"
If default = "" Then
Response.Write "" & vbCRLF
End If
For each x in Split(lst, ",")
If Ucase(x) = Ucase(default) Then
Response.Write "" & vbCRLF
Else
Response.Write "" & vbCRLF
End If
Next
End Sub
Example:
<select name="state" size="1">
<% StatesList "VA" %>
</select>
VBScript / ASP String Padding
Function PadString(strval, delim, length, side)
Dim tmp : tmp = Trim(strval)
Select Case Ucase(Left(side,1))
Case "L":
Do While Len(tmp) < length
tmp = delim & tmp
Loop
Case "R":
Do While Len(tmp) < length
tmp = tmp & delim
Loop
End Select
PadString = tmp
End Function
VBScript / ASP Date Formatter Function
Function FDate(dateval, mode)
Select Case mode
Case "MM/DD/YYYY":
FDate = FormatDateTime(dateval, vbShortDate)
Case "YYYY-MM-DD":
FDate = Year(dateval) & "-" & _
PadString(Month(dateval), "0", 2, "Left") & "-" & _
PadString(Day(dateval), "0", 2, "Left")
Case "Mmm D, YYYY":
FDate = FormatDateTime(dateval, vbLongDate)
Case "Mmm D, YYYY HH:MM:SS":
FDate = FormatDateTime(dateval, vbLongDate) & " " & FormatDateTime(dateval, vbLongTime)
Case "MM/DD":
FDate = Month(dateval) & "/" & Day(dateval)
Case "Mmm DD":
FDate = MonthName(Month(dateval), True) & " " & Day(dateval)
Case "MMM DD":
FDate = MonthName(Month(dateval), False) & " " & Day(dateval)
Case Else:
FDate = "[FDate] invalid option parameter specified"
End Select
End Function
Subscribe to:
Posts (Atom)
Posts
