'-------------------------------------------------------
'
'	TPI - Trade Partners Informática Ltda
'	
'	Arquivo  : Functions.vbs
'	Data     : 14/11/2001
'	Descrição: Diversas funcoes para auxilo no cliente
'              Declaração das variaveis globais
'
'--------------------------------------------------------

' Declaração de constantes globais
Const g_Custom = 0
Const g_String = 1
Const g_Number = 2
Const g_Date   = 3

' Declaração de constantes para o objeto ADO
'
' Direction Type
Const g_adParamUnknown     = 0
Const g_adParamInput       = 1
Const g_adParamOutput      = 2
Const g_adParamInputOutput = 3
Const g_adParamReturnValue = 4
' Data Type
Const g_adBigInt           = 20
Const g_adBinary           = 128
Const g_adBoolean          = 11
Const g_adBSTR             = 8
Const g_adChapter          = 136
Const g_adChar             = 129
Const g_adCurrency         = 6
Const g_adDate             = 7
Const g_adDBDate           = 133
Const g_adDBTime           = 134
Const g_adDBTimeStamp      = 135
Const g_adDecimal          = 14
Const g_adDouble           = 5
Const g_adEmpty            = 0
Const g_adError            = 10
Const g_adFileTime         = 64
Const g_adGUID             = 72
Const g_adIDispatch        = 9
Const g_adInteger          = 3
Const g_adIUnknown         = 13
Const g_adLongVarBinary    = 205
Const g_adLongVarChar      = 201
Const g_adLongVarWChar     = 203
Const g_adNumeric          = 131
Const g_adPropVariant      = 138
Const g_adSingle           = 4
Const g_adSmallInt         = 2
Const g_adTinyInt          = 16
Const g_adUnsignedBigInt   = 21
Const g_adUnsignedInt      = 19
Const g_adUnsignedSmallInt = 18
Const g_adUnsignedTinyInt  = 17
Const g_adUserDefined      = 132
Const g_adVarBinary        = 204
Const g_adVarChar          = 200
Const g_adVariant          = 12
Const g_adVarNumeric       = 139
Const g_adVarWChar         = 202
Const g_adWChar            = 130

' Declaração de variaveis globais
Public g_sXMLError
Public g_FormParam
Public g_oScrollMenuObject
Public g_sScrollMenuDirection
Public g_nScrollMenuTimerID
Public g_nMenuHideTimerID
Public g_bMenuHide

' Declaração de objetos globais
Public DBConn
Public ServerVars
Public SQLWiz
Public Manager

' Verificacar a alteracao dos campos na tela
Public g_bUpdateFields

' Busca a referencia do formulario de header
Public g_oHeaderWindow

'--------------------------- Inicio das funções de auxilio -------------------------

'--Funcao IIf do VB
Function IIf(p_Condicao, p_True, p_False)

    If p_Condicao Then
        
        IIf = p_True
        
    Else
    
        IIf = p_False
        
    End If

End Function

'--Permite atualizar o frame atual
Function reloadPage()

    If MsgBox("Deseja atualizar pagina atual ?", vbYesNo + vbQuestion, "Atualizar pagina") = vbYes Then
        
        window.location.reload
        
    End If
    
    reloadPage = False
    
End Function

'--Nao permite selecionar os textos, exceto componentes INPUT e AREA
Function selText()
    
    If IsObject(window.document.activeElement) Then
        
        If Not window.document.activeElement Is Nothing Then
            
            If window.document.activeElement.tagName = "INPUT" Then
                
                If UCase(window.document.activeElement.type) = "TEXT" Then
                    
                    Exit Function

                ElseIf UCase(window.document.activeElement.type) = "PASSWORD" Then
                    
                    Exit Function

                End If
                
            ElseIf window.document.activeElement.tagName = "TEXTAREA" Then
                
                Exit Function
                
            End If
            
        End If
    
    End If
    
    window.event.cancelBubble = True
    
    window.event.returnValue = False
    
    selText = False
    
End Function

'-- Faz inicializacao do form no cliente 
Sub InitPage()
    On Error Resume Next

    divMsg.style.visibility = "hidden"
    divBody.style.visibility = "visible"
	g_blnUpdateFields = False
    ' Busca a referencia do form header
    '-----------------------------------------------
    Dim nDeep, oJan
    nDeep = 20
    Set oJan = window.parent
    
	If oJan.name="frmFormulario" Then
		'Não faz nada
    ElseIf oJan.name = "JanelaPrincipal" or oJan.name="frmPwd" Then
        Set g_oHeaderWindow = oJan.Frames("fraHeader")
	    g_oHeaderWindow.addJanela window
    Else
        Set oJan = oJan.opener
        Do Until oJan.name = "fraMain"
            Set oJan = oJan.opener
            nDeep = nDeep - 1
            If nDeep = 0 Then
                'MsgBox "Janela Header não encontrada"
                Exit Sub
            End If
        Loop
        Set g_oHeaderWindow = oJan.parent.Frames("fraHeader")
	    g_oHeaderWindow.addJanela window
    End If

    '-----------------------------------------------
    Form_Load()

End Sub

'-- Finaliza o form no cliente 
Function FinishPage()

    On Error Resume Next

    FinishPage=Form_UnLoad()

End Function

'-- Abre uma nova janela para formulario
Sub showForm(p_sPage, p_nWidth, p_nHeight, p_oParams)

    Dim nTop, nLeft, sJanela
	
	
    If IsObject(p_oParams) Then
        Set g_FormParam = p_oParams
    Else
        g_FormParam = p_oParams
    End If

	sJanela = ServerVars.getItem("CDPESSOAUSR") & p_sPage 
    sJanela = Replace(sJanela, ".", "")
    sJanela = Replace(sJanela, "/", "")
    sJanela = Replace(sJanela, "\", "")
    sJanela = Replace(sJanela, "?", "")
    sJanela = Replace(sJanela, "&", "")
	
    nTop  = Int((screen.height - 75 - p_nHeight) / 2)
    nLeft = Int((screen.width  - 10 - p_nWidth) / 2)

	p_sPage = "./" & p_sPage & "?Rnd=" & Day(Now) & Hour(Now) & Minute(Now)& Second(Now) & CStr(CLng(Rnd *100000))
    window.open  p_sPage , sJanela, "status=yes, resizable=no, scrollbars=no" & _
                                  ", top=" & nTop & _
                                  ", left=" & nLeft & _
                                  ", width=" & p_nWidth & _
                                  ", height=" & p_nHeight

End Sub

'-- Abre uma nova janela para formulario
Sub showFormGeraTXT(p_oParams)
    Dim  sJanela

    If IsObject(p_oParams) Then
        Set g_FormParam = p_oParams
    Else
        g_FormParam = p_oParams
    End If
	sJanela = ServerVars.getItem("CDPESSOAUSR") & "GeraTXT.asp"
    sJanela = Replace(sJanela, ".", "")
    sJanela = Replace(sJanela, "/", "")
    sJanela = Replace(sJanela, "\", "")
    sJanela = Replace(sJanela, "?", "")
    sJanela = Replace(sJanela, "&", "")
	p_sPage = "../../includes/asp/GerarTXT.asp?Chamada=1&Rnd=" & Day(Now) & Hour(Now) & Minute(Now)& Second(Now) & CStr(CLng(Rnd *100000))
    window.open  p_sPage , sJanela , "status=yes, resizable=no, scrollbars=no" & _
                                  ", top=100"  & _
                                  ", left=100"  & _
                                  ", width=330" & _
                                  ", height=120" 
End Sub


Sub showFormModal(p_sPage, p_nWidth, p_nHeight, p_oParams)
	p_sPage = "./" & p_sPage & "?Rnd=" & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) & CStr(CLng(Rnd *100000))
	window.showModalDialog p_sPage, p_oParams, "dialogwidth:" & p_nWidth & "px; " & _
	                                           "dialogHeight:" & p_nHeight & "px; " & _
	                                           "dialogHide:yes; " & _
	                                           "status:no; " & _
	                                           "help:no; " & _
	                                           "scroll:no; "
End Sub

Sub MostraAjuda(sFile,nWidth,nHeight)

    Dim nTop, nLeft,jan
    nTop  = Int((screen.height - 75 - nHeight) / 2)
    nLeft = Int((screen.width  - 10 - nWidth) / 2)
    window.open "../help/" & sFile, "Help", "status=no, resize=no, scrolling=no" & _
                                  ", top=" & nTop & _
                                  ", left=" & nLeft & _
                                  ", width=" & nWidth & _
                                  ", height=" & nHeight

End Sub


'-- Busca os dados que o form anterior enviou
Function getFormParams()

	On Error Resume Next

    If IsObject(window.opener.g_FormParam) Then
        Set getFormParams = window.opener.g_FormParam
    Else
        getFormParams = window.opener.g_FormParam
    End If

    If Err.Number > 0 Then
    	getFormParams = ""
    End If

End Function

'-- Limpa todos os campos de um formulario ativo
Sub clearForm()
    
    Dim oCtr, i

	For i = 0 To document.all.length - 1

		Set oCtr = document.all(i)

        On Error Resume Next

		If oCtr.tagName = "INPUT" Then

			If oCtr.type = "text" Or oCtr.type = "password" Then

				oCtr.value = ""
            Else
            
				oCtr.checked = False

            End If

        ElseIf oCtr.tagName = "SELECT" Then

		If oCtr.options.length > 0 Then
	                oCtr.selectedIndex = 0
		Else
			oCtr.selectedIndex = -1
		End If

	ElseIf oCtr.tagName = "TEXTAREA" Then
		
		oCtr.innerText = ""		

	End If

	Next

End Sub

'Protege todos os campos do Form

Sub ClosedForm()

Dim oCtr, i

For i = 0 To document.all.length - 1

	Set oCtr = document.all(i)

	On Error Resume Next

	If oCtr.tagName = "INPUT" Then

		If oCtr.type = "text" Or oCtr.type = "password" Then
			oCtr.disabled = True
		Else
			oCtr.checked = False
		End If 

	ElseIf oCtr.tagName = "BUTTON" Then
				
			oCtr.disabled = True
				
	ElseIf oCtr.tagName = "SELECT" Then

		If oCtr.options.length > 0 Then
			oCtr.disabled = true
		Else
			oCtr.selectedIndex = -1
		End If

	ElseIf oCtr.tagName = "TEXTAREA" Then

		oCtr.disabled = true		

	End If

Next

End Sub

Sub OpenForm()

Dim oCtr, i

For i = 0 To document.all.length - 1

	Set oCtr = document.all(i)

	On Error Resume Next

	If oCtr.tagName = "INPUT" Then

		If oCtr.type = "text" Or oCtr.type = "password" Then
			oCtr.disabled = False
		Else
			oCtr.checked = True
		End If 

	ElseIf oCtr.tagName = "BUTTON" Then
				
			oCtr.disabled = False
				
	ElseIf oCtr.tagName = "SELECT" Then

		If oCtr.options.length > 0 Then
			oCtr.disabled = False
		Else
			oCtr.selectedIndex = -1
		End If

	ElseIf oCtr.tagName = "TEXTAREA" Then

		oCtr.disabled = False		

	End If

Next

End Sub

'-- Busca os dados do banco e popula a combo
Sub MontaCombo(p_oCombo, p_sSQL)
    Dim rsCombo, i

    Set rsCombo = DBConn.openSnap(p_sSQL)
    If p_oCombo.size < 2 Then
        p_oCombo.options.length = rsCombo.RecordCount + 1
        p_oCombo.options(0).value = ""
        p_oCombo.options(0).text  = ""
        i = 1
    Else
        p_oCombo.options.length = rsCombo.RecordCount
        i = 0
    End If
    Do Until rsCombo.EOF
        p_oCombo.options(i).value = rsCombo.Field(1)
        p_oCombo.options(i).text  = rsCombo.Field(2)
        i = i + 1    
        rsCombo.MoveNext()
    Loop
    If p_oCombo.size < 2 Then
        p_oCombo.selectedIndex = 0
    Else
        p_oCombo.selectedIndex = -1
    End If
End Sub

Sub MontaComboCustom(p_oCombo, p_sSQL, p_sTexto)
    Dim rsCombo, i

    Set rsCombo = DBConn.openSnap(p_sSQL)
    If p_oCombo.size < 2 Then
        p_oCombo.options.length = rsCombo.RecordCount + 1
        p_oCombo.options(0).value = ""
        p_oCombo.options(0).text  = p_sTexto
        i = 1
    Else
        p_oCombo.options.length = rsCombo.RecordCount
        i = 0
    End If
    Do Until rsCombo.EOF
        p_oCombo.options(i).value = rsCombo.Field(1)
        p_oCombo.options(i).text  = rsCombo.Field(2)
        i = i + 1    
        rsCombo.MoveNext()
    Loop
    If p_oCombo.size < 2 Then
        p_oCombo.selectedIndex = 0
    Else
        p_oCombo.selectedIndex = -1
    End If
End Sub

'-- Função para montar uma grid com dados de um SQL
Sub MontaGrid(p_oGrid, p_sSQL)
    
    Dim rsGrid, i, j, aItens()
	
	window.status = "Aguarde, processando..."

    Set rsGrid = DBConn.openSnap(p_sSQL)

	window.status = "Aguarde, processando..."
    p_oGrid.clearItens()

    Do Until rsGrid.EOF

        ReDim aItens(rsGrid.FieldCount - 2)

        For i = 2 To rsGrid.FieldCount
              aItens(i - 2) = rsGrid.Field(i)
	    Next

        p_oGrid.addItem rsGrid.Field(1), aItens
        rsGrid.MoveNext()

    Loop

	window.status = ""
End Sub

'-- Função para montar uma grid com dados de um SQL começando a preencher as colunas a partir da posicao p_Posicao
'-- Util para utilização de campos que precisam ser ordenados e que foram convertidos para caracteres em selects com 
'-- Union,Minus,etc
Sub MontaGridCustom(p_oGrid, p_sSQL,p_Posicao)
    
    Dim rsGrid, i, j, aItens()
	
	window.status = "Aguarde, processando..."
    Set rsGrid = DBConn.openSnap(p_sSQL)
	window.status = "Aguarde, processando..."
    p_oGrid.clearItens()

    Do Until rsGrid.EOF

        ReDim aItens(rsGrid.FieldCount - p_Posicao)

        For i = p_Posicao To rsGrid.FieldCount
              aItens(i - p_Posicao) = rsGrid.Field(i)
	    Next

        p_oGrid.addItem rsGrid.Field(1), aItens
        rsGrid.MoveNext()

    Loop
	window.status = ""
End Sub

Sub AdicionaItensGrid(p_oGrid, p_sSQL)
  
    Dim rsGrid, i, j, aItens()
    
	window.status = "Aguarde, processando..."
    Set rsGrid = DBConn.openSnap(p_sSQL)
	window.status = "Aguarde, processando..."

    Do Until rsGrid.EOF

        ReDim aItens(rsGrid.FieldCount - 2)

        For i = 2 To rsGrid.FieldCount
            aItens(i - 2) = rsGrid.Field(i)        
        Next

        p_oGrid.addItem rsGrid.Field(1), aItens
        rsGrid.MoveNext()

    Loop
	window.status = ""
End Sub

'-- Função para montar uma treeview via SELECT
'-- ATENCAO: campos devem estar na ordem: DESCRICAO - CHAVE - CHAVEPAI - ICONE
'--          e SEMPRE ordenados, primeiramente, por NVL(PAI, 0)
Sub MontaTreeview(p_oTvw, p_sSQL)
    
    Dim rsTvw
    
	window.status = "Aguarde, processando..."
    Set rsTvw = DBConn.openSnap(p_sSQL)
	window.status = "Aguarde, processando..."
	
    p_oTvw.clearNodes()

    Do Until rsTvw.EOF

        p_oTvw.AddNode rsTvw.Field(1), rsTvw.Field(2), IIf(rsTvw.Field(3) = "", Null, rsTvw.Field(3)), IIf(rsTvw.Field(4) = "", Null, rsTvw.Field(4))

        rsTvw.MoveNext()

    Loop
	window.status = ""
End Sub

'-- Função para montar uma treeview com dados de um SQL começando a preencher as colunas a partir da posicao p_Posicao
'-- Util para utilização de campos que precisam ser ordenados e que foram convertidos para caracteres em selects com
'-- Union,Minus,etc
'-- ATENCAO: campos devem estar na ordem: DESCRICAO - CHAVE - CHAVEPAI - ICONE
'--          e SEMPRE ordenados, primeiramente, por NVL(PAI, 0)
Sub MontaTreeviewCustom(p_oTvw, p_sSQL, p_Posicao)

    Dim rsTvw

	window.status = "Aguarde, processando..."
    Set rsTvw = DBConn.openSnap(p_sSQL)
	window.status = "Aguarde, processando..."

    p_oTvw.clearNodes()

    Do Until rsTvw.EOF
        p_oTvw.AddNode rsTvw.Field(p_Posicao), rsTvw.Field(p_Posicao + 1), IIf(rsTvw.Field(p_Posicao + 2) = "", Null, rsTvw.Field(p_Posicao + 2)), IIf(rsTvw.Field(p_Posicao + 3) = "", Null, rsTvw.Field(p_Posicao + 3))
        rsTvw.MoveNext()
    Loop
	window.status = ""

End Sub

'-- Ativa menus conforme recursos e permissões
Sub verifyMenu(strNoPaginaInicial)
    Dim nProj, SnapP, sRecursos, strSQL

	If Trim(strNoPaginaInicial) = "" Then
		Exit Sub
	End If
	
	If ServerVars.getItem("TPUSUARIO") = "S" Then
		strSQL = "SELECT DISTINCT FC.NOFUNCAO, PRJ.DESCING AS MSG" & _
	             "  FROM SGW_PROJETO PRJ, SGW_PROJETOFUNCAO PF, SGR_FUNCAO FC " & _
	             " WHERE UPPER(PRJ.NOPAGINAINICIAL) = '" & UCase(strNoPaginaInicial) & "'" & _
	             "   AND PRJ.CDPROJETO              = PF.CDPROJETO " & _
	             "   AND PF.CDFUNCAO                = FC.CDFUNCAO "
	Else
		strSQL = "SELECT DISTINCT FC.NOFUNCAO, PRJ.DESCING AS MSG" & _
	             "  FROM SGR_PERFILUSUARIOEMP PUE, SGR_PERFIL F, SGW_PERFFUNCPROJ PFP, SGR_FUNCAO FC, " & _
	             "       SGW_PROJETO PRJ " & _
	             " WHERE PUE.CDPESSOAEMP            = " & ServerVars.getItem("CDPESSOAEMP") & _
	             "   AND PUE.CDPESSOAUSR            = " & ServerVars.getItem("CDPESSOAUSR") & _
	             "   AND PUE.CDPERFIL               = F.CDPERFIL " & _
	             "   AND F.CDPERFIL                 = PFP.CDPERFIL " & _
	             "   AND PFP.CDPROJETO              = PRJ.CDPROJETO " & _
	             "   AND UPPER(PRJ.NOPAGINAINICIAL) = '" & UCase(strNoPaginaInicial) & "'" & _
	             "   AND PFP.CDFUNCAO               = FC.CDFUNCAO "
	End If
    Set SnapP = DBConn.openSnap(strSQL)
	On Error Resume Next
	sRecursos = ""
    Do Until SnapP.EOF
    	vMsg=SnapP.Field("MSG")
    	If SnapP.Field(1) = "NEW" Then
    		sRecursos = sRecursos & "N"
    	ElseIf SnapP.Field(1) = "OPEN" Then
    		sRecursos = sRecursos & "O"
    	ElseIf SnapP.Field(1) = "SAVE" Then
    		sRecursos = sRecursos & "S"
    	ElseIf SnapP.Field(1) = "DELETE" Then
    		sRecursos = sRecursos & "D"
    	ElseIf SnapP.Field(1) = "FIND" Then
    		sRecursos = sRecursos & "F"
    	ElseIf SnapP.Field(1) = "PRINT" Then
    		sRecursos = sRecursos & "P"
    	End If
        SnapP.MoveNext()
    Loop
    If InStr(sRecursos, "N") = 0 Then
    '    mnuNovo.style.visibility = "hidden"
         mnuNovo.style.filter = "gray" 
    End If
    If InStr(sRecursos, "F") = 0 Then
        ' mnuPesquisar.style.visibility = "hidden"
         mnuPesquisar.style.filter = "gray"  
    End If
    If InStr(sRecursos, "S") = 0 Then
        'mnuSalvar.style.visibility = "hidden"
        mnuSalvar.style.filter = "gray"
    End If
    If InStr(sRecursos, "D") = 0 Then
        'mnuExcluir.style.visibility = "hidden"
         mnuExcluir.style.filter = "gray"
    End If
    If InStr(sRecursos, "P") = 0 Then
        'mnuImprimir.style.visibility = "hidden"
         mnuImprimir.style.filter = "gray"
    End If
    If InStr(sRecursos, "O") = 0 Then
        'mnuAbrir.style.visibility = "hidden"
         mnuAbrir.style.filter = "gray"
    End If
    If UCase(window.parent.name)="JANELAPRINCIPAL" Then
'    	window.alert vMsg & "  " & window.parent.name
    End If
    Err.Clear()
End Sub

'--- Funcao que converte uma string para valor
Function CVal(sValue)

    Dim i

    CVal = "0"

    For i = 1 To Len(sValue)

        If IsNumeric(Mid(sValue, i, 1)) Then
            
            CVal = CVal & Mid(sValue, i, 1)
            
        Else

            CVal = CDbl(CVal)
            Exit Function
        
        End If
    
    Next

    CVal = CDbl(CVal)

End Function

'-- Funcao para marcar a linha da grid multi
Sub marcaLinha(obj)
	
    If obj.checked = False Then
    
         obj.parentNode.parentNode.style.backgroundColor = "white" 
         obj.parentNode.parentNode.style.color = "black" 
         obj.parentNode.parentNode.setAttribute "checked", False
         
    Else
         obj.parentNode.parentNode.style.backgroundColor = "activecaption" 
         obj.parentNode.parentNode.style.color = "white" 
         obj.parentNode.parentNode.setAttribute "checked", True
    End If
    
End Sub

'-- Funcao para marcar todas as linhas da grid multi
Sub marcaTudo(obj)

    Dim oTable, sCor, sCorFundo, bValor
    
    On Error Resume Next
    Err.Clear
    
    Set oTable = obj.parentNode.parentNode.parentNode.parentNode.parentNode.childNodes(1).childNodes(0).childNodes(0)
    If Err.Number <> 0 Then
        obj.checked = False
    End If

    If obj.checked = False Then
        sCorFundo = "white"
        sCor = "black"
        bValor = False        
    Else
        sCorFundo = "activecaption"
        sCor = "white"
        bValor = True       
    End If

    For i = 0 To oTable.childNodes.length - 1
        
        Dim oChk
        
        Set oChk = oTable.childNodes(i).childNodes(0).childNodes(0)
        
        oChk.checked = bValor
        oChk.parentNode.parentNode.style.backgroundColor = sCorFundo
        oChk.parentNode.parentNode.style.color = sCor
        oChk.parentNode.parentNode.setAttribute "checked", bValor
    Next     
End Sub

Sub window_onbeforeunload()
	If g_bUpdateFields = True And VERIFY_UPDATE = True Then
		window.event.returnValue = "O encerramento desta página não salvará as alterações realizadas."
	End If
End Sub

Function UploadFile()
    Dim oJan
    oJan = window.showModalDialog("../../includes/asp/upload.asp?" & Rnd * Second(Now) * Minute(Now), "", "dialogHeight: 200px; dialogHide: yes; status:no")
    If IsArray(oJan) Then
        UploadFile = oJan
    Else
        UploadFile = Array(-1, "")
    End If
End Function

Sub ErroTimeOut()
    MsgBox "ATENÇÃO: Sua sessão no servidor foi finalizada por timeout. " & vbNewLine & vbNewLine & "Efetue novo login.", vbCritical
    g_oHeaderWindow.ProcessaTimeout()
End Sub

Function AplicaMascara(strValor, strMascara)

	Dim intPosMascara
	Dim intPosMascara2
	Dim intPosString
	Dim strValorFormatado
	
	intPosString   = 1
	intPosMascara  = 1
	intPosMascara2 = InStr(1, strMascara, ".")
	
	Do While intPosMascara2 <> 0
	
		If intPosMascara = 1 Then
			strValorFormatado = Mid(strValor, intPosString, intPosMascara2 - intPosMascara)
		Else
			If Mid(strValor, intPosString, intPosMascara2 - intPosMascara) = "" Then
				Exit Do
			Else
				strValorFormatado = strValorFormatado & "." & Mid(strValor, intPosString, intPosMascara2 - intPosMascara)
			End If
		End If

		intPosString   = intPosString + (intPosMascara2 - intPosMascara)
		intPosMascara  = intPosMascara2 + 1
		intPosMascara2 = InStr(intPosMascara, strMascara, ".")
	
	Loop
	
	If Mid(strValor, intPosString) = "" Then
		AplicaMascara = strValorFormatado
	Else
		AplicaMascara = strValorFormatado & "." & Mid(strValor, intPosString)
	End If

End Function

Function LeParametro(strCdSistema, strCdParametro, strCdPessoaEmp)

	Dim rsSnap

    Set rsSnap = DBConn.openSnap("SELECT FNC_PARAMETRO('" & strCdSistema & "','" & strCdParametro & "'," & _
                                                           strCdPessoaEmp & ") PARAMETRO FROM DUAL")
                                                           
	If rsSnap.EOF Then
		LeParametro = ""
	Else
		LeParametro = rsSnap.Field("PARAMETRO")
	End If

End Function

Sub ScrollingMenu()

    g_oScrollMenuObject.doScroll g_sScrollMenuDirection

End Sub

Sub HideMenu()

    If g_bMenuHide = True Then

        Dim oFrameMenu
        
        Set oFrameMenu = window.parent.frames("fraMenu")
        
        oFrameMenu.g_bMenuHide = False
        
        oFrameMenu.oMenu.RemoveTodosMenus()

    End If

End Sub

Function TrataDataNula(strData, strDataNula)

	If strData = strDataNula Then
		TrataDataNula = ""
	Else
		TrataDataNula = strData
	End If

End Function

Function ConverteRegiao(pStrNumero,pNumDigDec,pDigitoGrupo)
	
	Dim vStrNumero ,SeparadorDecimal
	
	if len(trim(pStrNumero & "")) = 0 then 
		ConverteRegiao = ""
		exit function
	end if

	If pDigitoGrupo Then
		vDiggrupo=-1
	Else
		vDiggrupo=0
	End If
	SeparadorDecimal=SepDecimalRegiao()
	vStrNumero=replace(pStrNumero,",",SeparadorDecimal)
	ConverteRegiao=FormatNumber(vStrNumero,pNumDigDec,-1,0,vDiggrupo)
	
End Function

'Função para tratar valores numéricos com separadores ("," ou ".") Dependendo das configurações regionais da maquina.
'Funciona para português e liglês, desde que o valor não seja tratado na propria consulta, o número deve vir como está no banco.
Function ConverteRegiaoCustom(pStrNumero,pNumDigDec,pDigitoGrupo)
	
	Dim vStrNumero, SeparadorDecimal
	
	If len(trim(pStrNumero & "")) = 0 Then 
		ConverteRegiaoCustom = ""
		Exit Function
	End If

	If pDigitoGrupo Then
		vDiggrupo=-1
	Else
		vDiggrupo=0
	End If
	
	SeparadorDecimal = SepDecimalRegiao()
	
    vStrNumero = replace(pStrNumero,".",SeparadorDecimal)
    
	ConverteRegiaoCustom = FormatNumber(vStrNumero,pNumDigDec,-1,0,vDiggrupo)
	
End Function

Function SepDecimalRegiao()
    If CCur("1.1") = "1.1" Then
    	SepDecimalRegiao="."
    Else
    	SepDecimalRegiao=","
    End If
End Function


Function ConverteBD(pStrNumero)
	Dim vSepDecimal,vSepGrupo,vStr
	
	vSepDecimal=SepDecimalRegiao()
	If vSepDecimal="," Then
		vSepGrupo="."
	Else
		vSepGrupo=","
	End If
	vStr=replace(pStrNumero,vSepGrupo,"")
	vStr=replace(vStr,vSepDecimal,",")
	ConverteBD=vStr
End Function

Sub LogBD(pCdProjeto)
     	strSQL="INSERT INTO SGW_LOG  (CDSEQLOG,CDPROJETO,CDPESSOAUSR,CDSTATUSLOG,DTLOG) VALUES (SEQ_SGW_LOG.NEXTVAL," & _
     				pCdProjeto & "," & Servervars.getItem("CDPESSOAUSR") & ",6,SYSDATE)"
     	DBConn.execSQL strSQL
End Sub

Sub DownloadFile(strCdUpload)
	Dim variavelJan
   	variavelJan=window.parent.location("../../includes/asp/Download.asp?CdUpload=" & strCdUpload)
End Sub

'-- Coloca o titulo do projeto na janela
Function getTitle(strNoPaginaInicial)

    Dim nProj, SnapP, sRecursos, strSQL

	If Trim(strNoPaginaInicial) = "" Then
		Exit Function
	End If
	strSQL = "SELECT DISTINCT PRJ.NOPROJETO " & _
             "  FROM SGW_PROJETO PRJ" & _
             " WHERE UPPER(PRJ.NOPAGINAINICIAL) = UPPER('" & strNoPaginaInicial & "')" 
    Set SnapP = DBConn.openSnap(strSQL)
    If Not SnapP.EOF Then
    	getTitle=SnapP.Field(1)
    Else
    	getTitle=""
    End If 
End Function