Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Web 1

UTF-8 no MSYQL

Recommended Posts

Ola pessoal estou tentando usar o utf-8 gravando no mysql, estou usando os códigos abaixo, porem ele grava os caracteres errados, gostaria de grava-los normalmente com os acentos para poder utilizar o utf-8 no site.

 

funcoesupload.asp

<%
' Upload Sem componentes ---------------------------------------
Sub BuildUploadRequest(RequestBin)
on error resume next

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

' Fim upload sem Componentes -----------------------------------------
%>

 

 

pagina.asp


<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
Response.ContentType = "text/html"
Response.AddHeader "Content-Type", "text/html;charset=UTF-8"
Response.CodePage = 65001
Response.CharSet = "UTF-8"
%>

<!-- #include file = "funcoesupload.asp" -->

<!DOCTYPE HTML>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<title>Titulo</title>
</head>

<body>

<form onSubmit="return valida_campo()" name="form" action="?cadastra=1" method="post" enctype="multipart/form-data">
Nome:
<input name="nome" type="text" id="nome" size="50" maxlength="255">
<br>
Imagem:
<input name="imagem1" type="file" id="imagem1" size="40">
<br>
<input name="submit" type="submit" id="submit" value="Cadastrar">
</form>


<%
If Request.Querystring("cadastra")="1" Then

' Chamando Funções, que fazem o Upload funcionar
byteCount = Request.TotalBytes
RequestBin = Request.BinaryRead(byteCount)
Set UploadRequest = CreateObject("Scripting.Dictionary")
BuildUploadRequest RequestBin

' Recuperando os Dados Digitados ----------------------
nome = replace(UploadRequest.Item("nome").Item("Value"), "'", "")

' Tipo de arquivo que esta sendo enviado
tipo_arquivo1 = UploadRequest.Item("imagem1").Item("ContentType") 'arquivo1
'tipo_arquivo1 = ""

' Caminho completo dos arquivos enviados
caminho_arquivo1 = UploadRequest.Item("imagem1").Item("FileName") ' arquivo1
'caminho_arquivo1 = ""

' Nome dos arquivos enviados
nome_arquivo1 = Right(caminho_arquivo1,Len(caminho_arquivo1)-InstrRev(caminho_arquivo1,"\"))
nome_arquivo1 = Right(nome_arquivo1, len(nome_arquivo1)-Instr(nome_arquivo1,".")+1)
Novo_nome = "CategMat1_"&Replace(date, "/","")&Hour(time)&Minute(time)&second(time)  'novo nome do arquivo (arquivo1)
nome_arquivo1 = novo_nome&nome_arquivo1

' Conteudo binario dos arquivos enviados
arquivo1 = UploadRequest.Item("imagem1").Item("Value")
'arquivo1 = ""

' pasta onde as imagens serao guardadas
pasta1 = Server.MapPath("../uploads/"&nome_arquivo1&"")

' Fazendo o Upload do arquivo selecionado
if arquivo1 <> "" then
Set ScriptObject = Server.CreateObject("Scripting.FileSystemObject")
Set MyFile = ScriptObject.CreateTextFile(pasta1)
For i = 1 to LenB(arquivo1)
MyFile.Write chr(AscB(MidB(arquivo1,i,1)))
Next
MyFile.Close
end if


Call abre_conexao1(ConnString,Conn)
mysql = "SELECT * FROM categoriamateria where CategMatNome='"&nome&"'"
set RS = Conn.Execute(mysql)

If not RS.eof then
response.redirect "categoriamateria_erro.asp?erro=existe_cadastro"
response.end()
RS.Close 
Set RS = Nothing
End If
Call fecha_conexao1()

'arquivo 1
'----------------------------------------------------------------------------------
If arquivo1 = "" Then
arquivo1grava = ""
Else
arquivo1grava = nome_arquivo1
End IF

'----------------------------------------------------------------------------------

Call abre_conexao1(ConnString,Conn)
sql = "Insert Into categoriamateria (CategMatNome, CategMatImagem1) VALUES ('" & nome & "', '" & arquivo1grava & "')"
Conn.Execute(sql)
Call fecha_conexao1() 

Response.Redirect "categoriamateria.asp"

'----------------------------------------------------------------------------------

End If

%>


</body>
</html>


 

E seu mando gravar

 

ááá ããã âââ ççç

 

Ele esta gravando

 

ááá ããã âââ ççç

 

O que devo fazer?

Compartilhar este post


Link para o post
Compartilhar em outros sites

use assim

 

 

 

Mude o head da página que solicita os dados para que ele fique assim

<meta http-equiv="content-type" content="text/html; charset=utf-8" />

 

Na página que responde os dados colocar isso antes do retorno co conteúdo (logo no topo):

<%
Response.AddHeader "Content-Type", "text/html; charset=utf-8"
Response.AddHeader "Pragma", "no-cache"
response.Charset="utf-8"
%>

 

e para ISO-8859-1

 

<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"
Response.Charset="ISO-8859-1" %>

Compartilhar este post


Link para o post
Compartilhar em outros sites

Viu que no meu código eu faço tudo em uma pagina só com Request.Querystring ficando assim

 

Inicio Pagina

 

Formulário

 

If Request.Querystring("cadastra") = 1 Then

 

Cadastro

 

End If

 

Fim da Pagina

 

Como ficaria?

Compartilhar este post


Link para o post
Compartilhar em outros sites

adicione o

<%
Response.AddHeader "Content-Type", "text/html; charset=utf-8"
Response.AddHeader "Pragma", "no-cache"
response.Charset="utf-8"
%>

Compartilhar este post


Link para o post
Compartilhar em outros sites

Ainda continua cadastrando os caracteres errados.

 

cadastro.asp

<!DOCTYPE HTML>
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=utf-8" />
<!-- InstanceBeginEditable name="doctitle" -->
<%
Response.AddHeader "Content-Type", "text/html; charset=utf-8"
Response.AddHeader "Pragma", "no-cache"
response.Charset="utf-8"
%>
<title><%=TituloSite%></title>

<!-- #include file = "upload.asp" -->

<form onSubmit="return valida_campo()" name="form" action="?cadastra=1" method="post" enctype="multipart/form-data">
<table width="100%" border="0" cellpadding="2" cellspacing="0">

         <tr> 
           <td width="150" class="textoform">Nome:</td>
           <td><input name="nome" type="text" class="CampoForm_a" id="nome" size="50" maxlength="255"></td>
         </tr>
         <tr>
           <td class="textoform">Imagem:</td>
           <td><input name="imagem1" type="file" id="imagem1" size="40" class="CampoForm_a"></td>
         </tr>
         <tr> 
           <td height="32"></td>
           <td class="textos"> 
             <input name="submit" type="submit" id="submit" class="BotaoForm_a" value="Cadastrar"></td>
         </tr>

     </table>

</form>

<%
If Request.Querystring("cadastra")="1" Then

' Chamando Funções, que fazem o Upload funcionar
byteCount = Request.TotalBytes
RequestBin = Request.BinaryRead(byteCount)
Set UploadRequest = CreateObject("Scripting.Dictionary")
BuildUploadRequest RequestBin

' Recuperando os Dados Digitados ----------------------
nome = replace(UploadRequest.Item("nome").Item("Value"), "'", "")
exibir = UploadRequest.Item("exibir").Item("Value")
aprovado = UploadRequest.Item("aprovado").Item("Value")


' Tipo de arquivo que esta sendo enviado
tipo_arquivo1 = UploadRequest.Item("imagem1").Item("ContentType") 'arquivo1
'tipo_arquivo1 = ""

' Caminho completo dos arquivos enviados
caminho_arquivo1 = UploadRequest.Item("imagem1").Item("FileName") ' arquivo1
'caminho_arquivo1 = ""

' Nome dos arquivos enviados
nome_arquivo1 = Right(caminho_arquivo1,Len(caminho_arquivo1)-InstrRev(caminho_arquivo1,"\"))
nome_arquivo1 = Right(nome_arquivo1, len(nome_arquivo1)-Instr(nome_arquivo1,".")+1)
Novo_nome = "CategMat1_"&Replace(date, "/","")&Hour(time)&Minute(time)&second(time)  'novo nome do arquivo (arquivo1)
nome_arquivo1 = novo_nome&nome_arquivo1

' Conteudo binario dos arquivos enviados
arquivo1 = UploadRequest.Item("imagem1").Item("Value")
'arquivo1 = ""

' pasta onde as imagens serao guardadas
pasta1 = Server.MapPath("../uploads/"&nome_arquivo1&"")

' Fazendo o Upload do arquivo selecionado
if arquivo1 <> "" then
Set ScriptObject = Server.CreateObject("Scripting.FileSystemObject")
Set MyFile = ScriptObject.CreateTextFile(pasta1)
For i = 1 to LenB(arquivo1)
MyFile.Write chr(AscB(MidB(arquivo1,i,1)))
Next
MyFile.Close
end if


Call abre_conexao1(ConnString,Conn)
mysql = "SELECT * FROM categoriamateria where CategMatNome='"&nome&"'"
set RS = Conn.Execute(mysql)

If not RS.eof then
response.redirect "categoriamateria_erro.asp?erro=existe_cadastro"
response.end()
RS.Close 
Set RS = Nothing
End If
Call fecha_conexao1()

'arquivo 1
'----------------------------------------------------------------------------------
If arquivo1 = "" Then
arquivo1grava = ""
Else
arquivo1grava = nome_arquivo1
End IF

'----------------------------------------------------------------------------------

Call abre_conexao1(ConnString,Conn)
sql = "Insert Into categoriamateria (CategMatNome, CategMatImagem1) VALUES ('" & nome & "', '" & arquivo1grava & "')"
Conn.Execute(sql)
Call fecha_conexao1() 

Response.Redirect "categoriamateria.asp"

'----------------------------------------------------------------------------------

End If

%>

 

upload.asp

<%
' Upload Sem componentes ---------------------------------------
Sub BuildUploadRequest(RequestBin)
on error resume next

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

' Fim upload sem Componentes -----------------------------------------
%>

Compartilhar este post


Link para o post
Compartilhar em outros sites

coloque também no upload

Compartilhar este post


Link para o post
Compartilhar em outros sites

Olá também tive grandes problemas em upload com utf-8, eu uso essa classe aqui, se quiser usar esta classe diga-me o seu email para lhe enviar a classe corrigida para utf-8

Compartilhar este post


Link para o post
Compartilhar em outros sites

Ola saloeric, obrigado pela dica, por favor posta aqui, com isso todos terão posteriormente a questão solucionada com este tópico.

Compartilhar este post


Link para o post
Compartilhar em outros sites

cá vai então, são 2 classes:

 

a classe "clsUpload.asp"



<!--METADATA
TYPE="TypeLib"
NAME="Microsoft ActiveX Data Objects 2.5 Library"
UUID="{00000205-0000-0010-8000-00AA006D2EA4}"
VERSION="2.5"
-->
<!--#INCLUDE FILE="clsField.asp"-->
<%

' ----------------------------------------------------------------------------------
'  Liberum Help Desk, Copyright (C) 2000-2004 Doug Luxem
'  Liberum Help Desk comes with ABSOLUTELY NO WARRANTY
'  Please view the license.html file for the full GNU General Public License.
'
'  Filename: clsUpload.asp
'  Date:     $Date: 2004/03/11 06:29:08 $
'  Version:  $Revision: 1.2 $
'  Purpose:  Object to assist when working with Attachments
' ----------------------------------------------------------------------------------


' ------------------------------------------------------------------------------
'	Author:		Lewis Moten
'	Email:		Lewis@Moten.com
'	URL:		http://www.lewismoten.com
'	Date:		March 19, 2002
' ------------------------------------------------------------------------------

' Upload class retrieves multi-part form data posted to web page
' and parses it into objects that are easy to interface with.
' Requires MDAC (ADODB) COM components found on most servers today
' Additional compenents are not necessary.
'
' Demo:
'	Set objUpload = new clsUpload
'		Initializes object and parses all posted multi-part from data.
'		Once this as been done, Access to the Request object is restricted
'
'	objUpload.Count
'		Number of fields retrieved
'
'		use: Response.Write "There are " & objUpload.Count & " fields."
'
'	objUpload.Fields
'		Access to field objects.  This is the default propert so it does
'		not necessarily have to be specified.  You can also determine if
'		you wish to specify the field index, or the field name.
'
'		Use:
'			Set objField = objUpload.Fields("File1")
'			Set objField = objUpload("File1")
'			Set objField = objUpload.Fields(0)
'			Set objField = objUpload(0)
'			Response.Write objUpload("File1").Name
'			Response.Write objUpload(0).Name
'
' ------------------------------------------------------------------------------
'
' List of all fields passed:
'
'	For i = 0 To objUpload.Count - 1
'		Response.Write objUpload(i).Name & "<BR>"
'	Next
'
' ------------------------------------------------------------------------------
'
' HTML needed to post multipart/form-data
'
'<FORM method="post" encType="multipart/form-data" action="Upload.asp">
'	<INPUT type="File" name="File1">
'	<INPUT type="Submit" value="Upload">
'</FORM>

Class clsUpload
' ------------------------------------------------------------------------------

Private mbinData			' bytes visitor sent to server
Private mlngChunkIndex		' byte where next chunk starts
Private mlngBytesReceived	' length of data
Private mstrDelimiter		' Delimiter between multipart/form-data (43 chars)

Private CR					' ANSI Carriage Return
Private LF					' ANSI Line Feed
Private CRLF				' ANSI Carriage Return & Line Feed

Private mobjFieldAry()		' Array to hold field objects
Private mlngCount			' Number of fields parsed

' ------------------------------------------------------------------------------
Private Sub RequestData

	Dim llngLength		' Number of bytes received

	' Determine number bytes visitor sent
	mlngBytesReceived = Request.TotalBytes

	' Store bytes recieved from visitor
	mbinData = Request.BinaryRead(mlngBytesReceived)

End Sub
' ------------------------------------------------------------------------------
Private Sub ParseDelimiter()

	' Delimiter seperates multiple pieces of form data
		' "around" 43 characters in length
		' next character afterwards is carriage return (except last line has two --)
		' first part of delmiter is dashes followed by hex number
		' hex number is possibly the browsers session id?

	' Examples:

	' -----------------------------7d230d1f940246
	' -----------------------------7d22ee291ae0114

	mstrDelimiter = MidB(mbinData, 1, InStrB(1, mbinData, CRLF) - 1)

End Sub
' ------------------------------------------------------------------------------
Private Sub ParseData()

	' This procedure loops through each section (chunk) found within the
	' delimiters and sends them to the parse chunk routine

	Dim llngStart	' start position of chunk data
	Dim llngLength	' Length of chunk
	Dim llngEnd		' Last position of chunk data
	Dim lbinChunk	' Binary contents of chunk

	' Initialize at first character
	llngStart = 1

	' Find start position
	llngStart = InStrB(llngStart, mbinData, mstrDelimiter & CRLF)

	' While the start posotion was found
	While Not llngStart = 0

		' Find the end position (after the start position)
		llngEnd = InStrB(llngStart + 1, mbinData, mstrDelimiter) - 2

		' Determine Length of chunk
		llngLength = llngEnd - llngStart

		' Pull out the chunk
		lbinChunk = MidB(mbinData, llngStart, llngLength)

		' Parse the chunk
		Call ParseChunk(lbinChunk)

		' Look for next chunk after the start position
		llngStart = InStrB(llngStart + 1, mbinData, mstrDelimiter & CRLF)

	Wend

End Sub
' ------------------------------------------------------------------------------
Private Sub ParseChunk(ByRef pbinChunk)

	' This procedure gets a chunk passed to it and parses its contents.
	' There is a general format that the chunk follows.

	' First, the deliminator appears

	' Next, headers are listed on each line that define properties of the chunk.

	'	Content-Disposition: form-data: name="File1"; filename="C:\Photo.gif"
	'	Content-Type: image/gif

	' After this, a blank line appears and is followed by the binary data.

	Dim lstrName			' Name of field
	Dim lstrFileName		' File name of binary data
	Dim lstrContentType		' Content type of binary data
	Dim lbinData			' Binary data
	Dim lstrDisposition		' Content Disposition
	Dim lstrValue			' Value of field

	' Parse out the content dispostion
	lstrDisposition = ParseDisposition(pbinChunk)

		' And Parse the Name
		lstrName = ParseName(lstrDisposition)

		' And the file name
		lstrFileName = ParseFileName(lstrDisposition)

	' Parse out the Content Type
	lstrContentType = ParseContentType(pbinChunk)

	' If the content type is not defined, then assume the
	' field is a normal form field
	If lstrContentType = "" Then

		' Parse Binary Data as Unicode
		lstrValue = CStrU(ParseBinaryData(pbinChunk))

	' Else assume the field is binary data
	Else

		' Parse Binary Data
		lbinData = ParseBinaryData(pbinChunk)

	End If

	' Add a new field
	Call AddField(lstrName, lstrFileName, lstrContentType, lstrValue, lbinData)

End Sub
' ------------------------------------------------------------------------------
Private Sub AddField(ByRef pstrName, ByRef pstrFileName, ByRef pstrContentType, ByRef pstrValue, ByRef pbinData)

	Dim lobjField		' Field object class

	' Add a new index to the field array
	' Make certain not to destroy current fields
	ReDim Preserve mobjFieldAry(mlngCount)

	' Create new field object
	Set lobjField = New clsField

	' Set field properties
	lobjField.Name = pstrName
	lobjField.FilePath = pstrFileName				
	lobjField.ContentType = pstrContentType

	' If field is not a binary file
	If LenB(pbinData) = 0 Then

		lobjField.BinaryData = ChrB(0)
		lobjField.Value = pstrValue
		lobjField.Length = Len(pstrValue)

	' Else field is a binary file
	Else

		lobjField.BinaryData = pbinData
		lobjField.Length = LenB(pbinData)
		lobjField.Value = ""

	End If

	' Set field array index to new field
	Set mobjFieldAry(mlngCount) = lobjField

	' Incriment field count
	mlngCount = mlngCount + 1

End Sub
' ------------------------------------------------------------------------------
Private Function ParseBinaryData(ByRef pbinChunk)

	' Parses binary content of the chunk

	Dim llngStart	' Start Position

	' Find first occurence of a blank line
	llngStart = InStrB(1, pbinChunk, CRLF & CRLF)

	' If it doesn't exist, then return nothing
	If llngStart = 0 Then Exit Function

	' Incriment start to pass carriage returns and line feeds
	llngStart = llngStart + 4

	' Return the last part of the chunk after the start position
	ParseBinaryData = MidB(pbinChunk, llngStart)

End Function
' ------------------------------------------------------------------------------
Private Function ParseContentType(ByRef pbinChunk)

	' Parses the content type of a binary file.
	'	example: image/gif is the content type of a GIF image.

	Dim llngStart	' Start Position
	Dim llngEnd		' End Position
	Dim llngLength	' Length

	' Fid the first occurance of a line starting with Content-Type:
	llngStart = InStrB(1, pbinChunk, CRLF & CStrB("Content-Type:"), vbTextCompare)

	' If not found, return nothing
	If llngStart = 0 Then Exit Function

	' Find the end of the line
	llngEnd = InStrB(llngStart + 15, pbinChunk, CR)

	' If not found, return nothing
	If llngEnd = 0 Then Exit Function

	' Adjust start position to start after the text "Content-Type:"
	llngStart = llngStart + 15

	' If the start position is the same or past the end, return nothing
	If llngStart >= llngEnd Then Exit Function

	' Determine length
	llngLength = llngEnd - llngStart

	' Pull out content type
	' Convert to unicode
	' Trim out whitespace
	' Return results
	ParseContentType = Trim(CStrU(MidB(pbinChunk, llngStart, llngLength)))

End Function
' ------------------------------------------------------------------------------
Private Function ParseDisposition(ByRef pbinChunk)

	' Parses the content-disposition from a chunk of data
	'
	' Example:
	'
	'	Content-Disposition: form-data: name="File1"; filename="C:\Photo.gif"
	'
	'	Would Return:
	'		form-data: name="File1"; filename="C:\Photo.gif"

	Dim llngStart	' Start Position
	Dim llngEnd		' End Position
	Dim llngLength	' Length

	' Find first occurance of a line starting with Content-Disposition:
	llngStart = InStrB(1, pbinChunk, CRLF & CStrB("Content-Disposition:"), vbTextCompare)

	' If not found, return nothing
	If llngStart = 0 Then Exit Function

	' Find the end of the line
	llngEnd = InStrB(llngStart + 22, pbinChunk, CRLF)

	' If not found, return nothing
	If llngEnd = 0 Then Exit Function

	' Adjust start position to start after the text "Content-Disposition:"
	llngStart = llngStart + 22

	' If the start position is the same or past the end, return nothing
	If llngStart >= llngEnd Then Exit Function

	' Determine Length
	llngLength = llngEnd - llngStart

	' Pull out content disposition
	' Convert to Unicode
	' Return Results
	ParseDisposition = CStrU(MidB(pbinChunk, llngStart, llngLength))

End Function
' ------------------------------------------------------------------------------
Private Function ParseName(ByRef pstrDisposition)

	' Parses the name of the field from the content disposition
	'
	' Example
	'
	'	form-data: name="File1"; filename="C:\Photo.gif"
	'
	'	Would Return:
	'		File1

	Dim llngStart	' Start Position
	Dim llngEnd		' End Position
	Dim llngLength	' Length

	' Find first occurance of text name="
	llngStart = InStr(1, pstrDisposition, "name=""", vbTextCompare)

	' If not found, return nothing
	If llngStart = 0 Then Exit Function

	' Find the closing quote
	llngEnd = InStr(llngStart + 6, pstrDisposition, """")

	' If not found, return nothing
	If llngEnd = 0 Then Exit Function

	' Adjust start position to start after the text name="
	llngStart = llngStart + 6

	' If the start position is the same or past the end, return nothing
	If llngStart >= llngEnd Then Exit Function

	' Determine Length
	llngLength = llngEnd - llngStart

	' Pull out field name
	' Return results
	ParseName = Mid(pstrDisposition, llngStart, llngLength)

End Function
' ------------------------------------------------------------------------------
Private Function ParseFileName(ByRef pstrDisposition)
	' Parses the name of the field from the content disposition
	'
	' Example
	'
	'	form-data: name="File1"; filename="C:\Photo.gif"
	'
	'	Would Return:
	'		C:\Photo.gif

	Dim llngStart	' Start Position
	Dim llngEnd		' End Position
	Dim llngLength	' Length

	' Find first occurance of text filename="
	llngStart = InStr(1, pstrDisposition, "filename=""", vbTextCompare)

	' If not found, return nothing
	If llngStart = 0 Then Exit Function

	' Find the closing quote
	llngEnd = InStr(llngStart + 10, pstrDisposition, """")

	' If not found, return nothing
	If llngEnd = 0 Then Exit Function

	' Adjust start position to start after the text filename="
	llngStart = llngStart + 10

	' If the start position is the same of past the end, return nothing
	If llngStart >= llngEnd Then Exit Function

	' Determine length
	llngLength = llngEnd - llngStart

	' Pull out file name
	' Return results
	ParseFileName = Mid(pstrDisposition, llngStart, llngLength)

End Function
' ------------------------------------------------------------------------------
Public Property Get Count()

	' Return number of fields found
	Count = mlngCount

End Property
' ------------------------------------------------------------------------------

Public Default Property Get Fields(ByVal pstrName)

	Dim llngIndex	' Index of current field

	' If a number was passed
	If IsNumeric(pstrName) Then

		llngIndex = CLng(pstrName)

		' If programmer requested an invalid number
		If llngIndex > mlngCount - 1 Or llngIndex < 0 Then
			' Raise an error
			Call Err.Raise(vbObjectError + 1, "clsUpload.asp", "Object does not exist within the ordinal reference.")
			Exit Property
		End If

		' Return the field class for the index specified
		Set Fields = mobjFieldAry(pstrName)

	' Else a field name was passed
	Else

		' convert name to lowercase
		pstrName = LCase(pstrname)

		' Loop through each field
		For llngIndex = 0 To mlngCount - 1

			' If name matches current fields name in lowercase
			If LCase(mobjFieldAry(llngIndex).Name) = pstrName Then

				' Return Field Class
				Set Fields = mobjFieldAry(llngIndex)
				Exit Property

			End If

		Next

	End If

	' If matches were not found, return an empty field
	Set Fields = New clsField

'		' ERROR ON NonExistant:
'		' If matches were not found, raise an error of a non-existent field
'		Call Err.Raise(vbObjectError + 1, "clsUpload.asp", "Object does not exist within the ordinal reference.")
'		Exit Property

End Property
' ------------------------------------------------------------------------------
Private Sub Class_Terminate()

	' This event is called when you destroy the class.
	'
	' Example:
	'	Set objUpload = Nothing
	'
	' Example:
	'	Response.End
	'
	' Example:
	'	Page finnishes executing ...

	Dim llngIndex	' Current Field Index

	' Loop through fields
	For llngIndex = 0 To mlngCount - 1

		' Release field object
		Set mobjFieldAry(llngIndex) = Nothing

	Next

	' Redimension array and remove all data within
	ReDim mobjFieldAry(-1)

End Sub
' ------------------------------------------------------------------------------
Private Sub Class_Initialize()

	' This event is called when you instantiate the class.
	'
	' Example:
	'	Set objUpload = New clsUpload

	' Redimension array with nothing
	ReDim mobjFieldAry(-1)

	' Compile ANSI equivilants of carriage returns and line feeds

	CR = ChrB(Asc(vbCr))	' vbCr		Carriage Return
	LF = ChrB(Asc(vbLf))	' vbLf		Line Feed
	CRLF = CR & LF			' vbCrLf	Carriage Return & Line Feed

	' Set field count to zero
	mlngCount = 0

	' Request data
	Call RequestData

	' Parse out the delimiter
	Call ParseDelimiter()

	' Parse the data
	Call ParseData

End Sub

' ------------------------------------------------------------------------------ Alterada para aceitar utf8 04/11/2011
Private Function CStrU(ByRef pstrANSI)

	Dim llngLength '' # Length of ANSI string
	Dim llngIndex '' # Current position
	Dim bytVal
	Dim intChar

	'' # determine length
	llngLength = LenB(pstrANSI)

	'' # Loop through each character
	llngIndex = 1
	Do While llngIndex <= llngLength

		bytVal = AscB(MidB(pstrANSI, llngIndex, 1))
 		llngIndex = llngIndex + 1

 		If bytVal < &h80 Then
 			 intChar = bytVal
 		ElseIf bytVal < &hE0 Then

  			intChar = (bytVal And &h1F) * &h40

  			bytVal =  AscB(MidB(pstrANSI, llngIndex, 1))
  			llngIndex = llngIndex + 1

  			intChar = intChar + (bytVal And &h3f)

 		ElseIf bytVal < &hF0 Then

  			intChar = (bytVal And &hF) * &h1000

 			 bytVal =  AscB(MidB(pstrANSI, llngIndex, 1))
 			 llngIndex = llngIndex + 1

  			intChar = intChar + (bytVal And &h3F) * &h40

 			 bytVal =  AscB(MidB(pstrANSI, llngIndex, 1))
  			llngIndex = llngIndex + 1

  			intChar = intChar + (bytVal And &h3F)

 		Else
  			intChar = &hBF
 		End If

 		CStrU = CStrU & ChrW(intChar)
	Loop

End Function

' ------------------------------------------------------------------------------
Private Function CStrB(ByRef pstrUnicode)

	' Converts a Unicode string to ANSI
	' Best used for small strings

	Dim llngLength	' Length of ANSI string
	Dim llngIndex	' Current position

	' determine length
	llngLength = Len(pstrUnicode)

	' Loop through each character
	For llngIndex = 1 To llngLength

		' Pull out Unicode character
		' Get Ascii value of Unicode character
		' Get ANSI Character from Ascii
		' Append character to results
		CStrB = CStrB & ChrB(Asc(Mid(pstrUnicode, llngIndex, 1)))

	Next

End Function
' ------------------------------------------------------------------------------
End Class
' ------------------------------------------------------------------------------
%>

 

 

e a classe "clsField.asp"

 




<%
' ----------------------------------------------------------------------------------
'  Liberum Help Desk, Copyright (C) 2000-2004 Doug Luxem
'  Liberum Help Desk comes with ABSOLUTELY NO WARRANTY
'  Please view the license.html file for the full GNU General Public License.
'
'  Filename: clsField.asp
'  Date:     $Date: 2004/03/11 06:29:08 $
'  Version:  $Revision: 1.2 $
'  Purpose:  Class object to assist when working with Attachments
' ----------------------------------------------------------------------------------

' ------------------------------------------------------------------------------
'	Author:		Lewis Moten
'	Email:		Lewis@Moten.com
'	URL:		http://www.lewismoten.com
'	Date:		March 19, 2002
' ------------------------------------------------------------------------------

' Field class represents interface to data passed within one field
'
' Two available methods of getting a field:
'	Set objField = objUpload.Fields("File1")
'	Set objField = objUpload("File1")
'
'
'	objField.Name
'		Name of the field as defined on the form
'
'	objFiled.Filepath
'		Path that file was sent from
'
'		ie: C:\Documents and Settings\lmoten\Desktop\Photo.gif
'
'	objField.FileDir
'		Directory that file was sent from
'
'		ie: C:\Documents and Settings\lmoten\Desktop
'
'	objField.FileExt
'		Uppercase Extension of the file
'
'		ie: GIF
'
'	objField.FileName
'		Name of the file
'
'		use: Response.AddHeader "Content-Disposition", "filename=""" & objField.FileName & """"
'
'		ie: Photo.gif
'
'	objField.ContentType
'		Type of binary data
'
'		use: Response.ContentType = objField.ContentType
'
'		ie: image/gif
'
'	objField.Value
'		Unicode value passed from form.  This value is empty if the field is binary data.
'
'		use: Response.Write "The value of this field is: " & objField.Value
'
'	objField.BinaryData
'		Contents of files binary data. (Integer SubType Array)
'
'		use: Response.BinaryWrite objField.BinaryData
'
'	objField.BLOB
'		Same thing as BinaryData but with a shorter name.  Added to help prevent
'		confusion with database access.
'
'		use: Call lobjRs.Fields("Image").AppendChunk(objField.BLOB)
'
'	objField.Length
'		byte size of Value or BinaryData - depending on type of field
'
'		use: Response.Write "The size of this file is: " & objField.Length
'
'	objField.BinaryAsText()
'		Converts binary data into unicode format.  Useful when you expect the user
'		to upload a text file and you have the need to interact with it.
'
'		use: Response.Write objField.BinaryAsText()
'
'	objField.SaveAs()
'		Saves binary data to a specified path.  This will overwrite any existing files.
'
'		use: objField.SaveAs(Server.MapPath("/Uploads/") & "\" & objField.FileName)
'
' ------------------------------------------------------------------------------
Class clsField

Public Name				' Name of the field defined in form

Private mstrPath		' Full path to file on visitors computer
						' C:\Documents and Settings\lmoten\Desktop\Photo.gif

Public FileDir			' Directory that file existed in on visitors computer
						' C:\Documents and Settings\lmoten\Desktop

Public FileExt			' Extension of the file
						' GIF

Public FileName			' Name of the file
						' Photo.gif

Public ContentType		' Content / Mime type of file
						' image/gif

Public Value			' Unicode value of field (used for normail form fields - not files)

Public BinaryData		' Binary data passed with field (for files)

Public Length			' byte size of value or binary data

Private mstrText		' Text buffer 
							' If text format of binary data is requested more then
							' once, this value will be read to prevent extra processing

' ------------------------------------------------------------------------------
Public Property Get BLOB()
	BLOB = BinaryData
End Property
' ------------------------------------------------------------------------------
Public Function BinaryAsText()

	' Binary As Text returns the unicode equivilant of the binary data.
	' this is useful if you expect a visitor to upload a text file that
	' you will need to work with.

	' NOTICE:
	' NULL values will prematurely terminate your Unicode string.
	' NULLs are usually found within binary files more often then plain-text files.
	' a simple way around this may consist of replacing null values with another character
	' such as a space " "

	Dim lbinBytes
	Dim lobjRs

	' Don't convert binary data that does not exist
	If Length = 0 Then Exit Function
	If LenB(BinaryData) = 0 Then Exit Function

	' If we previously converted binary to text, return the buffered content
	If Not Len(mstrText) = 0 Then
		BinaryAsText = mstrText
		Exit Function
	End If

	' Convert Integer Subtype Array to Byte Subtype Array
	lbinBytes = ASCII2Bytes(BinaryData)

  		' Convert Byte Subtype Array to Unicode String
  		mstrText = Bytes2Unicode(lbinBytes)

  		' Return Unicode Text
   	BinaryAsText = mstrText

End Function
' ------------------------------------------------------------------------------
Public Sub SaveAs(ByRef pstrFileName)

	Dim lobjStream
	Dim lobjRs
	Dim lbinBytes

	' Don't save files that do not posess binary data
	If Length = 0 Then Exit Sub
	If LenB(BinaryData) = 0 Then Exit Sub

	' Create magical objects from never never land
	Set lobjStream = Server.CreateObject("ADODB.Stream")

	' Let stream know we are working with binary data
	lobjStream.Type = adTypeBinary

	' Open stream
	Call lobjStream.Open()

	' Convert Integer Subtype Array to Byte Subtype Array
	lbinBytes = ASCII2Bytes(BinaryData)

	' Write binary data to stream
	Call lobjStream.Write(lbinBytes)

	' Save the binary data to file system
	'	Overwrites file if previously exists!
	Call lobjStream.SaveToFile(pstrFileName, adSaveCreateOverWrite)

	' Close the stream object
	Call lobjStream.Close()

	' Release objects
	Set lobjStream = Nothing

End Sub
' ------------------------------------------------------------------------------
Public Property Let FilePath(ByRef pstrPath)

	mstrPath = pstrPath

	' Parse File Ext
	If Not InStrRev(pstrPath, ".") = 0 Then
		FileExt = Mid(pstrPath, InStrRev(pstrPath, ".") + 1)
		FileExt = UCase(FileExt)
	End If

	' Parse File Name
	If Not InStrRev(pstrPath, "\") = 0 Then
		FileName = Mid(pstrPath, InStrRev(pstrPath, "\") + 1)
	Else ' Added for browsers that don't pass the path
		FileName = pstrPath ' (i.e. only file name is passed).
	End If

	' Parse File Dir
	If Not InStrRev(pstrPath, "\") = 0 Then
		FileDir = Mid(pstrPath, 1, InStrRev(pstrPath, "\") - 1)
	End If

End Property
' ------------------------------------------------------------------------------
Public Property Get FilePath()
	FilePath = mstrPath
End Property
' ------------------------------------------------------------------------------
Private Function ASCII2Bytes(ByRef pbinBinaryData)

	Dim lobjRs
	Dim llngLength
	Dim lbinBuffer

	' get number of bytes
	llngLength = LenB(pbinBinaryData)

	Set lobjRs = Server.CreateObject("ADODB.Recordset")

	' create field in an empty recordset to hold binary data
	Call lobjRs.Fields.Append("BinaryData", adLongVarBinary, llngLength)

	' Open recordset
	Call lobjRs.Open()

	' Add a new record to recordset
	Call lobjRs.AddNew()

	' Populate field with binary data
	Call lobjRs.Fields("BinaryData").AppendChunk(pbinBinaryData & ChrB(0))

	' Update / Convert Binary Data
		' Although the data we have is binary - it has still been
		' formatted as 4 bytes to represent each byte.  When we
		' update the recordset, the Integer Subtype Array that we
		' passed into the Recordset will be converted into a
		' Byte Subtype Array
	Call lobjRs.Update()

	' Request binary data and save to stream
	lbinBuffer = lobjRs.Fields("BinaryData").GetChunk(llngLength)

	' Close recordset
	Call lobjRs.Close()

	' Release recordset from memory
	Set lobjRs = Nothing

	' Return Bytes
	ASCII2Bytes = lbinBuffer

End Function
' ------------------------------------------------------------------------------
Private Function Bytes2Unicode(ByRef pbinBytes)

	Dim lobjRs
	Dim llngLength
	Dim lstrBuffer

	llngLength = LenB(pbinBytes)

	Set lobjRs = Server.CreateObject("ADODB.Recordset")

	' Create field in an empty recordset to hold binary data
   	Call lobjRs.Fields.Append("BinaryData", adLongVarChar, llngLength)

   	' Open Recordset
   	Call lobjRs.Open()

   	' Add a new record to recordset
   	Call lobjRs.AddNew()

   	' Populate field with binary data
   	Call lobjRs.Fields("BinaryData").AppendChunk(pbinBytes)

   	' Update / Convert.
   		' Ensure bytes are proper subtype
   	Call lobjRs.Update()

   	' Request unicode value of binary data
   	lstrBuffer = lobjRs.Fields("BinaryData").Value

   	' Close recordset
   	Call lobjRs.Close()

   	' Release recordset from memory
   	Set lobjRs = Nothing

	' Return Unicode
	Bytes2Unicode = lstrBuffer

End Function

' ------------------------------------------------------------------------------
End Class
' ------------------------------------------------------------------------------
%>


 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Eu sei que vai parecer idiota a pergunta, mas a sua tabela está em utf-8 ou latin1?

 

 

Pois acredito que este seja o seu problema.

As vezes criamos o DB para padrão UTF8 mas ao criar a tabela ela acaba assumindo o padrão do SERVIDOR DO BANCOe não do BANCO ESPECIFICO, entende?

 

:) Aguardo.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Provavelmente deva ser isto! onde posso mudar para utf-8?

 

consegui deixar as tabelas em utf-8 mas nada ainda.

mas nao usei as classes postadas acima.

 

Não teria soluções mesmo sera pessoal?

Estou rodando o forum aqui e na internet mas não encontrei nada.

 

Procurei na net sobre este artigo mas nada para solucionar minha questão, pode colocar como resolvido, porem Não resolvido.

Compartilhar este post


Link para o post
Compartilhar em outros sites

ja ando de volta deste problema a mais de um mes, é daquelas coisas que nao da para perceber :(

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.