Dim oFPExec, sFPFilleName, bFPShowResult

gsAppName = "Orisales"

function max(a, b)
	if a > b then
		max = a
	else
		max = b
	end if
end function

function min(a, b)
	if a < b then
		min = a
	else
		min = b
	end if
end function

function IIf(cond, a, b)
	if cond then
		IIf = a
	else
		IIf = b
	end if
end function

Function Nvl(v,nv)
	Nvl = iif(isnull(v),nv,v.Value)
End Function

Function Nvl2(v,nv)
	Nvl2 = iif(isnull(v),nv,v)
End Function

sub SetVisibility(ctrl, bVisible)
	SetVisibilityEx ctrl, bVisible, bVisible
end sub

sub SetVisibilityEx(ctrl, bVisible, bEnabled)
	ctrl.style.display = IIf(bVisible, "inline", "none")
	'ctrl.style.visibility = IIf(bVisible, "visible", "hidden")
	ctrl.disabled = not bEnabled
end sub

function GetPickerDate(ctrl)
	if IsDate(ctrl.Value) then 
		GetPickerDate = CStr(CDate(Int(ctrl.Value)))
	else
		GetPickerDate = ""
	end if
end function

function GetPickerDateTime(ctrl)
	if IsDate(ctrl.Value) then 
		GetPickerDateTime = CStr(CDate(ctrl.Value))
	else
		GetPickerDateTime = ""
	end if
end function

function FormatMsg(msg, params)
	dim i
	if IsArray(params) then 
		for i = 0 to UBound(params)
			msg = Replace(msg, "%" & (i + 1), params(i))
		next
	else
		msg = Replace(msg, "%1", params)
	end if
	FormatMsg = msg
end function

function OriMsg(msg)
	OriMsg = MsgBox(msg, , gsAppName)
end function

function OriMsgP(msg, params)
	OriMsgP = MsgBox(FormatMsg(msg, params), , gsAppName)
end function

function OriMsgB(msg, buttons)
	OriMsgB = MsgBox(msg, buttons, gsAppName)
end function

function OriMsgPB(msg, params, buttons)
	OriMsgPB = MsgBox(FormatMsg(msg, params), buttons, gsAppName)
end function

function OriInputBox(msg)
	OriInputBox = InputBox(msg, gsAppName)
end function

function OriInputBoxP(msg, params)
	OriInputBoxP = InputBox(FormatMsg(msg, params), gsAppName)
end function

function OriInputBoxD(msg, default)
	OriInputBoxD = InputBox(msg, gsAppName, default)
end function

function OriInputBoxPD(msg, params, default)
	OriInputBoxPD = InputBox(FormatMsg(msg, params), gsAppName, default)
end function

function GetUrlParams(params, values)
	dim sParams
	sParams = ""
	for i = LBound(params) to UBound(params)
		if sParams <> "" then sParams = sParams & "&"
		sParams = sParams & params(i) & "=" & ToUrlSafe(values(i))
	next
	GetUrlParams = sParams
end function

function ToUrlSafe(value)
	value = Replace(value,"%","%25")
	value = Replace(value,"+","%20")
	value = Replace(value,"/","%2F")
	value = Replace(value,"?","%3F")
	value = Replace(value,"#","%23")
	value = Replace(value,"&","%26")
	ToUrlSafe = value
end function

function OpenNewWnd(url, bScrollBars)
	set OpenNewWnd = window.open(url, "_blank", _
		"menubar=no,location=no,toolbar=no,status=yes,resizable=yes,scrollbars=" & _
		IIf(bScrollBars,"yes","no"))
end function

function OpenNewWndEx(url, bScrollBars, width, height)
	set OpenNewWndEx = window.open(url, "_blank", _
		"menubar=no,location=no,toolbar=no,status=yes,resizable=yes,scrollbars=" & _
		IIf(bScrollBars,"yes","no") & _
		",width=" & width & ",height=" & height)
end function

function OpenNewWndEx2(url, bScrollBars, width, height, name)
	set OpenNewWndEx2 = window.open(url, name, _
		"menubar=no,location=no,toolbar=no,status=yes,resizable=yes,scrollbars=" & _
		IIf(bScrollBars,"yes","no") & _
		",width=" & width & ",height=" & height)
end function

function GetDlgFeatures(width, height)
	GetDlgFeatures = GetDlgFeaturesEx(width, height, "no")
end function

function GetDlgFeaturesEx(width, height, status)
	dim sDlgFeatures
	sDlgFeatures = "dialogWidth: " & width & "px; dialogHeight: " & height & "px; "
	sDlgFeatures = sDlgFeatures & "scroll:no; resizable:yes; help:no; status:" & status & ";"
	GetDlgFeaturesEx = sDlgFeatures
end function

sub DisableAllControls(sDisabledCaption)
	dim sId
	for each obj in document.all.tags("INPUT")
		sId = obj.id
		if sId <> "btnCancel" and sId <> "btnClose" and Left(sId,8) <> "propPage" then
			obj.disabled = true
		end if
	next
	for each obj in document.all.tags("SELECT")
		obj.disabled = true
	next
	for each obj in document.all.tags("TEXTAREA")
		obj.disabled = true
	next
	for each obj in document.all.tags("OBJECT")
		select case obj.classid
		case "clsid:D76D712E-4A96-11D3-BD95-D296DC2DD072", "clsid:D76D7126-4A96-11D3-BD95-D296DC2DD072"
			'Object VSFlexGrid
			obj.Enabled = false
		case "clsid:20DD1B9E-87C4-11D1-8BE3-0000F8754DA1"
			'Object DateTimePicker
			obj.Enabled = false
		end select
	next
	for each obj in document.all.tags("DIV")
		if obj.classname = "dlgcaption" then
            if InStr(obj.innerText, " - " & sDisabledCaption) <= 0 then
			    obj.innerText = obj.innerText & " - " & sDisabledCaption
            end if
		end if
	next
end sub

sub DisableControl(obj)
	if not IsObject(obj) then exit sub
	select case UCase(obj.tagName)
		case "INPUT", "SELECT", "TEXTAREA":
			obj.disabled = true
		case "OBJECT":
			obj.Enabled = false
	end select
end sub

sub EnableAllControls(sEnabledCaption)
	dim sId
	for each obj in document.all.tags("INPUT")
		sId = obj.id
		if sId <> "btnCancel" and sId <> "btnClose" and Left(sId,8) <> "propPage" then
			obj.disabled = false
		end if
	next
	for each obj in document.all.tags("SELECT")
		obj.disabled = false
	next
	for each obj in document.all.tags("TEXTAREA")
		obj.disabled = false
	next
	for each obj in document.all.tags("OBJECT")
		select case obj.classid
		case "clsid:D76D712E-4A96-11D3-BD95-D296DC2DD072", "clsid:D76D7126-4A96-11D3-BD95-D296DC2DD072"
			'Object VSFlexGrid
			obj.Enabled = true
		case "clsid:20DD1B9E-87C4-11D1-8BE3-0000F8754DA1"
			'Object DateTimePicker
			obj.Enabled = true
		end select
	next
	for each obj in document.all.tags("DIV")
		if obj.classname = "dlgcaption" then
            if InStr(obj.innerText, " - " & sEnabledCaption) <= 0 then
			    obj.innerText = obj.innerText & " - " & sEnabledCaption
            end if
		end if
	next
end sub

function GetPath2(path)
	dim arr
	arr = split(window.location.href, "/", 5, 1)
	GetPath2 = arr(0) & "//" & arr(2) & "/" & arr(3) & "/" & path
end function

function DistributorDlg()
	DistributorDlg = DistributorDlgDef(Empty)
end function

function DistributorDlgDef(nDefDistId)
	Dim nDistId, url
	if IsNumeric(nDefDistId) then
		if nDefDistId <= 0 then nDefDistId = Empty
	end if
	url = GetPath2("Distributor/Distributor.asp") & "?Dlg=1&distId=" & nDefDistId
	nDistId = window.showModalDialog(url, , GetDlgFeatures(430,460))
	if IsEmpty(nDistId) or IsNull(nDistId) then nDistId = 0
	DistributorDlgDef = nDistId
end function

sub SetFrameDistId(nDistId)
	if not parent Is Me then
		if nDistId <> -1 then
			parent.frmMenu.nDistId = nDistId
			parent.frmDistributor.Distributor.value = nDistId
		else
			parent.frmMenu.nDistId = ""
			parent.frmDistributor.Distributor.value = ""
		end if
	elseif not IsEmpty(opener) then
		if nDistId <> -1 then
			opener.parent.frmMenu.nDistId = nDistId
			opener.parent.frmDistributor.Distributor.value = nDistId
		else
			opener.parent.frmMenu.nDistId = ""
			opener.parent.frmDistributor.Distributor.value = ""
		end if
	end if
end sub

function UserDlg()
	Dim nUserId, url
	url = GetPath2("common/User.asp") & "?Dlg=1"
	nUserId = window.showModalDialog(url, , GetDlgFeatures(300, 200))
	if IsEmpty(nUserId) or IsNull(nUserId) then nUserId = 0
	UserDlg = nUserId
end function

function CheckUserPassword(nUserId)
	Dim url, nUser
	url = GetPath2("common/User.asp") & "?Dlg=1"
	nUser = window.showModalDialog(url, Array(nUserId), GetDlgFeatures(300, 200))
	if IsEmpty(nUser) or IsNull(nUser) then nUser = 0
	CheckUserPassword = (nUser > 0)
end function

function OrderDlg()
	Dim  nWarder
	nWarder = window.showModalDialog(GetPath2("Orders/OrderNum.asp"), , GetDlgFeatures(300, 160))
	if IsEmpty(nWarder) or IsNull(nWarder) then nWarder = 0
	OrderDlg = nWarder
end function

sub BackOrClose
	if window.history.length > 0 then
		window.history.back
	else
		window.close
	end if
end sub

sub CancelOrClose
	Dim wndMain, wndApp, wndAct, bLoop, urlWelcome
	set wndAct = window
	bLoop = true
	while bLoop
		if not wndAct.frameElement is Nothing then
			if wndAct.frameElement.id = "frmMain" then set wndMain = wndAct
		end if
		
		if wndAct.frames.length > 0 then
			if wndAct.frames(0).frameElement.id = "frmToolBar" then set wndApp = wndAct
		end if
		bLoop = not wndAct.parent is wndAct
		set wndAct = wndAct.parent
	wend
	
	if IsObject(wndApp) then
		urlWelcome = GetPath2("welcome.asp")
		if IsObject(wndMain) then
			wndMain.navigate urlWelcome
		else
			if wndApp.frmMain.location.href <> urlWelcome then wndApp.frmMain.navigate urlWelcome
			wndApp.frmMenu.ShowFrame 2
		end if
	else
		wndAct.close
	end if
end sub

sub CancelOrCloseQ(sQuestion,bAsk)
	if bAsk then
		if OriMsgB(sQuestion,vbYesNo + vbQuestion) = vbNo then
			exit sub
		end if
	end if
	CancelOrClose
end sub

sub CancelOrCloseQN(sQuestion,bAsk)
	if bAsk then
		if OriMsgB(sQuestion,vbYesNo + vbQuestion + vbDefaultButton2) = vbNo then
			exit sub
		end if
	end if
	CancelOrClose
end sub

function DoFormatNumber(n)
	Dim sNum, sCurrSymbol
    if IsNumeric(n) then
        sNum = FormatCurrency(n)

        ' Remove currency symbol
        sCurrSymbol = FormatCurrency(0, 0, 0)
        sNum = Replace(sNum, sCurrSymbol, "")
		
        if CDbl(n) = CDbl(sNum) then
            DoFormatNumber = sNum
		else
			DoFormatNumber = n
		end if
	else
		DoFormatNumber = n
	end if
end function

sub ReformatNumbers()
	Dim ctrl
	for each ctrl in document.all.tags("INPUT")
		if ctrl.className = "money" then
			ctrl.value = DoFormatNumber(ctrl.value)
			if ctrl.id = "txtPaysTotal" then
				ctrl.select()
			end if
		end if
	next
end sub

sub ReformatNumCtrls(arrCtrl)
	Dim i
	for i = LBound(arrCtrl) to UBound(arrCtrl)
		arrCtrl(i).value = DoFormatNumber(arrCtrl(i).value)
	next
end sub

'function returns path to file on server in the format usable for opening file from client script
function GetCustomFileFromClient (astrFilename, country)
dim strFullPath
dim fso2

set fso2 = CreateObject("Scripting.FileSystemObject")

If Country <> "" And Country <> "." Then
	strFullPath =  "%APPL_PHYSICAL_PATH%/Custom/" & country & "/"
	strFullPath = Replace(strFullPath,"%APPL_PHYSICAL_PATH%/", GetPath("")) & astrFilename
	strFullPath = Replace(strFullPath, "\", "/")		
'    msgbox(strfullpath)
    'If fso2.FileExists(strFullPath) Then
		'path to file in custom folder is returned
		GetCustomFileFromClient = strfullpath
    'else 
		'if file is not found in custom folder, general path is returned
		'strFullPath =  "%APPL_PHYSICAL_PATH%\" 
		'strFullPath = Replace(strFullPath,"%APPL_PHYSICAL_PATH%\", GetPath("")) & astrFilename        
		'GetCustomFileFromClient = -1
    'End If
End If

end function

function FormatDate(dDate, sFormat)
	'Functions returns formated string or "" if dDate is not date
	'For date 5-jan-2004 replace in sFormat:
	'dd		  05
	'd		   5
	'mm		  01
	'm		   1
	'yyyy	2004
	'yy		  04

dim value
	FormatDate = ""
	if not IsDate(dDate) then
		exit function
	end if
	value = sFormat
	value = Replace(value, "yyyy", CStr(Year(dDate)))
	value = Replace(value, "yy", Right(CStr(Year(dDate)), 2))
	value = Replace(value, "mm", Right("0" & CStr(Month(dDate)), 2))
	value = Replace(value, "m", CStr(Month(dDate)))
	value = Replace(value, "dd", Right("0" & CStr(Day(dDate)), 2))
	value = Replace(value, "d", CStr(Day(dDate)))
	value = Replace(value, "HH", Right("0" & CStr(Hour(dDate)), 2))
	value = Replace(value, "MM", Right("0" & CStr(Minute(dDate)), 2))
	value = Replace(value, "SS", Right("0" & CStr(Second(dDate)), 2))
	FormatDate = value
end function

function FormatFileName(sFileName, nOrderNum, nWareId, nDistId)
	dim nLen, n
	if InStr(sFileName, "%order%") > 0 then
		sFileName = Replace(sFileName, "%order%", CLng(nOrderNum)+CLng(100000000)*CLng(nWareId))
	end if
	n = InStr(sFileName, "%dist")
	if n > 0 then
		nLen = CLng(Mid(sFileName, n+5, 1))
		sFileName = Replace(sFileName, "%dist" & nLen & "%", String(nLen-Len(nDistId), "0") & nDistId)
	end if
	FormatFileName = sFileName
end function

function FormatInvoiceFileName(sFileName, nOrderNum, nWareId, sInvoNum, nDistId)
    sFileName = FormatFileName(sFileName, nOrderNum, nWareId, nDistId)
	if InStr(sFileName, "%invoice%") > 0 then
		sFileName = Replace(sFileName, "%invoice%", sInvoNum)
	end if
	FormatInvoiceFileName = sFileName
end function

function FormatFileNameEx(sFileName, nOrderNum, nWareId, nDistId, sWaybillNum)
    sFileName = FormatFileName(sFileName, nOrderNum, nWareId, nDistId)
	if InStr(sFileName, "%waybill%") > 0 then
		sFileName = Replace(sFileName, "%waybill%", sWaybillNum)
	end if
	FormatFileNameEx = sFileName
end function

function FormatFileNameTC(sFileName, nOrderNum, nWareId, nDistId, nTaxCode)
    sFileName = FormatFileName(sFileName, nOrderNum, nWareId, nDistId)
	if InStr(sFileName, "%taxcode%") > 0 then
		sFileName = Replace(sFileName, "%taxcode%", "_" & nTaxCode)
	end if
	FormatFileNameTC = sFileName
end function

sub PrintStreamEx2(oStream, sFileName, bOverwrite, nCopies)
	Dim fso, tfolder, tname, s, prn, port, i
	Dim oConn, bUseTmp
	
    s = UCase(Left(sFileName, 3))
    
    'Client CR and PDF printing:
    if TypeName(oStream) = "DOMDocument" or TypeName(oStream) = "IXMLDOMDocument2" then
        Dim sRptFile, arrRS, arrParam, url, res, xmldom, sRptUrl, oReport
        Dim sPdfUrl, arrPdfUrl, j
        
        set xmldom = oStream

        if not xmldom.selectSingleNode("//report/rptFile") is nothing then
            ' CrystalReports
            ' Print functions return an XML file containig rpt file path, recordsets array and parameters array
            ' see OrisalesReports.TestReport.PrintClientRep
            sRptUrl = xmldom.selectSingleNode("//report/rptFile").Text
            sRptFile = GetRptFile(sRptUrl)
            arrRS = UnmarshalArray(xmldom.selectSingleNode("//report/arrRS"))
            arrParam = UnmarshalArray(xmldom.selectSingleNode("//report/arrParams"))
            set xmldom = Nothing

            set oReport = OpenReport(sRptFile, arrRS, arrParam)

            ' multiple copies set parameter "Copy" if available
            Dim nCopyParam
            nCopyParam = 0
            For i = 1 To oReport.ParameterFields.Count
                if oReport.ParameterFields.Item(i).Name = "{?Copy}" then 
                    nCopyParam = i
                    call oReport.ParameterFields.Item(nCopyParam).SetCurrentValue((1))
                    exit for
                end if
            Next
        
            if s = "PDF" then
                prn = ""
                port = Mid(sFileName,5)

                Dim eo
                set eo = oReport.ExportOptions
                eo.FormatType = 31 'crEFTPortableDocFormat
                eo.PDFExportAllPages = True
                if port <> "" then 
                    eo.DestinationType = 1 'crEDTDiskFile
                    eo.DiskFileName = port
                    oReport.Export False
                else
                    i = InstrRev(sRptUrl, "/")
                    if i = 0 then i = InstrRev(sRptUrl, "\")
                    port = Replace(Mid(sRptUrl, i + 1), ".rpt", ".pdf")
                    eo.DestinationType = 5 'crEDTApplication
                    eo.ApplicationFileName = port
                    oReport.Export False
                end if
            elseif s = "LPT" or s = "PRN" or s = "PRW" or Mid(s,2) = ":\" then
                prn = "": port = ""
                if s = "PRW" then
                    prn = Mid(sFileName,5)
                else
                    port = sFileName
                end if
                url = GetPath2("Reports/CRViewer.asp") '& "?T=" & Now()
            
                for i = 1 to nCopies
                    if nCopyParam > 0 then call oReport.ParameterFields.Item(nCopyParam).SetCurrentValue((i))
                    res = window.showModalDialog(url, Array(oReport, prn, port, nCopies), GetDlgFeaturesEx(900, 800, 0))
                    if nCopyParam = 0 then exit for
                next
            elseif s = "NUL" then
                exit sub
            else
                ' Crystal 9 print problem: after SelectPrinter you have to set paper orientation
                Dim po
                po = oReport.PaperOrientation
                oReport.SelectPrinter "", sFileName, ""
                oReport.PaperOrientation = po

                for i = 1 to nCopies
                    if nCopyParam > 0 then call oReport.ParameterFields.Item(nCopyParam).SetCurrentValue((i))
                    oReport.PrintOut False
                next
            end if
        else
            ' Generated PDF
            ' Print functions return an XML file containig PDF file path
            ' see OrisalesReports.TestReport.PrintClientPdf
            sPdfUrl = xmldom.selectSingleNode("//report/pdfUrl").Text
            'To Split Multiple Url PDF for single order_number + ware_id
            arrPdfUrl = Split(sPdfUrl, "$@")
            for j = LBound(arrPdfUrl) to UBound(arrPdfUrl)
                if s = "PRW" then
                    ' preview
                    OpenNewWnd arrPdfUrl(j), true
                elseif s = "NUL" then
                    exit sub
                else
                    prn = sFileName ' localy installed printing driver (e.g. CanonC1028i on dcosw2)
                    PrintPdf arrPdfUrl(j), prn
                end if
            next
        end if
        set oReport = Nothing
    else
        if oStream.Size = 0 then exit sub
	    bUseTmp = (Left(s, 2) = "\\" or s = "LPT" or s = "PRN")
    	
	    if bUseTmp then
		    Const TemporaryFolder = 2
		    Set fso = CreateObject("Scripting.FileSystemObject")
		    Set tfolder = fso.GetSpecialFolder(TemporaryFolder)
		    tname = fso.BuildPath(tfolder.Path, fso.GetTempName)
'            If (not fso.FolderExists(sFileName)) Then
'              OriMsgB sFileName & " doesn't exist.", vbExclamation
'            End If
		    oStream.SaveToFile tname, 2
            for i = 1 to nCopies
                fso.CopyFile tname, sFileName, bOverwrite
            next
		    fso.DeleteFile tname
	    else		
            for i = 1 to nCopies
                oStream.SaveToFile sFileName, IIf(bOverwrite, 2, 1)
            next
	    end if
	end if
end sub

sub PrintPdf(sPdfUrl, sDriver)
    ' download file
    Dim xmlhttp
    set xmlhttp = CreateObject("Msxml2.XMLHTTP")
    xmlhttp.Open "GET", sPdfUrl, False
    xmlhttp.Send
    if xmlhttp.status <> 200 then
        alert "Error downloading " & sPdfUrl & vbNewLine & xmlhttp.statusText
        exit sub
    end if
    
    Const TemporaryFolder = 2
    Dim fso, tfolder, tname, oStream, oWsh    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set tfolder = fso.GetSpecialFolder(TemporaryFolder)
	tname = tfolder.Path & Replace(fso.GetTempName, ".tmp", ".pdf")
    
	set oStream = CreateObject("ADODB.Stream")
	oStream.Type = 1 'adTypeBinary
	oStream.Open()
	if not IsEmpty(xmlhttp.ResponseBody) then
	    oStream.Write xmlhttp.ResponseBody
    end if
    oStream.SaveToFile tname, 2 'adSaveCreateOverWrite

    ' send to printer
    Const WindowStyle = 7    ' Displays the window as a minimized window. The active window remains active.
    set oWsh = CreateObject("Wscript.Shell")
    on error resume next
    oWsh.Run "AcroRd32.exe /h /s /o /t " & tname & " """ & sDriver & """", WindowStyle, false
    oWsh.Run "Acrobat.exe /h /s /o /t " & tname & " """ & sDriver & """", WindowStyle, false
    on error goto 0
    ' delete file
    'DP: 30s is still not enough and files are removed before they are sent to a printer
    'window.setTimeout "AsyncDelete('" & tname & "')", 30000
end sub

sub AsyncDelete(fileName)
    Dim fso
    on error resume next
        Set fso = CreateObject("Scripting.FileSystemObject")
	    fso.DeleteFile fileName
    on error goto 0
end sub

sub PrintStream(oStream, sFileName)
	PrintStreamEx oStream, sFileName, true
end sub

sub PrintStreamEx(oStream, sFileName, bOverwrite)
	PrintStreamEx2 oStream, sFileName, bOverwrite, 1
end sub

sub PrintFiscalDocEx(sCommand, sFileName, bShowResult, bDeleteFile)
	Dim WshShell
	Set WshShell = CreateObject("WScript.Shell")

	Set oFPExec = WshShell.Exec(Replace(sCommand, "%1", sFileName))
	
	if bShowResult or bDeleteFile then
		bFPShowResult = bShowResult
		sFPFilleName = iif(bDeleteFile, sFileName, "")
		window.setTimeout GetRef("FPCleanup"), 1000, "VBScript"
	end if
end sub

sub PrintFiscalDoc(sCommand, oStream, bShowResult)
	Dim fso, tfolder, tname
	Const TemporaryFolder = 2
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set tfolder = fso.GetSpecialFolder(TemporaryFolder)
	tname = tfolder.Path & fso.GetTempName    
	oStream.SaveToFile tname, 2
	
	PrintFiscalDocEx sCommand, tname, bShowResult, true
end sub

sub FPCleanup()
	Dim sResult
	if oFPExec.Status = 0 then 
		window.setTimeout GetRef("FPCleanup"), 200, "VBScript"
	end if
	
	if sFPFilleName <> "" then
		Dim fso
		Set fso = CreateObject("Scripting.FileSystemObject")
		fso.DeleteFile sFPFilleName
		sFPFilleName = ""
	end if
	
	if bFPShowResult then
		sResult = ""
	
		If Not oFPExec.StdOut.AtEndOfStream Then
			sResult = oFPExec.StdOut.ReadAll
		End If

		If Not oFPExec.StdErr.AtEndOfStream Then
			if sResult <> "" then sResult = sResult & vbCrLf
			sResult = sResult & "STDERR: " & oFPExec.StdErr.ReadAll
		End If
	
		if sResult <> "" then 
			OriMsg sResult
		end if
	end if	
end sub

'*** Creating objects to get rid of an activation ***
function CreateControl(sObjectID, sCLSID, sCodebase, nWidth, nHeight, sStyle, sOther, sParams)
	dim d, s

	s = "<OBJECT classid=""clsid:" & sCLSID & """ id=" & sObjectID

	if sCodebase <> "" then
		s = s & " codebase=""" & sCodebase & """"
	end if
	
	if nWidth > 0 or nHeight > 0 then
		s = s & " width=" & nWidth & " height=" & nHeight
	end if
	
	if sStyle <> "" then 
		s = s &  " style=""" & sStyle & """"
	end if
	
	if sOther <> "" then
		s = s & " " & sOther
	end if
	
	s = s & ">" & sParams & "</OBJECT>"

	set d = document.getElementById(sObjectID & "_DIV")
	d.outerHTML = s
	CreateControl = s
end function

Public Function URLEncode(sURL)
    Dim x 
    Dim sResult 
    Dim sTmp 

    sResult = ""
    
    If Len(sURL) > 0 Then
        For x = 1 To Len(sURL)
            sTmp = Mid(sURL, x, 1)

            if (Asc(sTmp) < 48 Or Asc(sTmp) > 126) Or (Asc(sTmp) > 57 And Asc(sTmp) < 65) then
                sTmp = Hex(Asc(sTmp))

                If sTmp = "20" Then
                    sTmp = "+"
                ElseIf Len(sTmp) = 1 Then
                    sTmp = "%0" & sTmp
                Else
                    sTmp = "%" & sTmp
                End If
            End If
            sResult = sResult & sTmp
        Next
    End If
    
    URLEncode = sResult
End Function

' Set focus and if needed then select it
Sub SetFocus(ctrl, bSelect)
    on error resume next
        ctrl.focus()
        if bSelect then ctrl.select()
    on error goto 0
end sub

' Enable/disable the control
Sub SetControl(ctrl, bEnabled)
    on error resume next
        ctrl.disabled = not bEnabled
        ctrl.enabled = bEnabled ' it is used by the DateTimePicker
    on error goto 0
end sub

' Enable/disable the control with all its childs
Sub SetControls(ctrl, bEnabled)
    Dim i

    SetControl ctrl, bEnabled
    
    if ctrl.childNodes.length > 0 then
        for i = 0 to ctrl.childNodes.length - 1
            SetControls ctrl.childNodes(i), bEnabled
        next
    end if
end sub

Private Function AssignRS(oReport, arrRecordsets, n)
    Dim i
    If IsArray(arrRecordsets) Then
        'Set recordsets for main report
        For i = 1 To oReport.Database.Tables.Count
            if n <= UBound(arrRecordsets) then
                oReport.Database.Tables.Item(i).SetDataSource arrRecordsets(n)
                n = n + 1
            end if
        Next
        
        'Iterate through subreports
        Dim oSection, oRepObj
        For Each oSection In oReport.Sections
            For Each oRepObj In oSection.ReportObjects
                If oRepObj.Kind = 5 Then 'crSubreportObject
                    n = AssignRS(oRepObj.OpenSubreport, arrRecordsets, n)
                End If 
            Next
        Next
    End If
    
    AssignRS = n
End Function

Private Function AssignParams(oReport, arrParams, n)
    Dim i
    If IsArray(arrParams) Then
        'Set recordsets for main report
        For i = 1 To oReport.ParameterFields.Count
            if n <= UBound(arrParams) then
                 call oReport.ParameterFields.Item(i).SetCurrentValue((arrParams(n)))
                 n = n + 1
            end if
        Next
        
        'Iterate through subreports
        Dim oSection, oRepObj
        For Each oSection In oReport.Sections
            For Each oRepObj In oSection.ReportObjects
                If oRepObj.Kind = 5 Then 'crSubreportObject
                    n = AssignParams(oRepObj.OpenSubreport, arrParams, n)
                End If 
            Next
        Next
    End If
    
    AssignParams = n
End Function

Function OpenReport(sRptFile, arrRecordsets, arrParams)
    Dim oApp, oReport
    Set oApp = CreateObject("CrystalRuntime.Application")
    Set oReport = oApp.OpenReport(sRptFile, 1)

    oReport.DiscardSavedData
    oReport.EnableParameterPrompting = False

    AssignRS oReport, arrRecordsets, 0
    AssignParams oReport, arrParams, 0

    Set OpenReport = oReport
End Function

Function GetRptFile(sRptFile)
    Dim sRepUrl
    sRepUrl = GetPath(sRptFile)
    
    Dim xmlhttp
    set xmlhttp = CreateObject("Msxml2.XMLHTTP")
    xmlhttp.Open "GET", sRepUrl, False
    xmlhttp.Send
    if xmlhttp.status <> 200 then
        alert "Error downloading " & sRptFile & vbNewLine & xmlhttp.statusText
        exit function
    end if
    
    Dim fso, tfolder, oStream, sBaseFileName
    
    Const TemporaryFolder = 2
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set tfolder = fso.GetSpecialFolder(TemporaryFolder)
    sBaseFileName = tfolder.Path & "\" & Replace(sRptFile, "/", "_")
    GetRptFile = Replace(sBaseFileName, ".rpt", "_" & _
        Replace(Replace(Replace( _
            xmlhttp.getResponseHeader("Last-Modified"), _
            ",", ""), _
            " ", "_"), _
            ":", "_") _
         ) & ".rpt"
    
    if not fso.FileExists(GetRptFile) then
        on error resume next
        fso.DeleteFile Replace(sBaseFileName, ".rpt", "*.rpt"), True
        on error goto 0
        
	    set oStream = CreateObject("ADODB.Stream")
	    oStream.Type = 1 'adTypeBinary
	    oStream.Open()
	    if not IsEmpty(xmlhttp.ResponseBody) then
	        oStream.Write xmlhttp.ResponseBody
        end if
        oStream.SaveToFile GetRptFile, 2 'adSaveCreateOverWrite
    end if
End Function

Public Function CopyRecordInRS(rsTo, rsFrom)
    Dim i
    For i = 0 To Min(rsTo.Fields.count, rsFrom.Fields.count) - 1
        rsTo(i).value = rsFrom(i).value
    Next

    set CopyRecordInRS = rsTo
End Function

Public Function AppendRecordsInRS(rsTo, rsFrom)
    if not rsFrom is Nothing then
        If Not (rsFrom.BOF And rsFrom.EOF) Then
            rsFrom.MoveFirst
            While Not rsFrom.EOF
                rsTo.AddNew
                CopyRecordInRS rsTo, rsFrom
                rsFrom.MoveNext
            Wend
        End If
    end if

    set AppendRecordsInRS = rsTo
End Function

Function CopyFieldsInRS(rs)
    Dim fld, i 
    Dim nFldType, nDefinedSize, nPrecision, nNumericScale
    Set CopyFieldsInRS = CreateObject("ADODB.Recordset")

    For i = 0 To rs.Fields.count - 1
        Set fld = rs.Fields(i)
        nFldType = fld.Type
        nDefinedSize = fld.DefinedSize
        nPrecision = fld.Precision
        nNumericScale = fld.NumericScale
'        Select Case nFldType
'        Case adNumeric, adDecimal:
'            If nPrecision <= 9 And nNumericScale = 0 Then
'                nFldType = adInteger
'            Else
'                nFldType = adDouble
'            End If
'            nDefinedSize = 0
'            nPrecision = 0
'            nNumericScale = 0
'        Case adVarNumeric:
'            nFldType = adDouble
'            nDefinedSize = 0
'            nPrecision = 0
'            nNumericScale = 0
'        Case adChar:
'            nFldType = adVarChar
'            nDefinedSize = 255
'            nPrecision = 0
'            nNumericScale = 0
'        Case adWChar:
'            nFldType = adVarWChar
'            nDefinedSize = 255
'            nPrecision = 0
'            nNumericScale = 0
''        Case adVarChar, adVarWChar:
''            nFldType = adBSTR
''            nDefinedSize = 0
''            nPrecision = 0
''            nNumericScale = 0
'        Case adDBDate, adDBTime, adDBTimeStamp:
'            nFldType = adDate
'            nDefinedSize = 0
'            nPrecision = 0
'            nNumericScale = 0
'        End Select
'        
        CopyFieldsInRS.Fields.Append fld.name, nFldType, nDefinedSize, fld.Attributes
        With CopyFieldsInRS.Fields(i)
            .Precision = nPrecision
            .NumericScale = nNumericScale
            .Attributes = fld.Attributes And adFldUpdatable
        End With
    Next
End Function

' vnSize = -1 .... ignore it
Function AppendColumnInRS(rs, vsName, vnType, vnSize)
    Dim rsNew
    Dim i, j

    if not rs is nothing then
        ' Copy columns
        Set rsNew = CopyFieldsInRS(rs)
                
        if not IsArray(vsName) and not IsArray(vnType) and not IsArray(vnSize) then
            vsName = Array(vsName)
            vnType = Array(vnType)
            vnSize = Array(vnSize)
        end if

        for i = max(LBound(vsName), max(LBound(vnType), LBound(vnSize))) to min(UBound(vsName), min(UBound(vnType), UBound(vnSize)))
            ' Append column
            if vnSize(i) = -1 then
                rsNew.Fields.Append vsName(i), vnType(i)
            else
                rsNew.Fields.Append vsName(i), vnType(i), vnSize(i)
            end if
        next

        ' Copy data
        rsNew.Open
        if not (rs.BOF and rs.EOF) then
            while not rs.EOF
                rsNew.AddNew
                For j = 0 To rs.Fields.count - 1
                    rsNew(j).value = rs(j).value
                Next

                rs.MoveNext
            wend
        end if        
    end if

    set AppendColumnInRS = rsNew
end function

Public Function HexColor2RGB(HexColor)
'The input at this point could be HexColor = "#00FF1F"
'The output is an RGB value

    Dim Red, Green, Blue
    HexColor = Replace(HexColor, "#", "")
    Red = CLng("&H" & Mid(HexColor, 1, 2)) 
    Green = CLng("&H" & Mid(HexColor, 3, 2))
    Blue = CLng("&H" & Mid(HexColor, 5, 2))

    HexColor2RGB = RGB(Red, Green, Blue)
End Function

'************* Open Save Common Dialog **************************

'comDlg object should be defined on page together with licinfo 
'because CreateObject throws license error

'<OBJECT CLASSID="clsid:5220cb21-c88d-11cf-b347-00aa00a28331" id=objLicInfo>
'   <PARAM NAME="LPKPath" VALUE="Components/Orisales.LPK" VIEWASTEXT>
'</OBJECT>
'<OBJECT	classid=clsid:F9043C85-F6F2-101A-A3C9-08002B2F49FB id=comDlg
'		codebase="Components/ComDlg32.cab#Version=6.1.97.82" VIEWASTEXT>
'</OBJECT>

function GetOpenSaveFileName(bOpen, sFilter, sDefExt, sInitDir)
	dim objCD, sPath

	Const OFN_ALLOWMULTISELECT   = &H200
	Const OFN_CREATEPROMPT       = &H2000
	Const OFN_EXPLORER           = &H80000
	Const OFN_EXTENSIONDIFFERENT = &H400
	Const OFN_FILEMUSTEXIST      = &H1000
	Const OFN_HIDEREADONLY       = &H4
	Const OFN_LONGNAMES          = &H200000
	Const OFN_NOCHANGEDIR        = &H8
	Const OFN_NODEREFERENCELINKS = &H100000
	Const OFN_OVERWRITEPROMPT    = &H2
	Const OFN_PATHMUSTEXIST      = &H800
	Const OFN_READONLY           = &H1

	on error resume next
  
    set objCD = CreateObject("MSComDlg.CommonDialog")

    if Err.number <> 0 then
        OriMsgB "Error " & Err.Number & ": " & Err.Description, vbExclamation
        exit function
    end if
	objCD.MaxFileSize = 256
    if sInitDir <> "" then
	    objCD.InitDir = sInitDir
    end if
	objCD.Filter = sFilter
    if sDefExt <> "" then
        if substr(sDefExt, 1, 1) <> "" then sDefExt = "." & sDefExt
        objCD.DefaultExt = sDefExt
    end if
	objCD.CancelError = true
	objCD.FilterIndex = nLastFilter
	objCD.Flags = OFN_FILEMUSTEXIST + OFN_LONGNAMES + OFN_PATHMUSTEXIST + OFN_EXPLORER
	
    on error resume next
	if bOpen then 
        objCD.ShowOpen
    else
        objCD.ShowSave
    end if

	if Err.number = 32755 then		    ' cancel
		sPath = ""
	elseif Err.number = 20476 then		' file size over the max limit
		sPath = ""
		OriMsgB "File name (path) is too long.", vbExclamation
	elseif Err.number = 0 then
		sPath = objCD.FileName
		sLastDir = sPath
		nLastFilter = objCD.FilterIndex
    else
        OriMsgB "Error " & Err.Number & ": " & Err.Description, vbExclamation
        exit function
	end if

	on error goto 0
	set objCD = nothing
	GetOpenSaveFileName = sPath
end function

function GetOpenFileName(sFilter, sDefExt, sInitDir)
    GetOpenFileName = GetOpenSaveFileName(true, sFilter, sDefExt, sInitDir)
end function

function GetSaveFileName(sFilter, sDefExt, sInitDir)
    GetSaveFileName = GetOpenSaveFileName(false, sFilter, sDefExt, sInitDir)
end function

' *** SecurityCtx ***
dim oSecurityCtx
set oSecurityCtx = nothing

Class SecurityCtx
	Private Sub Class_Initialize()
        SID = -1
        CTX = ""
        on error resume next
        Dim oNetwork
        Set oNetwork = CreateObject("WScript.Network")
        UserName = oNetwork.UserDomain & "\" & oNetwork.UserName
        if Err.number <> 0 then
            UserName = ""
            Err.Clear()
        end if
	End Sub
	
	Public Sub Init(nSID, sSecurityCTX)
        SID = nSID
        CTX = sSecurityCTX
    End Sub

    public SID
    public CTX
    public UserName
End Class

sub InitSecurityCtx(nSID, sSecurityCTX)
    set oSecurityCtx = new SecurityCtx
    oSecurityCtx.Init nSID, sSecurityCTX
end sub

function CurrentSecurityCtx()
    set CurrentSecurityCtx = oSecurityCtx
end function

Function AsciiToString(sString)
       Dim sResult, x
       AsciiToString = ""
       If Len(sString)<5 Then Exit Function
       If Len(sString)=5 Then
              AsciiToString = ChrW(CInt(sString))
              Exit Function
       End If
       sResult = ""
       For x=1 To Len(sString) Step 5
              sResult = sResult & AsciiToString(Mid(sString, x, 5))
       Next
       AsciiToString = sResult
End Function

Function StringToAscii(sString)
       Dim sResult, x
       StringToAscii = ""
       If Len(sString)=0 Then Exit Function
       If Len(sString)=1 Then
              sResult = AscW(Mid(sString, 1, 1))
              StringToAscii = Left("00000", 5-Len(CStr(sResult))) & CStr(sResult)
              Exit Function
       End If
       sResult = ""
       For x=1 To Len(sString)
              sResult = sResult & StringToAscii(Mid(sString, x, 1))
       Next
       StringToAscii = sResult
End Function

function IsValueInArray(arr, value)
	Dim x     
	for x = LBound(arr) to UBound(arr)
		if arr(x) = value then
			IsValueInArray = true
			exit function
		end if		
	next
	
	IsValueInArray = false
end function