<% '######################################################################################### '# Loja Virtua Developer Pack 6 - Versão Beta '######################################################################################### 'Declaração das variaveis comuns Dim razaoloja Dim bancopag Dim contapag Dim pagpara Dim varimg Dim pesquisa Dim strTextoHtml Dim conexao Dim dados Dim nomeloja Dim slogan Dim emailloja Dim urlloja Dim tituloloja Dim endereco11 Dim bairro11 Dim cidade11 Dim estado11 Dim pais11 Dim fone11 Dim razao Dim Mes Dim meszz Dim diazz Dim dataz Dim i Dim dia Dim mez Dim strLink Dim strAcao Dim contacompra Dim contacli Dim estadoz Dim rs Dim r2 Dim finalera Dim pag Dim pesss Dim pagdxx Dim pesqsa Dim catege Dim fDia Dim mezito Dim anito Dim data Dim Ano Dim j Dim ndiasmes Dim anozinho Dim palavra Dim inicial Dim final Dim restinho Dim totalreg Dim pagina2 Dim pagina3 Dim rs2 Dim nSem Dim aDiasMes Dim strString Dim UploadRequest Dim objFSO Dim ObjFile Dim ObjStream Dim arquivodat Dim separador Dim senhaok Dim VersaoDb Dim StringdeConexao Const wexPassword = "" Const wexRoot = "\" Const appName = "Explorer VirtuaStore" Const appVersion = "OPEN" Const wexCharSet = "ISO-8859-1" Const showHiddenItems = true Const calculateTotalSize = false Const calculateFolderSize = false Const editableExtensions = "*htm*|*html*|*asp*|*asa*|*txt*|*inc*|*css*|*aspx*|*js*|*vbs*|*shtm*|*shtml*|*xml*|*xsl*|*log*" Const viewableExtensions = "*gif*|*jpg*|*jpeg*|*png*|*bmp*|*jpe*" Const iconFolderOpenBig = "" Const iconFolderUp = " Diretório acima" Const iconFolder = "" Const iconFile = "" Const iconFileEditable = "" Const iconFileViewable = "" Const iconRefresh = "" Const iconCreateFile = "" Const iconCreateFolder = "" Const iconUpload = "" Const iconLogout = "" Const iconDelete = "" Server.ScriptTimeout = 60 Call Iniciar %> <% '----------------------------------------------------------------------------------- 'Inicia a sub pricipal Sub Iniciar() on error resume next Session.LCID = 1046 Response.Buffer = True 'inicia conexao com o banco de dados %> <% set conexao = Server.CreateObject("ADODB.Connection") conexao.Open(StringdeConexao) 'Chama variaveis de Aplicação nomeloja = Application("nomeloja") razaoloja = Application("razaoloja") emailloja = Application("emailloja") slogan = Application("slogan") urlloja = Application("urlloja") endereco11 = Application("endereco11") bairro11 = Application("bairro11") cidade11 = Application("cidade11") estado11 = Application("estado11") pais11 = Application("pais11") fone11 = Application("fone11") bancopag = Application("bancopag") contapag = Application("contapag") pagpara = Application("pagpara") If Session("admin") = "" Then %> <% Response.Write strTextoHtml Response.End End If '--------------------------------------------------------------------------- strTextoHtml = "" strTextoHtml = strTextoHtml & "" & vbNewLine strTextoHtml = strTextoHtml & "" & vbNewLine strTextoHtml = strTextoHtml & "" & vbNewLine strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" Mes = CStr(Trim(Month(Date))) If Mes = "1" Or Mes = "01" Then Mes = "janeiro" End If If Mes = "2" Or Mes = "02" Then Mes = "fevereiro" End If If Mes = "3" Or Mes = "03" Then Mes = "março" End If If Mes = "4" Or Mes = "04" Then Mes = "abril" End If If Mes = "5" Or Mes = "05" Then Mes = "maio" End If If Mes = "6" Or Mes = "06" Then Mes = "junho" End If If Mes = "7" Or Mes = "07" Then Mes = "julho" End If If Mes = "8" Or Mes = "08" Then Mes = "agosto" End If If Mes = "9" Or Mes = "09" Then Mes = "setembro" End If If Mes = "10" Then Mes = "outubro" End If If Mes = "11" Then Mes = "novembro" End If If Mes = "12" Then Mes = "dezembro" End If strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "
  Usuario: "&Ucase(Session("NOME")) &" - "& nomeloja & " · " & urlloja & " ·     Página inicial  |  Logout    
" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" If Len(Day(Date)) = 1 Then dia = "0" & Day(Date) Else dia = Day(Date) End If If Len(Month(Date)) = 1 Then mez = "0" & Month(Date) Else mez = Month(Date) End If strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" '************************************************************************************' '***** Inicio montagem menu esquerdo do Administrador Posição de estoque ***********' '***** Criado: Fábio V.Coelho - fabio_v_coelho@zipmail.com.br ***********' '************************************************************************************' strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" If CStr(Len(Day(Now))) = CStr("1") Then diazz = "0" & Day(Now) Else diazz = Day(Now) End If If CStr(Len(Month(Now))) = CStr("1") Then meszz = "0" & Month(Now) Else meszz = Month(Now) End If dataz = diazz & "/" & meszz & "/" & Year(Now) strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" 'strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "
  ADMINISTRADOR
    Trocar seu Email / Senha
    Inserir administrador
    Excluir administrador
  PRODUTOS
    Inserir produto
    Ver / Editar produtos
    Excluir produtos
    Posição de Estoque/Vendas
  COMPRAS
    Compras por data
    Todas as compras
    Rastreamento de Compras
  DEPARTAMENTOS
    Inserir departamento
      Sub-departamentos
    Editar departamentos
      Sub-departamentos
    Excluir departamentos
      Sub-departamentos
  CLIENTES
    Administrar clientes
  NEWSLETTER
    Escrever nova newsletter
    Excluir email newsletter
  UTILITÁRIOS
    Atendimento Online
    Banners (Sist AdMentor)
    Diagnóstico do servidor
    Componentes no servidor
    Estatísticas
    Gerenciador de arquivos
    Manutenção da base
    Otimizar banco de bados
    SQL Manager
    Variáveis do servidor
    Ver minha loja
    Ver tabela de cores
    Zerar contador
" strLink = Request("link") strAcao = Request("acao") Select Case strLink Case "produtos" %> <% Case "clientes" %> <% Case "news" %> <% Case "util" %> <% Case "suporte" %> <% Case "dep" %> <% Case "sdep" %> <% Case "compras" %> <% Case "adm" %> <% Case "logout" Session.contents.remove("admin") Session.contents.remove("ACESSO") Session.contents.remove("ULTACESSO") Session.Abandon() Response.Redirect "administrador.asp" Case Else %> <% End Select strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "
" & vbNewLine strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "Powered by Virtua Developer           "&application("link_comunidade")&"
" strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "" conexao.Close Set conexao = Nothing Response.Write strTextoHtml End Sub '----------------------------------------------------------------------------------- Function MesExtenso(Mes) Select Case Mes Case 1 MesExtenso = "Janeiro" Case 2 MesExtenso = "Fevereiro" Case 3 MesExtenso = "Março" Case 4 MesExtenso = "Abril" Case 5 MesExtenso = "Maio" Case 6 MesExtenso = "Junho" Case 7 MesExtenso = "Julho" Case 8 MesExtenso = "Agosto" Case 9 MesExtenso = "Setembro" Case 10 MesExtenso = "Outubro" Case 11 MesExtenso = "Novembro" Case 12 MesExtenso = "Dezembro" End Select End Function '----------------------------------------------------------------------------------- Function DiaSemana(iDia) Select Case iDia Case 0 DiaSemana = "Dom" Case 1 DiaSemana = "Seg" Case 2 DiaSemana = "Ter" Case 3 DiaSemana = "Qua" Case 4 DiaSemana = "Qui" Case 5 DiaSemana = "Sex" Case 6 DiaSemana = "Sab" End Select End Function '----------------------------------------------------------------------------------- Function nSemanas(Mes, Ano) DtInicial = DateSerial(Ano, Mes, fDia) If Weekday(DtInicial) = 1 Then nSem = 0 Else nSem = 1 End If ndiasmes = aDiasMes(Mes) For i = 1 To ndiasmes If Weekday(DtInicial) = 1 Then nSem = nSem + 1 End If DtInicial = DateAdd("d", 1, DtInicial) Next nSemanas = nSem End Function '----------------------------------------------------------------------------------- Sub SetBissexto() mezito = Request("mes") anito = Request("ano") If mezito = "" Then mezito = Month(Now) End If If anito = "" Then anito = Year(Now) End If data = "1/" & mezito & "/" & anito If Trim(data) = "" Then data = Date Else data = CDate(data) End If Ano = Year(data) If (Ano Mod 4 = 0) Or (Ano Mod 100 = 0) And (Ano Mod 400 = 0) Then aDiasMes(2) = 29 Else aDiasMes(2) = 28 End If End Sub '----------------------------------------------------------------------------------- Sub CalendarioASP() strTextoHtml = strTextoHtml & "Selecione pela data as compras que você deseja visualizar:" strTextoHtml = strTextoHtml & "
" fDia = 1 ReDim aDiasMes(12) aDiasMes(1) = 31 aDiasMes(2) = 28 aDiasMes(3) = 31 aDiasMes(4) = 30 aDiasMes(5) = 31 aDiasMes(6) = 30 aDiasMes(7) = 31 aDiasMes(8) = 31 aDiasMes(9) = 30 aDiasMes(10) = 31 aDiasMes(11) = 30 aDiasMes(12) = 31 Call SetBissexto Call MontaCalendario End Sub '----------------------------------------------------------------------------------- Sub MontaCalendario() mezito = Request("mes") anito = Request("ano") If mezito = "" Then mezito = Month(Now) End If If anito = "" Then anito = Year(Now) End If data = "1/" & mezito & "/" & anito If Trim(data) = "" Then data = Date Else data = CDate(data) End If Ano = Year(data) Mes = Month(data) DiaInicial = Weekday(DateSerial(Ano, Mes, fDia)) DtInicial = DateSerial(Ano, Mes, fDia) strTextoHtml = strTextoHtml & "" & vbCrLf strTextoHtml = strTextoHtml & "" For j = 0 To 6 If j = 0 Then strTextoHtml = strTextoHtml & "" & vbCrLf Else strTextoHtml = strTextoHtml & "" & vbCrLf End If Next strTextoHtml = strTextoHtml & "" For i = 0 To (nSemanas(Month(DtInicial), Year(DtInicial)) - 1) strTextoHtml = strTextoHtml & "" & vbCrLf For j = 0 To 6 If (DiaInicial - 1) > j And i = 0 Then If j = 0 And i = 0 Then strTextoHtml = strTextoHtml & "" & vbCrLf Else strTextoHtml = strTextoHtml & "" & vbCrLf End If Else If Month(DtInicial) > Mes Or Year(DtInicial) > Ano Then strTextoHtml = strTextoHtml & "" & vbCrLf Else If Weekday(DtInicial) = 1 Then If CStr(Len(Day(DtInicial))) = CStr("1") Then diazz = "0" & Day(DtInicial) Else diazz = Day(DtInicial) End If If CStr(Len(Month(DtInicial))) = CStr("1") Then meszz = "0" & Month(DtInicial) Else meszz = Month(DtInicial) End If dataz = diazz & "/" & meszz & "/" & Year(DtInicial) set rs = conexao.execute("select * from compras where datacompra='" & dataz & "' AND status <> 'Compra em Aberto';") if rs.eof then varvialvelcompra = "#000000" else varvialvelcompra = "red" end if rs.close set rs = nothing strTextoHtml = strTextoHtml & "" Else If DtInicial = Date Then If CStr(Len(Day(DtInicial))) = CStr("1") Then diazz = "0" & Day(DtInicial) Else diazz = Day(DtInicial) End If If CStr(Len(Month(DtInicial))) = CStr("1") Then meszz = "0" & Month(DtInicial) Else meszz = Month(DtInicial) End If dataz = diazz & "/" & meszz & "/" & Year(DtInicial) set rs = conexao.execute("select * from compras where datacompra='" & dataz & "' AND status <> 'Compra em Aberto';") if rs.eof then varvialvelcompra = "#000000" else varvialvelcompra = "red" end if rs.close set rs = nothing strTextoHtml = strTextoHtml & "" Else If CStr(Len(Day(DtInicial))) = CStr("1") Then diazz = "0" & Day(DtInicial) Else diazz = Day(DtInicial) End If If CStr(Len(Month(DtInicial))) = CStr("1") Then meszz = "0" & Month(DtInicial) Else meszz = Month(DtInicial) End If dataz = diazz & "/" & meszz & "/" & Year(DtInicial) set rs = conexao.execute("select * from compras where datacompra='" & dataz & "' AND status <> 'Compra em Aberto';") if rs.eof then varvialvelcompra = "#000000" else varvialvelcompra = "red" end if rs.close set rs = nothing strTextoHtml = strTextoHtml & "" End If End If End If DtInicial = DateAdd("d", DtInicial, 1) End If Next strTextoHtml = strTextoHtml & "" & vbCrLf Next strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "
" & DiaSemana(j) & "" & DiaSemana(j) & "
   " If CStr(Request("dia")) = CStr(Day(DtInicial)) Then strTextoHtml = strTextoHtml & "" & Day(DtInicial) & "" Else strTextoHtml = strTextoHtml & Day(DtInicial) End If strTextoHtml = strTextoHtml & "" If CStr(Request("dia")) = CStr(Day(DtInicial)) Then strTextoHtml = strTextoHtml & "" & Day(DtInicial) & "" Else strTextoHtml = strTextoHtml & Day(DtInicial) End If strTextoHtml = strTextoHtml & "" If CStr(Request("dia")) = CStr(Day(DtInicial)) Then strTextoHtml = strTextoHtml & "" & Day(DtInicial) & "" Else strTextoHtml = strTextoHtml & Day(DtInicial) End If strTextoHtml = strTextoHtml & "
" Call DisplaySelectDate strTextoHtml = strTextoHtml & "
" & vbCrLf End Sub '----------------------------------------------------------------------------------- Sub DisplaySelectDate() strTextoHtml = strTextoHtml & "
" Call MonthCombo Call YearCombo strTextoHtml = strTextoHtml & " " End Sub Sub MonthCombo() mezito = Request("mes") If mezito = "" Then mezito = Month(Now) Else mezito = mezito End If strTextoHtml = strTextoHtml & "" End Sub Sub YearCombo() anozinho = Request("ano") If anozinho = "" Then anozinho = Year(Now) Else anozinho = anozinho End If strTextoHtml = strTextoHtml & " de " End Sub Sub DepartamentosASP() If Request("acaba") = "sim" Then Session("adm_descprod") = "" Session("adm_email") = "" End If Select Case strAcao Case "inserir" strTextoHtml = strTextoHtml & " Incluir novo departamento na loja
" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" varimg = " " strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "
Data:" & dia & "/" & mez & "/" & Year(Date) & "
Departamento: "sim" Then strTextoHtml = strTextoHtml & Request.QueryString("erro1") End If strTextoHtml = strTextoHtml & """ size=50 style=font-size:11px;font-family:tahoma>" If Request.QueryString("erro1") = "sim" Then strTextoHtml = strTextoHtml & varimg End If strTextoHtml = strTextoHtml & "
Descrição (opcional):
Visível:
    

Voltar para página inicial

" Case "gravanovo" nome = Trim(Request("nomedep")) descri = Trim(Request("descri")) ver = Trim(Request("ver")) If nome = "" Then If nome = "" Then erro1 = "sim" Else erro1 = nome erro3 = descri If ver = "" Then erro2 = "sim" Else erro2 = ver Response.Redirect "?link=dep&acao=inserir&erro1=" & erro1 & "&erro2=" & erro2 & "&erro3=" & erro3 End If If descri = "" Then descri = "-" End If If CStr(Len(Day(Now))) = CStr("1") Then diazz = "0" & Day(Now) Else diazz = Day(Now) End If If CStr(Len(Month(Now))) = CStr("1") Then meszz = "0" & Month(Now) Else meszz = Month(Now) End If dataz = diazz & "/" & meszz & "/" & Year(Now) textosql = "INSERT INTO sessoes (data, nome, descr,ver) VALUES ('" & dataz & "', '" & nome & "', '" & descri & "','" & ver & "');" Set gravadep = conexao.Execute(textosql) strTextoHtml = strTextoHtml & " Novo departamento incluído na loja com sucesso
" strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "
Inserir um novo departamento na loja
" strTextoHtml = strTextoHtml & "

" varimg = " " strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "
Data:" & dataz & "
Departamento:" & nome & "
Descrição (opcional):" If descri = "" Then strTextoHtml = strTextoHtml & "-" Else strTextoHtml = strTextoHtml & descri End If strTextoHtml = strTextoHtml & "
Visível:" If CStr(ver) = "s" Then strTextoHtml = strTextoHtml & "Sim" Else strTextoHtml = strTextoHtml & "Não" End If strTextoHtml = strTextoHtml & "
Voltar para página inicial

" Case "editar" Set rs = conexao.Execute("SELECT * FROM sessoes ORDER by nome") If rs.EOF Or rs.bof Then strTextoHtml = strTextoHtml & " Editar departamentos na loja
" strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "Departamentos(s) encontrado(s): 0
" strTextoHtml = strTextoHtml & "

" strTextoHtml = strTextoHtml & "


Nenhum departamento foi encontrado na base de dados da loja.



" strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "
Voltar para Página Inicial
" Else Set rs2 = conexao.Execute("SELECT count(nome) AS total FROM sessoes;") totalreg = rs2("total") rs2.Close Set rs2 = Nothing numiz = Request("pagina") & "0" numiz = CInt(numiz) iz = iz + numiz strTextoHtml = strTextoHtml & " Editar departamentos na loja
" strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "Departamentos(s) encontrado(s): " & totalreg & "
" strTextoHtml = strTextoHtml & "
" While Not rs.EOF iz = iz + 1 If rs("ver") = "s" Then varestoq = "Sim" Else varestoq = "Não" End If strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "
" & iz & ") " & UCase(rs("nome")) & "
      Data: " & rs("data") & "    Visível: " & varestoq & "		Ação: Ver | Editar 
" rs.movenext Wend strTextoHtml = strTextoHtml & "

Voltar para Página Inicial
" rs.Close Set rs = Nothing End If Case "excluir" Set rs = conexao.Execute("SELECT * FROM sessoes ORDER by nome") If rs.EOF Or rs.bof Then strTextoHtml = strTextoHtml & " Excluir departamentos na loja
" strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "Departamentos(s) encontrado(s): 0
" strTextoHtml = strTextoHtml & "

" strTextoHtml = strTextoHtml & "


Nenhum departamento foi encontrado na base de dados da loja.



" strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "
Voltar para Página Inicial
" Else Set rs2 = conexao.Execute("SELECT count(nome) AS total FROM sessoes;") totalreg = rs2("total") rs2.Close Set rs2 = Nothing numiz = Request("pagina") & "0" numiz = CInt(numiz) iz = iz + numiz strTextoHtml = strTextoHtml & " Excluir departamentos na loja
" strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "Departamentos(s) encontrado(s): " & totalreg & "
" strTextoHtml = strTextoHtml & "
" If Request("status") = "sucesso" Then strTextoHtml = strTextoHtml & "
DEPARTAMENTO EXCLIUDO COM SUCESSO!

" Else End If While Not rs.EOF iz = iz + 1 If rs("ver") = "s" Then varestoq = "Sim" Else varestoq = "Não" End If strTextoHtml = strTextoHtml & "" & vbNewLine strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "
" & vbNewLine strTextoHtml = strTextoHtml & "
" & iz & ") " & UCase(rs("nome")) & "
      Data: " & rs("data") & "    Visível: " & varestoq & "		Ação: Ver | Excluir 
" rs.movenext Wend strTextoHtml = strTextoHtml & "

Voltar para Página Inicial
" rs.Close Set rs = Nothing End If Case "exclui" notz = Request.QueryString("dep") set rs_delete = abredb.execute("SELECT idcategoria from categoria where idsessao=" & notz & ";") if not rs_delete.eof then delete_idcategoria=rs_delete("idcategoria") end if rs_delete.close set rs_delete = nothing conexao.Execute("delete from sessoes where id=" & notz & ";") conexao.Execute("delete from produtos where idsessao='" & delete_idcategoria & "';") Response.Redirect "?link=dep&acao=excluir&status=sucesso" Case "ver" Set setdep = conexao.Execute("SELECT * FROM sessoes WHERE id = " & Request("dep") & ";") nome = setdep("nome") data = setdep("data") descri = setdep("descr") ver = setdep("ver") If Request("status") = "sucesso" Then strTextoHtml = strTextoHtml & " Departamento editado com sucesso
" strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "
Editar novamente este departamento | Ver novamente todos os departamentos
" Else strTextoHtml = strTextoHtml & " Ver departamento cadastrado na loja
" strTextoHtml = strTextoHtml & "
" If Request("modo") = "exclui" Then strTextoHtml = strTextoHtml & "" & vbNewLine strTextoHtml = strTextoHtml & "
Excluir este departamento | Ver todos os departamentos
" Else strTextoHtml = strTextoHtml & "
Editar este departamento | Ver todos os departamentos
" End If End If strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "

" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "
Data:" & dataz & "
Departamento:" & nome & "
Descrição (opcional):" If setdep("descr") = "" Then strTextoHtml = strTextoHtml & "-" Else strTextoHtml = strTextoHtml & descri End If strTextoHtml = strTextoHtml & "
Visível:" If CStr(ver) = "s" Then strTextoHtml = strTextoHtml & "Sim" Else strTextoHtml = strTextoHtml & "Não" End If strTextoHtml = strTextoHtml & "
Voltar para página inicial

" Case "edita" Set depz = conexao.Execute("SELECT * FROM sessoes WHERE id = " & Request("dep") & ";") strTextoHtml = strTextoHtml & " Editar departamento na loja
" strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" varimg = " " strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "
Data:" & depz("data") & "
Departamento:" If Request.QueryString("erro1") = "sim" Then strTextoHtml = strTextoHtml & varimg End If strTextoHtml = strTextoHtml & "
Descrição (opcional):
Visível:
    

Voltar para página inicial

" Case "gravavelho" nome = Trim(Request("nomedep")) descri = Trim(Request("descri")) ver = Trim(Request("ver")) If nome = "" Then If nome = "" Then erro1 = "sim" Else erro1 = nome erro3 = descri If ver = "" Then erro2 = "sim" Else erro2 = ver Response.Redirect "?link=dep&acao=edita2&erro1=" & erro1 & "&erro2=" & erro2 & "&erro3=" & erro3 & "&dep=" & Request("dep") End If If descri = "" Then descri = "-" End If textosql = "UPDATE sessoes SET nome = '" & nome & "', descr = '" & descri & "', ver = '" & ver & "' WHERE id = " & Request("dep") & ";" Set gravadep = conexao.Execute(textosql) Response.Redirect "?link=dep&acao=ver&status=sucesso&dep=" & Request("dep") Case "edita2" strTextoHtml = strTextoHtml & " Editar departamento na loja
" strTextoHtml = strTextoHtml & "
" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" varimg = " " strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "" strTextoHtml = strTextoHtml & "
Data:" & dia & "/" & mez & "/" & Year(Date) & "
Departamento: "sim" Then strTextoHtml = strTextoHtml & Request.QueryString("erro1") End If strTextoHtml = strTextoHtml & """ size=50 style=font-size:11px;font-family:tahoma>" If Request.QueryString("erro1") = "sim" Then strTextoHtml = strTextoHtml & varimg End If strTextoHtml = strTextoHtml & "
Descrição (opcional):
Visível:
    

Voltar para página inicial

" End Select End Sub Function DecodificaTexto(strString) strString = Replace(strString, Chr(1), "A") strString = Replace(strString, Chr(2), "a") strString = Replace(strString, Chr(3), "B") strString = Replace(strString, Chr(4), "b") strString = Replace(strString, Chr(5), "C") strString = Replace(strString, Chr(6), "c") strString = Replace(strString, Chr(7), "D") strString = Replace(strString, Chr(8), "d") strString = Replace(strString, Chr(14), "E") strString = Replace(strString, Chr(15), "e") strString = Replace(strString, Chr(16), "F") strString = Replace(strString, Chr(17), "f") strString = Replace(strString, Chr(18), "G") strString = Replace(strString, Chr(19), "g") strString = Replace(strString, Chr(20), "H") strString = Replace(strString, Chr(21), "h") strString = Replace(strString, Chr(22), "I") strString = Replace(strString, Chr(23), "i") strString = Replace(strString, Chr(24), "J") strString = Replace(strString, Chr(25), "j") strString = Replace(strString, Chr(26), "K") strString = Replace(strString, Chr(27), "k") strString = Replace(strString, Chr(28), "L") strString = Replace(strString, Chr(29), "l") strString = Replace(strString, Chr(30), "M") strString = Replace(strString, Chr(31), "m") strString = Replace(strString, Chr(127), "N") strString = Replace(strString, Chr(128), "n") strString = Replace(strString, Chr(129), "O") strString = Replace(strString, Chr(131), "o") strString = Replace(strString, Chr(134), "P") strString = Replace(strString, Chr(135), "p") strString = Replace(strString, Chr(138), "Q") strString = Replace(strString, Chr(140), "q") strString = Replace(strString, Chr(141), "R") strString = Replace(strString, Chr(142), "r") strString = Replace(strString, Chr(143), "S") strString = Replace(strString, Chr(144), "s") strString = Replace(strString, Chr(153), "T") strString = Replace(strString, Chr(154), "t") strString = Replace(strString, Chr(156), "U") strString = Replace(strString, Chr(157), "u") strString = Replace(strString, Chr(158), "V") strString = Replace(strString, Chr(162), "v") strString = Replace(strString, Chr(163), "X") strString = Replace(strString, Chr(164), "x") strString = Replace(strString, Chr(165), "Z") strString = Replace(strString, Chr(166), "z") strString = Replace(strString, Chr(167), "Y") strString = Replace(strString, Chr(169), "y") strString = Replace(strString, Chr(172), "W") strString = Replace(strString, Chr(174), "w") strString = Replace(strString, Chr(177), "1") strString = Replace(strString, Chr(181), "2") strString = Replace(strString, Chr(182), "3") strString = Replace(strString, Chr(188), "4") strString = Replace(strString, Chr(189), "5") strString = Replace(strString, Chr(190), "6") strString = Replace(strString, Chr(191), "7") strString = Replace(strString, Chr(198), "8") strString = Replace(strString, Chr(208), "9") strString = Replace(strString, Chr(216), "0") strString = Replace(strString, Chr(222), ",") strString = Replace(strString, Chr(223), "-") strString = Replace(strString, Chr(221), "_") strString = Replace(strString, Chr(229), Chr(34)) strString = Replace(strString, Chr(230), "'") strString = Replace(strString, Chr(240), "@") strString = Replace(strString, Chr(241), "&") strString = Replace(strString, Chr(248), "$") strString = Replace(strString, Chr(253), "#") strString = Replace(strString, Chr(254), "*") strString = Replace(strString, Chr(255), "(") strString = Replace(strString, Chr(197), ")") strString = Replace(strString, Chr(175), "\") strString = Replace(strString, Chr(161), "/") strString = Replace(strString, Chr(149), "|") DecodificaTexto = strString End Function Function Codifica(strString) strString = Replace(strString, Chr(32) & Chr(32), "  ") strString = Replace(strString, Chr(13), " ") strString = Replace(strString, Chr(10) & Chr(10), "

") strString = Replace(strString, Chr(10), "
") strString = Replace(strString, "[b]", "") strString = Replace(strString, "[/b]", "") strString = Replace(strString, "[i]", "") strString = Replace(strString, "[/i]", "") strString = Replace(strString, "[u]", "") strString = Replace(strString, "[linha]", "

") strString = Replace(strString, "[justificar]", "
") strString = Replace(strString, "[/justificar]", "
") strString = Replace(strString, "[/alinhar]", "") strString = Replace(strString, "[alinhar=esquerda]", "
") strString = Replace(strString, "[alinhar=direita]", "
") strString = Replace(strString, "[/u]", "") strString = Replace(strString, "[centralizar]", "
") strString = Replace(strString, "[/centralizar]", "
") strString = Replace(strString, "[comentario]", "
") strString = Replace(strString, "[/comentario]", "
") strString = Replace(strString, "[lista]", "
    ") strString = Replace(strString, "[item]", "
  • ") strString = Replace(strString, "[/lista]", "
") strString = Replace(strString, "[/fonte]", "") strString = Replace(strString, "[fonte=Andale Mono]", "") strString = Replace(strString, "[fonte=Arial]", "") strString = Replace(strString, "[fonte=Arial Black]", "") strString = Replace(strString, "[fonte=Book Antiqua]", "") strString = Replace(strString, "[fonte=Century Gothic]", "") strString = Replace(strString, "[fonte=Comic Sans MS]", "") strString = Replace(strString, "[fonte=Courier New]", "") strString = Replace(strString, "[fonte=Georgia]", "") strString = Replace(strString, "[fonte=Impact]", "") strString = Replace(strString, "[fonte=Tahoma]", "") strString = Replace(strString, "[fonte=Times New Roman]", "") strString = Replace(strString, "[fonte=Trebuchet MS]", "") strString = Replace(strString, "[fonte=Script MT Bold]", "") strString = Replace(strString, "[fonte=Stencil]", "") strString = Replace(strString, "[fonte=Verdana]", "") strString = Replace(strString, "[fonte=Lucida Console]", "") strString = Replace(strString, "[/tamanho]", "") strString = Replace(strString, "[/cor]", "") strString = Replace(strString, "[tamanho=1]", "") strString = Replace(strString, "[tamanho=2]", "") strString = Replace(strString, "[tamanho=3]", "") strString = Replace(strString, "[tamanho=4]", "") strString = Replace(strString, "[tamanho=5]", "") strString = Replace(strString, "[tamanho=6]", "") strString = Replace(strString, "[cor=preto]", "") strString = Replace(strString, "[cor=vermelho]", "") strString = Replace(strString, "[cor=amarelo]", "") strString = Replace(strString, "[cor=rosa]", "") strString = Replace(strString, "[cor=verde]", "") strString = Replace(strString, "[cor=laranja]", "") strString = Replace(strString, "[cor=roxo]", "") strString = Replace(strString, "[cor=azul]", "") strString = Replace(strString, "[cor=bege]", "") strString = Replace(strString, "[cor=marron]", "") strString = ContaLink(strString) strString = ContaEmail(strString) Codifica = strString End Function Function Decodifica(strString) strString = Replace(strString, "  ", Chr(32) & Chr(32)) strString = Replace(strString, " ", Chr(13)) strString = Replace(strString, "

", Chr(10) & Chr(10)) strString = Replace(strString, "
", Chr(10)) strString = Replace(strString, "", "[b]") strString = Replace(strString, "", "[/b]") strString = Replace(strString, "", "[i]") strString = Replace(strString, "", "[/i]") strString = Replace(strString, "", "[u]") strString = Replace(strString, "", "[/u]") strString = Replace(strString, "

", "[linha]") strString = Replace(strString, "
", "[justificar]") strString = Replace(strString, "
", "[/justificar]") strString = Replace(strString, "
", "[/alinhar]") strString = Replace(strString, "
", "[alinhar=esquerda]") strString = Replace(strString, "
", "[alinhar=direita]") strString = Replace(strString, "
", "[centralizar]") strString = Replace(strString, "
", "[/centralizar]") strString = Replace(strString, "
", "[comentario]") strString = Replace(strString, "
", "[/comentario]") strString = Replace(strString, "
    ", "[lista]") strString = Replace(strString, "
  • ", "[item]") strString = Replace(strString, "
", "[/lista]") strString = Replace(strString, "", "[/fonte]") strString = Replace(strString, "", "[fonte=Andale Mono]") strString = Replace(strString, "", "[fonte=Arial]") strString = Replace(strString, "", "[fonte=Arial Black]") strString = Replace(strString, "", "[fonte=Book Antiqua]") strString = Replace(strString, "", "[fonte=Century Gothic]") strString = Replace(strString, "", "[fonte=Comic Sans MS]") strString = Replace(strString, "", "[fonte=Courier New]") strString = Replace(strString, "", "[fonte=Georgia]") strString = Replace(strString, "", "[fonte=Impact]") strString = Replace(strString, "", "[fonte=Tahoma]") strString = Replace(strString, "", "[fonte=Times New Roman]") strString = Replace(strString, "", "[fonte=Trebuchet MS]") strString = Replace(strString, "", "[fonte=Script MT Bold]") strString = Replace(strString, "", "[fonte=Stencil]") strString = Replace(strString, "", "[fonte=Verdana]") strString = Replace(strString, "", "[fonte=Lucida Console]") strString = Replace(strString, "", "[/tamanho]") strString = Replace(strString, "", "[/cor]") strString = Replace(strString, "", "[tamanho=1]") strString = Replace(strString, "", "[tamanho=2]") strString = Replace(strString, "", "[tamanho=3]") strString = Replace(strString, "", "[tamanho=4]") strString = Replace(strString, "", "[tamanho=5]") strString = Replace(strString, "", "[tamanho=6]") strString = Replace(strString, "", "[cor=preto]") strString = Replace(strString, "", "[cor=vermelho]") strString = Replace(strString, "", "[cor=amarelo]") strString = Replace(strString, "", "[cor=rosa]") strString = Replace(strString, "", "[cor=verde]") strString = Replace(strString, "", "[cor=laranja]") strString = Replace(strString, "", "[cor=roxo]") strString = Replace(strString, "", "[cor=azul]") strString = Replace(strString, "", "[cor=bege]") strString = Replace(strString, "", "[cor=marron]") strString = Replace(strString, "", "[cor=marron]") strString = VerEmail(strString) strString = VerLink(strString) strString = Replace(strString, "", "") Decodifica = strString End Function Function VerLink(strString) oTag = "####" c1Tag = "####" oTag2 = " 0) And (c1TagPos > 0) Then strArray = Split(strString, oTag, -1, 1) For counter2 = 0 To UBound(strArray) If (InStr(1, strArray(counter2), c2Tag, 1) > 0) Or (InStr(1, strArray(counter2), c1Tag, 1) > 0) Then strArray2 = Split(strArray(counter2), c1Tag, -1, 1) If InStr(1, strArray2(1), c2Tag, 1) And Not ((InStr(1, UCase(strArray2(1)), "[link]", 1) > 0) And Not (InStr(1, UCase(strArray2(1)), "[/link]", 1) > 0)) Then strFirstPart = Left(strArray2(1), InStr(1, strArray2(1), c2Tag, 1) - 1) strSecondPart = Right(strArray2(1), (Len(strArray2(1)) - InStr(1, strArray2(1), c2Tag, 1) - Len(c2Tag) + 1)) If strFirstPart <> "" Then If (InStr(strArray2(0), "@") > 0) And UCase(Left(strArray2(0), 7)) <> "MAILTO:" Then strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag Else strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag End If Else If (InStr(strArray2(0), "@") > 0) And UCase(Left(strArray2(0), 7)) <> "MAILTO:" Then strTempString = strTempString & roTag & strArray2(0) & rc1Tag & rc2Tag Else strTempString = strTempString & roTag & strArray2(0) & rc1Tag & rc2Tag End If End If Else strTempString = strTempString & roTag & strArray2(0) & rc1Tag & rc2Tag End If ElseIf (InStr(1, strArray(counter2), c1Tag, 1) > 0) Then strArray2 = Split(strArray(counter2), c1Tag, -1) strTempString = strTempString & roTag & strArray2(0) & rc1Tag & rc2Tag Else strTempString = strTempString & strArray(counter2) End If Next Else strTempString = strString End If oTagpos2 = InStr(1, strTempString, oTag2, 1) c1TagPos2 = InStr(1, strTempString, c1Tag2, 1) If (oTagpos2 > 0) And (c1TagPos2 > 0) Then strTempString2 = "" strArray = Split(strTempString, oTag2, -1, 1) For counter3 = 0 To UBound(strArray) If (InStr(1, strArray(counter3), c1Tag2, 1) > 0) Then strArray2 = Split(strArray(counter3), c1Tag2, -1, 1) vararray = Replace(strArray2(1), strArray2(0), "") If (InStr(strArray2(0), "@") > 0) And UCase(Left(strArray2(0), 7)) <> "MAILTO:" Then strTempString2 = strTempString2 & roTag & strArray2(0) & rc1Tag & rc2Tag & vararray Else strTempString2 = strTempString2 & roTag & strArray2(0) & rc1Tag & rc2Tag & vararray End If Else strTempString2 = strTempString2 & strArray(counter3) End If Next strTempString = strTempString2 End If VerLink = strTempString End Function Function VerEmail(strString) oTag = "####" c1Tag = "####" oTag2 = " 0) And (c1TagPos > 0) Then strArray = Split(strString, oTag, -1, 1) For counter2 = 0 To UBound(strArray) If (InStr(1, strArray(counter2), c2Tag, 1) > 0) Or (InStr(1, strArray(counter2), c1Tag, 1) > 0) Then strArray2 = Split(strArray(counter2), c1Tag, -1, 1) If InStr(1, strArray2(1), c2Tag, 1) And Not ((InStr(1, UCase(strArray2(1)), "[email]", 1) > 0) And Not (InStr(1, UCase(strArray2(1)), "[/email]", 1) > 0)) Then strFirstPart = Left(strArray2(1), InStr(1, strArray2(1), c2Tag, 1) - 1) strSecondPart = Right(strArray2(1), (Len(strArray2(1)) - InStr(1, strArray2(1), c2Tag, 1) - Len(c2Tag) + 1)) If strFirstPart <> "" Then If (InStr(strArray2(0), "@") > 0) And UCase(Left(strArray2(0), 7)) <> "MAILTO:" Then strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag Else strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag End If Else If (InStr(strArray2(0), "@") > 0) And UCase(Left(strArray2(0), 7)) <> "MAILTO:" Then strTempString = strTempString & roTag & strArray2(0) & rc1Tag & rc2Tag Else strTempString = strTempString & roTag & strArray2(0) & rc1Tag & rc2Tag End If End If Else strTempString = strTempString & roTag & strArray2(0) & rc1Tag & rc2Tag End If ElseIf (InStr(1, strArray(counter2), c1Tag, 1) > 0) Then strArray2 = Split(strArray(counter2), c1Tag, -1) strTempString = strTempString & roTag & strArray2(0) & rc1Tag & rc2Tag Else strTempString = strTempString & strArray(counter2) End If Next Else strTempString = strString End If oTagpos2 = InStr(1, strTempString, oTag2, 1) c1TagPos2 = InStr(1, strTempString, c1Tag2, 1) If (oTagpos2 > 0) And (c1TagPos2 > 0) Then strTempString2 = "" strArray = Split(strTempString, oTag2, -1, 1) For counter3 = 0 To UBound(strArray) If (InStr(1, strArray(counter3), c1Tag2, 1) > 0) Then strArray2 = Split(strArray(counter3), c1Tag2, -1, 1) vararray = Replace(strArray2(1), strArray2(0), "") If (InStr(strArray2(0), "@") > 0) And UCase(Left(strArray2(0), 7)) <> "MAILTO:" Then strTempString2 = strTempString2 & roTag & strArray2(0) & rc1Tag & rc2Tag & vararray Else strTempString2 = strTempString2 & roTag & strArray2(0) & rc1Tag & rc2Tag & vararray End If Else strTempString2 = strTempString2 & strArray(counter3) End If Next strTempString = strTempString2 End If VerEmail = strTempString End Function Function ContaLink(strString) oTag = "[link=""" oTag2 = "[link]" roTag = " 0) And (c1TagPos > 0) Then strArray = Split(strString, oTag, -1, 1) For counter2 = 0 To UBound(strArray) If (InStr(1, strArray(counter2), c2Tag, 1) > 0) Or (InStr(1, strArray(counter2), c1Tag, 1) > 0) Then strArray2 = Split(strArray(counter2), c1Tag, -1, 1) If InStr(1, strArray2(1), c2Tag, 1) And Not ((InStr(1, UCase(strArray2(1)), "[link]", 1) > 0) And Not (InStr(1, UCase(strArray2(1)), "[/link]", 1) > 0)) Then strFirstPart = Left(strArray2(1), InStr(1, strArray2(1), c2Tag, 1) - 1) strSecondPart = Right(strArray2(1), (Len(strArray2(1)) - InStr(1, strArray2(1), c2Tag, 1) - Len(c2Tag) + 1)) If strFirstPart <> "" Then If (InStr(strArray2(0), "@") > 0) And UCase(Left(strArray2(0), 7)) <> "MAILTO:" Then strTempString = strTempString & roTag & "http://" & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart Else strTempString = strTempString & roTag & "http://" & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart End If Else If (InStr(strArray2(0), "@") > 0) And UCase(Left(strArray2(0), 7)) <> "MAILTO:" Then strTempString = strTempString & roTag & "http://" & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strSecondPart Else strTempString = strTempString & roTag & "http://" & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strSecondPart End If End If Else strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1) End If ElseIf (InStr(1, strArray(counter2), c1Tag, 1) > 0) Then strArray2 = Split(strArray(counter2), c1Tag, -1) strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1) Else strTempString = strTempString & strArray(counter2) End If Next Else strTempString = strString End If oTagpos2 = InStr(1, strTempString, oTag2, 1) c1TagPos2 = InStr(1, strTempString, c1Tag2, 1) If (oTagpos2 > 0) And (c1TagPos2 > 0) Then strTempString2 = "" strArray = Split(strTempString, oTag2, -1, 1) For counter3 = 0 To UBound(strArray) If (InStr(1, strArray(counter3), c1Tag2, 1) > 0) Then strArray2 = Split(strArray(counter3), c1Tag2, -1, 1) If (InStr(strArray2(0), "@") > 0) And UCase(Left(strArray2(0), 7)) <> "MAILTO:" Then strTempString2 = strTempString2 & roTag & "http://" & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1) Else strTempString2 = strTempString2 & roTag & "http://" & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1) End If Else strTempString2 = strTempString2 & strArray(counter3) End If Next strTempString = strTempString2 End If ContaLink = strTempString End Function Function ContaEmail(strString) oTag = "[email=""" oTag2 = "[email]" roTag = " 0) And (c1TagPos > 0) Then strArray = Split(strString, oTag, -1, 1) For counter2 = 0 To UBound(strArray) If (InStr(1, strArray(counter2), c2Tag, 1) > 0) Or (InStr(1, strArray(counter2), c1Tag, 1) > 0) Then strArray2 = Split(strArray(counter2), c1Tag, -1, 1) If InStr(1, strArray2(1), c2Tag, 1) And Not ((InStr(1, UCase(strArray2(1)), "[email]", 1) > 0) And Not (InStr(1, UCase(strArray2(1)), "[/email]", 1) > 0)) Then strFirstPart = Left(strArray2(1), InStr(1, strArray2(1), c2Tag, 1) - 1) strSecondPart = Right(strArray2(1), (Len(strArray2(1)) - InStr(1, strArray2(1), c2Tag, 1) - Len(c2Tag) + 1)) If strFirstPart <> "" Then If (InStr(strArray2(0), "@") > 0) And UCase(Left(strArray2(0), 7)) <> "MAILTO:" Then strTempString = strTempString & roTag & "mailto:" & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart Else strTempString = strTempString & roTag & "mailto:" & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart End If Else If (InStr(strArray2(0), "@") > 0) And UCase(Left(strArray2(0), 7)) <> "MAILTO:" Then strTempString = strTempString & roTag & "mailto:" & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strSecondPart Else strTempString = strTempString & roTag & "mailto:" & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strSecondPart End If End If Else strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1) End If ElseIf (InStr(1, strArray(counter2), c1Tag, 1) > 0) Then strArray2 = Split(strArray(counter2), c1Tag, -1) strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1) Else strTempString = strTempString & strArray(counter2) End If Next Else strTempString = strString End If oTagpos2 = InStr(1, strTempString, oTag2, 1) c1TagPos2 = InStr(1, strTempString, c1Tag2, 1) If (oTagpos2 > 0) And (c1TagPos2 > 0) Then strTempString2 = "" strArray = Split(strTempString, oTag2, -1, 1) For counter3 = 0 To UBound(strArray) If (InStr(1, strArray(counter3), c1Tag2, 1) > 0) Then strArray2 = Split(strArray(counter3), c1Tag2, -1, 1) If (InStr(strArray2(0), "@") > 0) And UCase(Left(strArray2(0), 7)) <> "MAILTO:" Then strTempString2 = strTempString2 & roTag & "mailto:" & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1) Else strTempString2 = strTempString2 & roTag & "mailto:" & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1) End If Else strTempString2 = strTempString2 & strArray(counter3) End If Next strTempString = strTempString2 End If ContaEmail = strTempString End Function Sub BuildUploadRequest(RequestBin) PosBeg = 1 PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(13))) boundary = MidB(RequestBin, PosBeg, PosEnd - PosBeg) BoundaryPos = InStrB(1, RequestBin, boundary) Do Until (BoundaryPos = InStrB(RequestBin, boundary & getByteString("--"))) Dim UploadControl Set UploadControl = CreateObject("Scripting.Dictionary") Pos = InStrB(BoundaryPos, RequestBin, getByteString("Content-Disposition")) Pos = InStrB(Pos, RequestBin, getByteString("name=")) PosBeg = Pos + 6 PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(34))) Name = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg)) PosFile = InStrB(BoundaryPos, RequestBin, getByteString("filename=")) PosBound = InStrB(PosEnd, RequestBin, boundary) If PosFile <> 0 And (PosFile < PosBound) Then PosBeg = PosFile + 10 PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(34))) FileName = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg)) UploadControl.Add "FileName", FileName Pos = InStrB(PosEnd, RequestBin, getByteString("Content-Type:")) PosBeg = Pos + 14 PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(13))) ContentType = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg)) UploadControl.Add "ContentType", ContentType PosBeg = PosEnd + 4 PosEnd = InStrB(PosBeg, RequestBin, boundary) - 2 Value = MidB(RequestBin, PosBeg, PosEnd - PosBeg) Else Pos = InStrB(Pos, RequestBin, getByteString(Chr(13))) PosBeg = Pos + 4 PosEnd = InStrB(PosBeg, RequestBin, boundary) - 2 Value = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg)) End If UploadControl.Add "Value", Value UploadRequest.Add Name, UploadControl BoundaryPos = InStrB(BoundaryPos + LenB(boundary), RequestBin, boundary) Loop End Sub Function getByteString(StringStr) For i = 1 To Len(StringStr) Char = Mid(StringStr, i, 1) getByteString = getByteString & ChrB(AscB(Char)) Next End Function Function getString(StringBin) getString = "" For intCount = 1 To LenB(StringBin) getString = getString & Chr(AscB(MidB(StringBin, intCount, 1))) Next End Function %>