Загрузка изображений в базу данных SQLSERVER без компонентов

Автор：Eve Cole Время обновления：2009-06-23 16:41:26

Я только что успешно попробовал загрузить компоненты без компонентов, поэтому предоставляю код, чтобы поделиться со всеми.

/* addemployee.asp */
<html>
<голова>
<title>Дом для сотрудников</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" href="../css/site_css.css" type="text/css">
</head>

<body bgcolor="#FFFFFF" text="#000000" leftmargin="1" topmargin="1">
<form name="form1" Method="post" action="transact1.asp" enctype="multipart/form-data">
<table border="0" cellpacing="0" cellpadding="0">
<тр>
<td colspan="2" bgcolor="#006699" height="15"> </td>
</tr>
<тр>
<td class="textBlack">
<div align="right">Заголовок:</div>
</td>
<тд>
<input type="text" name="txtTitle" size="52" class="textarea">
</td>
</tr>
<тр>
<td class="textBlack">
<div align="right">Категория:</div>
</td>
<тд>
<input type="text" name="txtSort" size="35" class="textarea">
<input type="button" name="Submit2" class="buttonSkid" onclick="selectsort(txtSort);">
</td>
</tr>
<тр>
<td class="textBlack" valign="top">
<div align="right">Текст:</div>
</td>
<тд>
<textarea name="txtContent" rows="15" cols="50" class="textarea"></textarea>
</td>
</tr>
<тр>
<td height="14" class="textBlack" valign="top">
<div align="right">Изображение:</div>
</td>
<td height="14" class="textBlack">
<div align="left">
<input type="file" name="file" size="35" class="textarea">
</div>
</td>
</tr>
<тр>
<td height="42" class="textBlack" valign="top"> </td>
<td height="42" class="textBlack" valign="middle">
<p>1. Контролируйте размер загружаемых изображений в пределах <font color="#FF0000"><b>500 КБ</b></font>, иначе загрузка будет невозможна<br>
2. Размер загружаемого изображения должен быть <font color="#FF0000"><b>150*130 пикселей</b></font><br>.
3. Загрузите загруженное изображение в формате JPG или GIF</p>
</td>
</tr>
<тр>
<td height="39" class="textBlack"> </td>
<td height="39" valign="middle">
<div align="center"><img src="../images/save.gif" width="85" height="19" onClick="if(isOK(form1)){form1.submit()}" >
<img src="../images/close.gif" width="85" height="19" onClick="self.close();" ></div>
</td>
</tr>
</таблица>
</форма>
</тело>
</html>
************************************************* * ***********************

/* transact1.asp*/



<%
Если Request.ServerVariables("REQUEST_METHOD") = "POST" Тогда
Тусклые поля
Тусклый strTitle,strSort,strContent
Dim rs,sSql
Дим iMaxid
Дим стрМаксид
Дим стрлен

Установить поля = GetUpload()
strTitle=BinaryToString(Поля("txtTitle").value)
strSort=BinaryToString(Поля("txtSort").value)
strContent = BinaryToString (Поля («txtContent»). значение)
strSort=split(обрезка(strSort),"-")

если instr(1,lcase(Fields("file").FileName).jpg")=0 и instr(1,lcase(Fields("file").FileName).gif")=0 тогда
response.write "<script Language='javascript'>alert('Загруженные изображения должны быть в формате gif или jpg')</script>"
response.write "<script Language='javascript'>window.location='addemployee.asp';</script>"
Ответ.конец
конец, если

если Поля("файл").Длина>500000 тогда
response.write "<script Language='javascript'>alert('Разрешено загружать только изображения размером не более 500 КБ');</script>"
response.write "<script Language='javascript'>window.location='addemployee.asp';</script>"
ответ.конец
end if

'/*Сохранить в базу данных*/
если Поля("файл").ИмяФайла<>"" тогда
Set rs=Server.CreateObject("ADODB.Recordset")
sSql="выберите * из заказа сотрудника по идентификатору"
rs.open sSql,conn,2,2
если не rs.eof, то
iMaxid=Clng(rs("id"))+1
стрлен = 4-лен (cstr (iMaxid))
strMaxid=строка(strlen,"0") & cstr(iMaxid)
еще
стрМаксид="0001"
конец, если
rs.addnew
rs("id")=strMaxid
rs("title")=strTitle
rs("сортировка")=strSort(0)
rs("img").AppendChunk Fields("file").Value
rs("content")=quoteChg(strContent)
rs("todate")=дата()
RS.обновление
RS.закрыть
response.write "<script Language='javascript'>alert('Добавление записи успешно')</script>"
конец, если
конец, если
%>

************************************************ **********************
/*fupload.inc*/

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
Dim UploadSizeLimit

'********************************* GetUpload ************ **********************
'.Name имя поля формы (<Input Name="..." Type="File,...">)
'.ContentDisposition = Content-Disposition поля формы
'.FileName = имя исходного файла для <тип ввода=файл>
'.ContentType = Content-Type для <input type=file>
'.Value = Двоичное значение исходного поля.
'.Length = длина поля двоичных данных
Функция ПолучитьЗагрузить()
Тусклый результат
Установить результат = Ничего
Если Request.ServerVariables("REQUEST_METHOD") = "POST" Тогда "Метод запроса должен быть "POST"
Dim CT, PosB, граница, длина, PosE
CT = Request.ServerVariables("HTTP_Content_Type") 'считывает заголовок Content-Type
'ответ.запись CT
'приложение/x-www-form-urlencoded
Если LCase(Left(CT, 19)) = "multipart/form-data", то заголовок Content-Type должен быть "multipart/form-data"
«Это запрос на загрузку.
'Получаем границу и длину из заголовка Content-Type
PosB = InStr(LCase(CT), "boundary=") 'Находит границу
Если PosB > 0, то Boundary = Mid(CT, PosB + 9) 'Разделяет границу
Длина = CLng(Request.ServerVariables("HTTP_Content_Length")) 'Получаем заголовок Content-Length
если "" & UploadSizeLimit<>"" тогда
UploadSizeLimit = clng(UploadSizeLimit)
если Длина > UploadSizeLimit, то
'при ошибке возобновить следующий 'Очищает входной буфер
'Response.AddHeader "Соединение", "Закрыть"
'при ошибке переход на 0
Request.BinaryRead(длина)
Err.Raise 2, "GetUpload", "Размер загрузки" & FormatNumber(Length,0) & "B превышает предел " & FormatNumber(UploadSizeLimit,0) & "B"
функция выхода
конец, если
end if

Если длина > 0 и граница <> "" Тогда 'Есть ли необходимая информация о загрузке?
Граница = "--" & Граница
Тусклая голова, двоичный
Binary = Request.BinaryRead(Length) 'Читает двоичные данные от клиента

' Извлекает поля загрузки из двоичных данных
Установить результат = SeparateFields(Двоичный, Граница)
Binary = Empty 'Очистить переменные
Еще
Err.Raise 10, «GetUpload», «Запрос нулевой длины».
Конец, если
Еще
Err.Raise 11, «GetUpload», «Файл не отправлен».
Конец, если
Еще
Err.Raise 1, «GetUpload», «Неверный метод запроса».
Конец, если
Установите GetUpload = Результат
Конечная функция

'************************************ SeparateFields ************ **********************
'Эта функция извлекает поля загрузки из двоичных данных и перенастраивает поля в виде массива
«Двоичный код — это безопасный массив всех необработанных двоичных данных, поступающих на вход.
Функция SeparateFields(Двоичный, Граница)
Dim PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary
Тусклые поля
Граница = StringToBinary(Граница)

PosOpenBoundary = InstrB(Двоичный, Граница)
PosCloseBoundary = InstrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0)

Set Fields = CreateObject("Scripting.Dictionary")

Do While (PosOpenBoundary > 0 и PosCloseBoundary > 0 And Not isLastBoundary)
'Данные заголовка и поля файла/источника
Уменьшить заголовок содержимого, FieldContent
'Поля заголовка
Тусклый Content_Disposition, FormFieldName, SourceFileName, Content_Type
'Вспомогательные переменные
Тусклое поле, TwoCharsAfterEndBoundary
'Получить конец заголовка
PosEndOfHeader = InstrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

'Отделяет заголовок поля
HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)

'Разделяет содержимое поля
FieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)

'Отделяет поля заголовка от заголовка
GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type

'Создайте одно поле и назначьте параметры
Установить поле = CreateUploadField()
Поле.Имя = ИмяПоляФормы
Field.ContentDisposition = Content_Disposition
Field.FilePath = ИмяИсходногоФайла
Поле.ИмяФайла = ПолучитьИмяФайла(ИмяИсходногоФайла)
Field.ContentType = Content_Type
Поле.Значение = Содержимое поля
Field.Length = LenB(FieldContent)

Fields.Add FormFieldName, Field

'Это конечная граница?
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))
'Binary.Mid(PosCloseBoundary + Len(Boundary), 2).String
isLastBoundary = TwoCharsAfterEndBoundary = "--"
If Not isLastBoundary then 'Это не конечная граница - перейдите к следующему полю формы.
PosOpenBoundary = PosCloseBoundary
PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Граница), Двоичный, Граница )
Конец, если
Петля
Установить SeparateFields = Поля
Завершение функции

'********************************* Утилиты ************ **********************
Функция BinaryToString(str)
стрто = ""
для i=1 до lenb(str)
если AscB(MidB(str, i, 1)) > 127, то
strto = strto & chr(Ascb(MidB(str, i, 1))*256+Ascb(MidB(str, i+1, 1)))
я = я + 1
еще
strto = strto & Chr(AscB(MidB(str, i, 1)))
конец, если
следующий
BinaryToString=strto

Конечная функция

Функция StringToBinary(String)
Дим И,Б
От I=1 до len(String)
B = B & ChrB(Asc(Mid(String,I,1)))
Следующий
СтрингтоБинари = Б
Конечная функция

'Отделяет поля заголовка от заголовка загрузки
Функция GetHeadFields (ByVal Head, Content_Disposition, Name, FileName, Content_Type)
Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";"))
Name = (SeparateField(Head, "name=", ";")) 'ltrim
Если Left(Name, 1) = """" Тогда Name = Mid(Name, 2, Len(Name) - 2)
FileName = (SeparateField(Head, "filename=", ";")) 'ltrim
Если Left(FileName, 1) = """" Тогда FileName = Mid(FileName, 2, Len(FileName) - 2)
Content_Type = LTrim(SeparateField(Head, "content-type:", ";"))
Конечная функция

'Разделяет один файл между sStart и sEnd
Функция SeparateField(From, ByVal sStart, ByVal sEnd)
Тусклый PosB, PosE, sFrom
sFrom = LCase(От)
PosB = InStr(sFrom, sStart)
Если PosB > 0 Тогда
PosB = PosB + Len(sStart)
PosE = InStr(PosB, sFrom, sEnd)
Если PosE = 0, то PosE = InStr(PosB, sFrom, vbCrLf)
Если PosE = 0, то PosE = Len(sFrom) + 1
SeparateField = Mid(From, PosB, PosE - PosB)
Еще
СепаратеФилд = Пусто
Конец, если
Конечная функция

'Отделяет имя файла от полного пути к файлу
Функция GetFileName(FullPath)
Дим Пос, ПосФ
ПосФ = 0
Для Pos = Len(FullPath) до 1 Шаг -1
Выберите средний регистр (FullPath, Pos, 1)
Случай "/", "": PosF = Pos + 1: Pos = 0
Конец выбора
Следующий
Если PosF = 0, то PosF = 1
GetFileName = Mid(FullPath, PosF)
Конечная функция
</СКРИПТ>
<SCRIPT RUNAT=ЯЗЫК СЕРВЕРА=JSCRIPT>
//Функция создает объект Field.
функция CreateUploadField() { return new uf_Init() }
функция uf_Init(){
это.Имя = ноль
this.ContentDisposition = ноль
this.FileName = ноль
this.FilePath = ноль
this.ContentType = ноль
это.Значение = ноль
this.Length = ноль
}
</СКРИПТ>