option explicit

'_____________________________________________________________
'PROCS contained in this module:
'	public sub CKsys_MailSend(sTo, sFrom, sSubject, sBody)
'	public sub CKsys_EventOnClick()
'	public sub CKsys_EventOnHelp()		When user presses F1
'	public sub CKTools_WinShow()		When user presses Ctrl-F1, show CKTools dialog.
'	public sub CKTools_StylesheetsReport()
'	public sub CKTools_OnClickStyleReport(oSrcElem)
'	Public Sub CKs(sThis)
'	public sub CKmsg(sThis)





'====== GLOBAL DECLARATIONS
public gsCKs			'used by CKs
public gsMsg			'used by CKmsg

public gsCKToolsWinURL
	gsCKToolsWinURL = "xdev_cktools.htm"
	'>>> way to reference root folder of website,
	'>>> so that we can find file where it's called.
public gbCKToolsWinLoaded 



'====== COOKIE HANDLERS
	'Page declarations	
	Dim NOT_FOUND
	NOT_FOUND = "NOT_FOUND"

Sub CKSys_CooSetVar(sVarName, sVarValue)
'Creates or modifies the value assigned to a given variable.
'Args: The name of the variable, the value to store.
' >> Could include other cookie attributes, such as expire date and valid domains.  
'Cookies set with this implementation expire at the end of the user's session.  
'If the cookie should remain valid for a longer period of time,
'an expires section can be added to the string.  For example:
'	... & varVariableName & ";expires=01-Jul-96 GMT"

	'>>> Could validate args before adding cookie var.
	'>>> GetVar splits on ";" first--is ";" represented by an escape code?
	if len(sVarName)=0 then sVarName = "NoVarName"
	if len(sVarValue)=0 then sVarValue = "-empty-"
	Document.Cookie = sVarName & "=" & sVarValue
End Sub


Function CKSys_CooGetVarArray()
'Gets document.cookie, splits on ";", and loads 2D array.
'>>> Assumes that each crumb contains an assignment ("=")
'>>> Will choke on varName without a value.

	dim sCookie
	dim aCrumbArray, nCrumbs, nCrumb
	dim aVarArray						'Cookies can hold 20 values.
	dim nPosEqual
	
	sCookie = document.cookie
	aCrumbArray = Split(sCookie, ";", -1, 1)
	nCrumbs = ubound(aCrumbArray)
	redim aVarArray(nCrumbs,2)
	
	for nCrumb = 0 to nCrumbs
		nPosEqual = instr(1,aCrumbArray(nCrumb),"=",1)
		
		'left() will break if the crumb doesn't contain "="
		'that is, if the original assignment was ""
		aVarArray(nCrumb, 1) = trim(left(aCrumbArray(nCrumb), nPosEqual - 1))
		aVarArray(nCrumb, 2) = trim(mid(aCrumbArray(nCrumb), nPosEqual + 1))
	next
	CKSys_CooGetVarArray = aVarArray
End Function


Function CKSys_CooVarArray_ReportString()
'USES: function CKSys_CooGetVarArray() to get aVarArray
'RETURNS: string containing numbered list of each crumb in document.cookie, varName and varValue.
	
	dim aVarArray, nCrumbs, nCrumb
	dim sReport

	aVarArray = CKSys_CooGetVarArray()
	nCrumbs = ubound(aVarArray)
	
	sReport = ""
	for nCrumb= 0 to nCrumbs
		sReport = sReport & nCrumb & ": [" & aVarArray(nCrumb,1) & "][" & aVarArray(nCrumb,2) & "]" & vbCR
	next
	
	CKSys_CooVarArray_ReportString = sReport
End Function


Sub CKSys_CooVarArray_Msgbox
	Msgbox CKSys_CooVarArray_ReportString()
End Sub


Function CKSys_CooGetVar(sVarName)
'USES: function CKSys_CooGetVarArray to get aVarArray
'RETURNS: string containing value associated with sVarName
'>>> No validation of sVarName; assumed that it exists.

	dim aVarArray, nCrumbs, nCrumb
	dim sCurrVal
	
	aVarArray = CKSys_CooGetVarArray()
	nCrumbs = ubound(aVarArray)
	
	sCurrVal = NOT_FOUND
	for nCrumb = 0 to nCrumbs
		if aVarArray(nCrumb, 1) = sVarName then
			sCurrVal = aVarArray(nCrumb, 2)
		end if
	next
	CKSys_CooGetVar = sCurrVal
End Function

Sub CKSys_CooKillVar(sVarName)
' Delete a variable, marks cookie for deletion.
' Inputs:  The name of the variable to delete  		      
' Notes:   cookie deleted by setting expires attribute to a date in the past.

	CKSys_CooSetVar sVarName, "NULL;expires=Monday, 01-Jan-95 12:00:00 GMT"
End Sub


'====== Send email using CDO, if SMTP has been installed.
'Example copied from MyWebs/DOCS/Scripting/"Send Email from Script"
public sub CKsys_MailSend(sTo, sFrom, sSubject, sBody)
	dim oEmail
	
	Set oEmail = CreateObject("CDO.Message")
	oEmail.From = sFrom
	oEmail.To = sTo
	oEmail.Subject = sSubject
	oEmail.Textbody = sBody
	oEmail.Send
end sub


'====== INIT CKsys
'Attach my event handler to onhelp event--pressing key F1
set document.onhelp = getref("CKsys_EventOnHelp")
'Attach my event handler for clicking on a element
set document.onclick = getref("CKsys_EventOnClick")


'Tester for ability to call subs in this "module" from events attached to BODY elem.
public sub CKsys_EventOnClick()
	dim sProcName
		sProcName = "CKsys_EventOnClick"
	dim sKeys
		sKeys = ""
	
	with window.event
		dim thisSrcElemTagname
			thisSrcElemTagname = lcase(.srcElement.tagName)
		dim blnShiftKey
			blnShiftKey = .shiftKey
		dim blnAltKey
			blnAltKey = .altKey
		dim blnCtrlKey
			blnCtrlKey = .ctrlKey
		dim nKeyCode
			nKeyCode = .keyCode
	end with
	
	if false then	'DEBUG--set to True
		CKs ""
		CKs "Element: " & thisSrcElemTagname
		if blnShiftKey then sKeys = sKeys & "Shift "
		if blnCtrlKey then sKeys = sKeys & "Ctrl "
		if blnAltKey then sKeys = sKeys & "Alt"
		CKs "Shift-state keys: " & sKeys
		CKs "Keycode: " & nKeyCode
		msgbox gsCKs, vbOK, sProcName
	end if
	
	'If Alt-click, then continue.
	if blnAltKey then
		msgbox "Alt key pressed."
		
		'Pass srcElement on to handler.
		
		'Disable further handling.
		window.event.returnValue = false
	end if
	
	'Let default action continue.
end sub


public sub CKsys_EventOnHelp()
'OnHelp fires on pressing F1.
'Trap Ctrl-F1 to init CKToolsWin
	dim sProcName
		sProcName = "CKsys_EventOnHelp"
	dim sKeys
		sKeys = ""		'init var
		
	with window.event
		dim blnShiftKey
			blnShiftKey = .shiftKey
		dim blnAltKey
			blnAltKey = .altKey
		dim blnCtrlKey
			blnCtrlKey = .ctrlKey
	end with
	
	if false then									'DEBUG
		CKs ""
		if blnShiftKey then sKeys = sKeys & "Shift "
		if blnCtrlKey then sKeys = sKeys & "Ctrl "
		if blnAltKey then sKeys = sKeys & "Alt"
		CKs "Shift-state keys: " & sKeys
		msgbox gsCKs, vbOK, sProcName
	end if
		
	'Activate CKTools
	if window.event.ctrlKey then
		msgbox "Init CKTools", vbOK, sProcName
		CKTools_WinShow
		
		'Cancel default IE Help action.
		window.event.returnValue = false
	end if
	
end sub

public sub CKTools_WinShow()
	dim sProcName
		sProcName = "CKTools_WinShow"
'	dim vArgs(5)					'Args passed to dialog box--could be array of oWin, etc.
	dim oThisWindow
	dim oWindowDialog
	
'	sURLvbs = left(sURLvbs,len(sURLvbs) - 4) & ".htm"
'	msgbox sURLvbs, vbok, sProcName

	'Reference to window containing the call to open CKTools.
	set oThisWindow = window
'	vArgs(0) = oThisWindow
'	msgbox oThisWindow.name
	set oWindowDialog = window.showModelessDialog(gsCKToolsWinURL ,oThisWindow,_
	"dialogHeight=400px;dialogLeft=800px;dialogTop=400px;dialogWidth=400px;center=no;help=no;resizable=no;status=yes;"_
	)
	
	CKmsg ""
	CKmsg "oWindowDialog.document.title=" & oWindowDialog.document.title
'	sMsg = sMsg & "vPaletteReturnValue.document=" & vPaletteReturnValue.document.frames.length & vbcrlf
'	sMsg = sMsg & "vPaletteReturnValue.document=" & vPaletteReturnValue.document.frames(1).gsFrame_SampleText_var01 & vbcrlf
	msgbox gsMsg, vbok, sProcName
	
end sub



public sub CKTools_StylesheetsReport()
	dim sProcname
		sProcname = "CKTools_StylesheetsReport"
	dim nSheet, nSheets
	dim sSheetName
	dim thisSheet
	dim thisRule
		
	CKs ""
	nSheets = document.stylesheets.length
	CKs "Number of stylesheets: " & nSheets
	for nSheet = 0 to nSheets - 1
		set thisSheet = document.stylesheets(nSheet)
		CKs "Stylesheet " & nSheet & "___________"
		sSheetID = thisSheet.id
		CKs "ID: " & sSheetID
		CKs "disabled: " & thisSheet.disabled
		CKs "readOnly: " & thisSheet.readOnly
		CKs "type: " & thisSheet.type
		set thisRule = thisSheet.Rules(0)
		CKs "rules(0).readOnly: " & thisRule.readOnly
		'CKs "rules(0).runtimeStyle: " & thisRule.runtimeStyle
		CKs "rules(0).selectorText: " & thisRule.selectorText
	next 
	msgbox gsCKs, vbOK, sProcname
end sub	

public sub CKTools_OnClickStyleReport(oSrcElem)
	dim sProcName
		sProcName = "OnClickStyleReport"
		
	CKs ""
	CKs "OnClick srcElement:" & oSrcElem.tagName
	CKs "runtimeStyle____________________"
	CKs "cssText:" & oSrcElem.runtimeStyle.cssText
	CKs "currentStyle____________________"
	'CKs oSrcElement.currentStyle.cssText
	CKs "style___________________________"
	CKs "cssText:" & oSrcElem.style.cssText
	msgbox gsCKs, vbOK, sProcname	
end sub




'====================================== UTILITY
'Generic string assembler for msgbox reports.
' Use [CKs ""] to reset the string gsCKs
Public Sub CKs(sThis)
    If sThis = "" Then
        gsCKs = ""
    Else
        gsCKs = gsCKs & sThis & vbCrLf
    End If
End Sub

'Another string assembler for msgbox reports.
' Use [CKmsg ""] to reset the string gsMsg
public sub CKmsg(sThis)
    If sThis = "" Then
        gsMsg = ""
    Else
        gsMsg = gsMsg & sThis & vbCrLf
    End If
end sub