программный код
<%
'******************************
'Имя класса:
'Название: общая библиотека
'Дата: 28 октября 2008 г.
'Автор: xilou
'Веб-сайт: http://www.chinacms.org .
'Описание: Общая библиотека
'Авторское право: При перепечатке указывайте источник и автора.
'******************************
'Последнее изменение: 20090108
'Количество модификаций: 2
'Описание модификации:
'20090108 Добавьте следующие функции:
' A2U(),U2A(),UrlEncode(),UrlDecode(),GBToUTF8(),Bytes2Str(),Str2Bytes()
'20090108 Добавьте следующие функции:
'AryToVbsString(обр.)
'Текущая версия:
'******************************/
'Выход
Суб-эхо (ул.)
Response.Write строка
Конечная
точка
останова
Суб-Остановка()
Ответ.Конец()
End Sub
'Вывод и перенос
Суббр(ул)
Echo str & "<br />" и vbcrlf
End Sub
'Упростить Request.Form()
'f: имя формы
Функция P(f)
P = Заменить(Запрос.Форма(f), Chr(0), "")
Конечная функция
'Получить форму и заменить одинарные кавычки
Функция Pr(f)
Pr = Заменить(Запрос.Форма(f), Chr(0), "")
Pr = Заменить(Pr, "'", "''")
Конечная функция
'Упростить Request.Querystring()
'f: имя формы
ФункцияG(f)
G = Заменить(Request.QueryString(f), Chr(0), "")
Конечная функция
'Получить параметры URL и заменить одинарные кавычки
ФункцияГр(ф)
Gr = Заменить(Request.QueryString(f), Chr(0), "")
Гр = Заменить(Гр, "'", "''")
Конечная функция
'//Construction()?: Тернарная операция от xilou www.chinacms.org
'ifThen возвращает s1 в случае true и s2 в случае false
Функция IfThen(ifTrue, s1, s2)
Дим т
Если еслиистина Тогда
т = с1
Еще
т = с2
Конец, если
ЕслиТо = т
Конечная функция
'Отображать да и нет разными цветами
Функция IfThenFont(ifTrue, s1, s2)
Димстр
Если еслиистина Тогда
str = "<font color=""#006600"">" & s1 & "</font>"
Еще
str = "<font color=""#FF0000"">" & s2 & "</font>"
Конец, если
ЕслиТенФонт = ул
Конечная функция
'Создать объект словаря
Функция НоваяХэшТабле()
Установите NewHashTable = Server.CreateObj("Scripting.Dictionary")
NewHashTable.CompareMode = 1 'Значения ключей не чувствительны к регистру
Конечная функция
«Создать XmlHttp»
Функция НьюXmlHttp()
Установите NewXmlHttp = Server.createobject("MSXML2.XMLHTTP")
Конечная функция
«Создать XmlDom»
Функция НьюXmlDom()
Конечная функция
«Создать AdoStream»
Функция НьюАдоСтрим()
Установите NewAdoStream = Server.CreateObject("Adodb.Stream")
Конечная функция
'Создание одномерного массива
'Возвращаем пустой массив из n элементов
'n: количество элементов
ФункцияNewArray(n)
Dim ary: ary = array()
Повторный размер (n-1)
НовыйМассив = ари
Конечная функция
'Построение Try..Catch
СубПопытка()
При ошибке Возобновить Далее
End Sub
'Construct Try..Catch
'msg: выдается сообщение об ошибке. Если оно пустое, выдается Err.Description.
Дополнительный улов (сообщение)
Тусклый HTML
html = "<ul><li>$1</li></ul>"
Если Ошибка Тогда
Если сообщение <> "" Тогда
echo replace(html, "$1", msg)
Остановиться
Еще
echo replace(html, "$1", Err.Description)
Остановиться
Конец, если
Ошиб.Очистить
Ответ.Конец()
Конец, если
End Sub
'-------------------------------- начинается операция с массивом
'Определить, существует ли определенное значение в массиве
Функция InArray(arr, s)
Если не IsArray(arr), то InArray = False: выход из функции
Дим я
Для i = LBound(arr) To UBound(arr)
Если s = arr(i), то InArray = True: выход из функции
Следующий
Вмассив = Ложь
Конечная функция
'Замените заполнители в str значениями из массива ary.
'Вернем замененную строку
'str: Заменяемая строка, заполнители: $0, $1, $2...
'ary: Массив, используемый для замены, каждое значение соответствует $0, $1, $2... в заполнителе.
'Например: replaceByAry("$0-$1-$2 $3:$4:$5",Array(y,m,d,h,i,s))
Функция replaceByAry(str,ary)
Dim i, j, L1, L2: j = 0
Если IsArray(ary) Тогда
L1 = LBound(ary): L2 = UBound(ary)
Для я = от L1 до L2
str = Заменить(str, "$"&j, ary(i))
j = j+1
Следующий
Конец, если
ЗаменитьByAry = ул
Конечная функция
'-----------------------------операция массива завершается
'------------- --- ---------------Начинается операция случайного числа
'Получить случайные числа
Я случайное число
Функция RndNumber(m,n)
Рандомизировать
RndNumber = Int((n - m + 1) * Rnd + m)
Конечная функция
'Получить случайную строку
'n: сгенерированная длина
Функция RndText(n)
Dim str1, str2, i, x, L
str1 = "NOPQRSTUVWXYZ012ABCDEFGHIJKLM3456abcdefghijklm789nopqrstuvwxyz"
L = Лен(str1)
Рандомизировать
Для i = 1 К n
x = Int((L - 1 + 1) * Rnd + 1)
str2 = str2 & Mid(str1,x,1)
Следующий
РндТекст = стр2
Конечная функция
'Сгенерировать от m до n случайных строк из строки str
'Если строка пуста, по умолчанию будет сгенерирована случайная строка из цифр и букв.
'str: Чтобы сгенерировать случайную строку из этой строки
'm,n: сгенерировать от n до m битов
Функция RndByText(str, m, n)
Дим я,к,стр2,Л,х
Если str = "" Тогда str = "NOPQRSTUVWXYZ012ABCDEFGHIJKLM3456abcdefghijklm789nopqrstuvwxyz"
L = Лен(стр)
Если n = m Тогда
к = п
Еще
Рандомизировать
k = Int((n - m + 1) * Rnd + m)
Конец, если
Рандомизировать
Для i = 1 К k
x = Int((L - 1 + 1) * Rnd + 1)
str2 = str2 & Mid(str, x, 1)
Следующий
RndByText = str2
Конечная функция
'Дата и время формируют случайные числа
'Вернуть комбинацию чисел текущего времени
Функция RndByDateTime()
Тусклый dt: dt = Сейчас()
RndByDateTime = Год (dt) и месяц (dt) и день (dt) и час (dt) и минуты (dt) и секунды (dt)
Конечная функция
'----------------------------- Операция со случайными числами завершается
'--------------- ------ --------------------Начинается строковая операция
'Определяем, сколько раз строка str2 появляется в другой строке str1
'Возвращаем количество раз, если нет, возвращаем 0
'str1: строковое выражение, допускающее поиск
'str2: строковое выражение для поиска
'start: начальная позиция для поиска. Если пусто, это означает, что по умолчанию начинается с 1.
Функция InStrTimes(str1, str2, start)
Дим а, с
Если start="" Тогда start=1
с = 0
а = InStr(начало, строка1, строка2)
Делать, пока a > 0
с = с + 1
а = InStr(a+1, str1, str2)
Петля
ИнСтрТаймс = с
Конечная функция
'Конкатенация строк
'Нет возврата
'strResult: символы, сохраненные после подключения
'str: символ, который нужно объединить
'partition: символ разделения между соединяющими символами
Sub JoinStr(byref strResult,str,partition)
Если strResult <> "" Тогда
стрРезультат = стрРезультат & раздел & стр
Еще
стрРезультат = стр
Конец, если
End Sub
'Вычисляем длину строки в байтах, один китайский иероглиф = 2 байта
ФункцияStrLen(str)
Если isNull(str) или Str = "" Тогда
СтрЛен = 0
Выход из функции
Конец, если
Тусклый WINNT_CHINESE
WINNT_CHINESE = (len("пример")=2)
Если WINNT_CHINESE Тогда
Тусклый л, т, с
Дим я
л = лен(стр)
т = л
Для i = 1 К l
c = возрастание(середина(str,i,1))
Если c<0, то c = c + 65536
Если c>255, то t = t + 1
Следующий
СтрЛен = т
Еще
СтрЛен = лен(стр)
Конец, если
Конечная функция
'Перехватить строку
'str: строка, которую нужно перехватить
'strlen: длина перехватываемого сообщения
' addStr: используйте вместо этого, если оно превышает длину, например:...
Функция CutStr(str, strlen, addStr)
Дим я, л, т, с
Если Is_Empty(str) Тогда CutStr = "": Выход из функции
l = len(str) : t = 0
Для i = 1 К l
c = Abs(Asc(Mid(str,i,1)))
Если с > 255 Тогда
т=т+2
Еще
т=т+1
Конец, если
Если t > strlen Тогда
CutStr = влево (str, i) и addStr
Выход для
Еще
CutStr = ул
Конец, если
Следующий
Конечная функция
'Преобразование полной ширины в половинную ширину
Функция SBCcaseConvert(str)
Дим б, в, я
б = "1,2,3,4,5,6,7,8,9,0", _
&"A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X, Ｙ,Ｚ"
с = "1,2,3,4,5,6,7,8,9,0", _
&"A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X, Ю,З"
б = разделить(б,",")
с = разделить(с,",")
Для i = 0 To Ubound(b)
Если instr(str,b(i)) > 0 Тогда
str = Заменить(str, b(i), c(i))
Конец, если
Следующий
SBCcaseConvert = строка
Конечная функция
эквивалентна escape() в javascript
Функция VbsEscape(стр)
дими,с,с,а
с = ""
От i=1 до Len(str)
c = Середина (str,i,1)
а = АСКВ(с)
Если (a>=48 и a<=57) или (a>=65 и a<=90) или (a>=97 и a<=122) Тогда
s = s&c
ElseIf InStr("@*_+-./",c) > 0 Тогда
s = s&c
ИначеЕсли a>0 и a<16 Тогда
s = s & "%0" & Hex(a)
ИначеЕсли a>=16 и a<256 Тогда
s = s & "%" & Hex(a)
Еще
s = s & "%u" & Hex(a)
Конец, если
Следующий
VbsEscape=s
Конечная функция
'Декодировать данные, закодированные с помощью escape() в javascript, используемые при вызове ajax
Функция VbsUnEscape(str)
Тусклый х
x = InStr(str,"%")
Делать, пока x > 0
VbsUnEscape = VbsUnEscape & Mid(str,1,x-1)
Если LCase(Mid(str,x+1,1)) = "u" Тогда
VbsUnEscape = VbsUnEscape & ChrW(CLng("&H"&Mid(str,x+2,4)))
ул = Середина(str,x+6)
Еще
VbsUnEscape = VbsUnEscape & Chr(CLng("&H"&Mid(str,x+1,2)))
ул = Середина(str,x+3)
Конец, если
x = InStr(str,"%")
Петля
VbsUnEscape = VbsUnEscape & строка
Конечная функция
'Преобразуем символы ascii в форму кодировки Unicode
Функция A2U(стр)
Дим я,L,uText
L = Лен(стр)
Для я = 1 до L
uText = uText & "&#" & AscW(Mid(str,i,1)) & ";"
Следующий
A2U = uтекст
Конечная функция
'Преобразовать кодировку Unicode в ascii
'str: строка, подлежащая перекодированию, должна состоять из символов Юникода, в противном случае произойдет ошибка.
Функция U2A(стр)
Dim ary,i,L,newStr
ary = Split(str,";")
L = UBound(арный)
Для i = 0 К L - 1
newStr = newStr & ChrW(Replace(ary(i),"&#",""))
Следующий
U2A = новаяСтрока
Конечная функция
'кодировка URL
Функция UrlEncode(str)
UrlEncode = Server.UrlEncode(str)
Декодирование URL-адреса
конечной функции
ФункцияUrlDecode(str)
Dim newsstr, haschar, Lastchar, я, char_c, next_1_c, next_1_Num
новостистр = ""
иметьchar = ложь
последнийсимвол = ""
Для i = 1 To Len(str)
char_c = Mid(str,i,1)
Если char_c = "+" Тогда
ньюстр = ньюстр & " "
ИначеЕсли char_c = "%" Тогда
next_1_c = Mid(str, i+1, 2)
next_1_num = Cint("&H" & next_1_c)
Если естьчар Тогда
иметьchar = ложь
newstr = newstr & Chr(CInt("&H" &lastchar & next_1_c))
Еще
Если Abs(next_1_num) <= 127 Тогда
newstr = newstr & Chr(next_1_num)
Еще
хавчар = истина
последнийсимвол = next_1_c
Конец, если
Конец, если
я = я + 2
Еще
newstr = newstr и char_c
Конец, если
Следующий
UrlDecode = новая строка
Конечная функция
'GB в UTF8 — конвертировать текст в кодировке GB в текст в кодировке UTF8.
Функция GBToUTF8(gbStr)
Dim wch,uch,szRet,szInput
Тусклый х
Тусклый nAsc, nAsc2, nAsc3
szInput = gbStr
'Если входной параметр пуст, выходим из функции
Если szInput = "" Тогда
toUTF8 = szInput
Выход из функции
Конец, если
'Начать преобразование
Для x = 1 до Len(szInput)
'Используйте функцию Mid для разделения текста, закодированного в ГБ.
wch = Mid(szInput, x, 1)
'Используйте функцию ascW, чтобы вернуть код символа Юникода для каждого текста, закодированного в ГБ.
'Примечание: функция asc возвращает код символа ANSI, обратите внимание на разницу
nAsc = AscW(что)
Если nAsc < 0 Тогда nAsc = nAsc + 65536
Если (nAsc И &HFF80) = 0 Тогда
szRet = szRet & wch
Еще
Если (nAsc И &HF000) = 0 Тогда
uch = "%" & Hex(((nAsc 2 ^ 6)) или &HC0) & Hex(nAsc And &H3F или &H80)
szRet = szRet&uch
Еще
'Код символов Юникода для текста, закодированного в GB, принимает трехбайтовый шаблон между 0800 и FFFF.
uch = "%" & Hex((nAsc 2 ^ 12) или &HE0) & "%" & _
Hex((nAsc2^6) И &H3F или &H80) & "%" & _
Шестнадцатеричный (nAsc и &H3F или &H80)
szRet = szRet&uch
Конец, если
Конец, если
Следующий
GBToUTF8 = сзРет
Конечная функция
'Преобразование из потока байтов в поток символов
Функция Bytes2Str(vin,кодировка)
Тусклый мс,strRet
Set ms = Server.CreateObject("ADODB.Stream") 'Создание объекта потока
ms.Type = 1 'Двоичный
мс.Открыть
ms.Write vin 'Записываем vin в объект потока
ms.Position = 0 'Установите начальную позицию объекта потока на 0, чтобы установить свойство Charset.
ms.Type = 2 'Текст
ms.Charset = charset 'Установить режим кодирования объекта потока в виде набора символов
strRet = ms.ReadText 'Получить поток символов
ms.close 'Закрываем объект потока
Установить мс = ничего
Байтес2Стр = стррет
Конечная функция
'Преобразование потока символов в поток байтов
Функция Str2Bytes(str,кодировка)
Тусклый мс,strRet
Set ms = CreateObject("ADODB.Stream") 'Создание объекта потока
ms.Type = 2 'Текст
ms.Charset = charset 'Установить режим кодирования объекта потока как charset
мс.Открыть
ms.WriteText str 'Записываем str в объект потока
ms.Position = 0 'Установите начальную позицию объекта потока на 0, чтобы установить свойство Charset.
ms.Type = 1 'Двоичный
vout = ms.Read(ms.Size) 'Получить поток символов
ms.close 'Закрываем объект потока
Установить мс = ничего
Str2Bytes = воут
Конечная функция
'--------------------------------Операция со строкой завершается
'------------- -------- --------------------Время и дата начала работы
'Получить соответствующее количество дней в месяце на основе года и месяца
'Вернем количество дней
'y: год, например: 2008
Я: месяц, например: 3
Функция GetDayCount(y,m)
Дим с
Выберите случай м
Случай 1, 3, 5, 7, 8, 10, 12
с=31
Случай 2
Если IsDate(y&"-"&m&"-"&"29") Тогда
с=29
Еще
с=28
Конец, если
Другое дело
с=30
Конец выбора
GetDayCount = с
Конечная функция
«Определите, находятся ли дата и время между определенным периодом времени, включая время на обоих концах сравнения».
Функция IsBetweenTime(fromTime,toTime,strTime)
Если DateDiff("s",fromTime,strTime) >= 0 И DateDiff("s",toTime,strTime) <= 0 Тогда
IsBetweenTime = Истина
Еще
IsBetweenTime = Ложь
Конец, если
Конечная функция
'--------------------------------Время и дата завершения операции
'----------- ---------- --------------------Начинаются операции, связанные с шифрованием безопасности
'----------------------------- Окончание операций, связанных с шифрованием
'---------- ---- -----------------Начинается операция по проверке легальности данных
'Определить строку с помощью регулярного выражения и вернуть true|false
Функция RegExpTest(strPatrn,strText)
Dim objRegExp, совпадения
Установите objRegExp = Новое регулярное выражение.
objRegExp.Pattern = стрПатрн
objRegExp.IgnoreCase = Ложь
objRegExp.Global = Истина
RegExpTest = objRegExp.Test(strText)
'Установить совпадения = objRegExp.Execute(strText)
Установить objRegExp = ничего
Конечная функция
«Это положительное целое число?»
ФункцияIsPint(str)
IsPint = RegExpTest("^[1-9]{1}d*$", str)
Конечная функция
'Будь то 0 или положительное целое число
ФункцияIsInt(str)
IsInt = RegExpTest("^0|([1-9]{1}d*)$", str)
Конечная функция
'Электронная почта
ФункцияIsEmail(str)
Тусклый узор
patrn = "^w+((-w+)|(.w+))*@[A-Za-z0-9]+((.|-)[A-Za-z0-9]+ )*.[A-Za-z0-9]+$"
IsEmail = RegExpTest(patrn,str)
Конечная функция
'сотовый телефон
ФункцияIsMobile(str)
Тусклый узор
patrn = "^(130|131|132|133|153|134|135|136|137|138|139|158|159){1}d{8}$"
IsMobile = RegExpTest(patrn,str)
Конечная функция
'QQ
ФункцияIsQQ(строка)
Тусклый узор
patrn = "^[1-9]d{4,8}$"
IsQQ = RegExpTest(patrn,str)
Конечная функция
'Удостоверение личности
ФункцияIsIdCard(e)
Dim arrVerifyCode,Wi,Checker
arrVerifyCode = Split("1,0,x,9,8,7,6,5,4,3,2", ",")
Wi = Split("7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2", ",")
Checker = Split("1,9,8,7,6,5,4,3,2,1,1", ",")
Если Len(e) < 15 или Len(e) = 16 или Len(e) = 17 или Len(e) > 18 Тогда
ИсИдКард = Ложь
Выход из функции
Конец, если
Дим А
Если Len(e) = 18 Тогда
Ай = Средний(е, 1, 17)
ИначеЕсли Len(e) = 15 Тогда
Ай=е
Ai = Левый (Ai, 6), «19» и Средний (Ai, 7, 9)
Конец, если
Если Не IsNumeric(Ai), Тогда
Исидкарт = ложь
Выход из функции
Конец, если
Тусклый strYear, strMonth, strDay, BirthDay
strYear = CInt(Mid(Ai, 7, 4))
strMonth = CInt(Mid(Ai, 11, 2))
strDay = CInt(Mid(Ai, 13, 2))
День Рождения = Trim(strYear) + "-" + Trim(strMonth) + "-" + Trim(strDay)
Если IsDate(День Рождения) Тогда
Если DateDiff("гггг",Now,BirthDay)<-140 или cdate(BirthDay)>date() Тогда
ИсИдКард= Ложь
Выход из функции
Конец, если
Если strMonth > 12 или strDay > 31 Тогда
ИсИдКард= Ложь
Выход из функции
Конец, если
Еще
ИсИдКард= Ложь
Выход из функции
Конец, если
Дим я, TotalmulAiWi
Для я = от 0 до 16
TotalmulAiWi = TotalmulAiWi + CInt(Mid(Ai, i + 1, 1)) * Wi(i)
Следующий
Dim modValue
modValue = TotalmulAiWi Мод 11
Dim strVerifyCode
strVerifyCode = arrVerifyCode(modValue)
Ай = Ай и стрверикоде
IsIdCard = Ай
Если Len(e) = 18 И e <> Ai Тогда
Исидкарт = ложь
Выход из функции
Конец, если
IsIdCard=Истина
Конечная функция
'Почтовый индекс
Функция IsZipCode(str)
Тусклый узор
patrn = "^[1-9]d{2,5}$"
IsZipCode = RegExpTest(patrn,str)
Конечная функция
'Пустой ли он, включая функции IsEmpty(), IsNull(), ""
Функция Is_Empty(str)
Если IsNull(str) или IsEmpty(str) или str="" Тогда
Is_Empty=Истина
Еще
Is_Empty=Ложь
Конец, если
Конечная функция
'--------------------------------Операция проверки достоверности данных завершается
'--------- -- ---------------------Начинается работа с файлом
'Получаем суффикс файла, например jpg
Функция GetFileExt(f)
GetFileExt = Lcase(Mid(f,InStrRev(f,".") + 1))
Конечная функция
'Создать папку
'путь: путь к создаваемой папке, используйте относительный путь
ПодCFolder(путь)
Тусклый фсо
Установите fso = Server.CreateObject("Scripting.FileSystemObject")
Если нет, fso.FolderExists(путь) Тогда
fso.CreateFolder(путь)
Конец, если
Установить fso = Ничего
Конец подпункта
«Удалить папку»
'path: путь к папке, используйте относительный путь
Подпапка(путь)
Тусклый фсо
Установите fso = Server.CreateObject("Scripting.FileSystemObject")
Если fso.FolderExists(путь) Тогда
путь fso.DeleteFolder, правда
Еще
echo «Путь не существует:» и путь
Конец, если
Установить fso = Ничего
End Sub
'Создать файл
'путь: создать путь к файлу, включая имя
'strText: содержимое файла
Подфайл CFile(путь,strText)
Дим ф, фсо
Установите fso = Server.CreateObject("Scripting.FileSystemObject")
Установите f = fso.CreateTextFile(путь)
е. Напишите strText
Установить f = Ничего
Установить fso = Ничего
End Sub
'Удалить файл
'path: путь к файлу, включая имя
Субфайл(путь)
Тусклый фсо
Установите fso = Server.CreateObject("Scripting.FileSystemObject")
Если fso.FileExists(путь) Тогда
Fso.DeleteFile(путь)
Конец, если
Установить fso = Ничего
Конец подпункта
«Собрать»
Функция GetHTTPPage(url)
'Http.setTimeouts 10000,10000,10000,10000
'При ошибке возобновить далее
Дим HTTP
Установите Http = Server.createobject("MSXML2.XMLHTTP")
Http.open "GET", URL, false
HTTP.send()
Если Http.Status <> 200 Тогда
Выход из функции
Конец, если
'Если ошибка, то Response.Write url: Response.End()
GetHTTPPage = bytesToBSTR(Http.ResponseBody,"GB2312")
'Http.Close()
'если номер ошибки<>0, то err.Clear
Конечная функция
'Преобразование кодировки
Функция BytesToBstr(body,Cset)
DimStreamObj
Установите StreamObj = Server.CreateObject("Adodb.Stream")
StreamObj.Type = 1
StreamObj.Mode = 3
StreamObj.Open
StreamObj. Напишите тело
StreamObj.Position = 0
StreamObj.Type = 2
StreamObj.Charset = Cset
BytesToBstr = StreamObj.ReadText
StreamObj.Close
Конечная функция
'--------------------------------Операция с файлом завершается
'------------- ------------------Начинаются другие операции
'Показать информацию
'message: сообщение, которое будет отображаться
'url: URL-адрес для перехода
'typeNum: режим отображения, 1 отображает всплывающую информацию и возвращает на предыдущую страницу 2 отображает всплывающую информацию и переходит к URL-адресу;
Sub ShowMsg (сообщение, URL, typeNum)
сообщение = replace(сообщение,"'","'")
Выберите тип делаNum
Случай 1
echo ("<script Language=javascript>alert('" & message & "');history.go(-1)</script>")
Случай 2
echo ("<script Language=javascript>alert('" & message & "');location=" & Url &"'</script>")
Конец выбора
End Sub
'Список и положение параметров отображения, автор: xilou www.chinacms.org
'textArr: текстовый массив
'valueArr: массив значений
'curValue: текущее выбранное значение
Функция ShowOpList(textArr, valueArr, curValue)
Дим ул, стиль, я
style = "style=""background-color:#FFCCCC"""
ул = ""
Если IsNull(curValue) Тогда curValue = ""
Для I = LBound(textArr) To UBound(valueArr)
Если Cstr(valueArr(I)) = Cstr(curValue) Тогда
str = str&"<option value="""&valueArr(I)&""" selected=""selected"" "&style&" >"&textArr(I)&"</option>"&vbcrlf
Еще
str = str&"<option value="""&valueArr(I)&""" >"&textArr(I)&"</option>"&vbcrlf
Конец, если
Следующий
ПоказатьОпЛист = ул
Конечная функция
'Список множественного выбора
'Примечание: вам необходимо использовать функцию InArray().
'textArr: текстовый массив
'valueArr: массив значений
'curValue: текущий выбранный массив значений
Функция ShowMultiOpList(textArr,valueArr,curValueArr)
Тусклый стиль, str, isCurr, I
style = "style=""background-color:#FFCCCC"""
str = "" : isCurr = False
Если IsNull(curValue) Тогда curValue = ""
Для I = LBound(textArr) To UBound(valueArr)
Если InArray(curValueArr, valueArr(I)) Тогда
str = str&"<option value="""&valueArr(I)&""" selected=""selected"" "&style&" >"&textArr(I)&"</option>"&vbcrlf
Еще
str = str&"<option value="""&valueArr(I)&""" >"&textArr(I)&"</option>"&vbcrlf
Конец, если
Следующий
ShowMultiOpList = ул
Конечная функция
Функция ПолучитьIP()
Dim strIPAddr,actforip
Если Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" или InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "неизвестно") > 0 Тогда
strIPAddr = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Тогда
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Тогда
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
Еще
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
Конец, если
ПолучитьIP = стрIPАддр
Конечная функция
'Преобразуем массив в хранилище объектов словаря
'hashObj: объект словаря
'ary: Массив, формат должен быть одним из следующих двух, первый может хранить только строковые значения.
' : array("Id:12","UserName:xilou","Sex:1"), то есть формат array("ключ:значение",...)
' : массив(массив("Id","12"),массив("Имя пользователя","xilou"),массив("Пол","1"))
'Вернуть объект словаря
'www.chinacms.org
Sub AryAddToHashTable (ByRef hashObj, ary)
Dim str,ht,i,k,v,pos
Для i = 0 к UBound(ary)
Если IsArray(ary(i)) Тогда
Если IsObject(ary(i)(0)) Тогда
Response.Write «Ошибка: AryToHashTable(ary), значение ключа не может быть типом объекта».
Response.Write "Текущий тип значения ary("& i &")(0):" & TypeName(ary(i)(0))
Ответ.Конец()
Конец, если
If IsObject(ary(i)(1)) Тогда 'Если значение является объектом
Установить hashObj(ary(i)(0)) = ary(i)(1)
Еще
hashObj(ary(i)(0)) = ary(i)(1)
Конец, если
Еще
стр = ary(i) & ""
pos = InStr(str,":")
'www.chinacms.org
Если поз < 1 Тогда
Response.Write "Ошибка: AryToHashTable(ary),"":""Не существует"
Response.Write ", Происходит по адресу:" & ary(i)
Ответ.Конец()
Конец, если
Если поз = 1 Тогда
Response.Write «Ошибка: AryToHashTable(ary), значение ключа не существует»
Response.Write ", Происходит по адресу:" & ary(i)
Ответ.Конец()
Конец, если
k = слева(str,pos-1)
v = Середина(str,pos+1)
hashObj(k) = v
Конец, если
Следующий
End Sub
'Преобразовать массив в хранилище объектов словаря
'ary: Массив, формат должен быть одним из следующих двух, первый может хранить только строковые значения.
' : array("Id:12","UserName:xilou","Sex:1"), то есть формат array("ключ:значение",...)
' : массив(массив("Id","12"),массив("Имя пользователя","xilou"),массив("Пол","1"))
'Вернуть объект словаря
Функция AryToHashTable(ary)
Dim str,ht,i,k,v,pos
Set ht = Server.CreateObject("Scripting.Dictionary")
ht.CompareMode = 1
AryAddToHashTable ht, ary
Установите AryToHashTable = ht
Конечная функция
'Преобразовать массив в строку, что эквивалентно сериализации массива. Разрешены только следующие форматы:
'array("p1:v1","p2:v2",array("p3",true))
'возвратная строка
Функция AryToVbsString(arr)
Дим ул,i,c
Если не IsArray(arr), то Response.Write «Ошибка: ошибка AryToString(arr), параметр arr не является массивом»
c = UBound(приобретение)
Для i = 0 К с
Если IsArray(arr(i)) Тогда
Выберите регистр LCase(TypeName(arr(i)(1)))
Регистр "дата", "строка", "пусто"
str = str & ",array(""" & arr(i)(0) & ""","""& arr(i)(1) &""")"
Регистр «целое число», «длинный», «одинарный», «двойной», «валюта», «десятичный», «логический»
str = str & ",array(""" & arr(i)(0) & ""","& arr(i)(1) &")"
Случай "ноль"
str = str & ",array(""" & arr(i)(0) & """,null)"
Другое дело
Response.Write "Ошибка: AryToVbsString(arr), параметр содержит недопустимые данные, индекс i="&i&", значение ключа: "&arr(i)(0)
Ответ.Конец()
Конец выбора
Еще
str = str & ",""" & arr(i) & """"
Конец, если
Следующий
Если str <> "" Тогда str = Mid(str, 2, Len(str) - 1)
str = "массив(" & str & ")"
AryToVbsString = ул
Конечная функция
'--------------------------------Окончание других операций
%>