プログラムコード
<%
「******************************」
'クラス名:
'名前：総合図書館
'日付: 2008/10/28
'作者: xilou
ウェブサイト: http://www.chinacms.org
'説明: 一般ライブラリ
著作権：転載する場合は出典と作者を明記してください
「******************************」
'最終更新日: 20090108
'変更数: 2
'変更の説明:
'20090108 以下の機能を追加します。
' A2U()、U2A()、UrlEncode()、UrlDecode()、GBToUTF8()、Bytes2Str()、Str2Bytes()
'20090108 以下の機能を追加します。
'AryToVbsString(arr)
'現在のバージョン:
'*******************************/
'出力
サブエコー(str)
応答.書き込み文字列
End Sub
'ブレークポイント
サブ停止()
Response.End()
End Sub
'出力とラップ
サブBr(str)
Echo str & "<br />" & vbcrlf
End Sub
'Request.Form() を簡略化します
'f : フォーム名
関数 P(f)
P = Replace(Request.Form(f), Chr(0), "")
End Function
'フォームを受信し、一重引用符を置換します
関数 Pr(f)
Pr = Replace(Request.Form(f), Chr(0), "")
Pr = 置換(Pr, "'", "''")
関数の終了
'Request.Querystring() を簡略化します
'f : フォーム名
関数G(f)
G = 置換(Request.QueryString(f), Chr(0), "")
End Function
' URL パラメータを受け取り、一重引用符を置換します
関数Gr(f)
Gr = Replace(Request.QueryString(f), Chr(0), "")
Gr = 置換(Gr, "'", "''")
End Function
'//Construction()?:xilou による三項演算www.chinacms.org
'ifThen は true の場合は s1 を返し、false の場合は s2 を返します
関数 IfThen(ifTrue, s1, s2)
薄暗い
If ifTrue その後
t = s1
それ以外
t = s2
終了の場合
IfThen = t
End Function
'YesとNoを色分けして表示
関数 IfThenFont(ifTrue, s1, s2)
ディムストル
If ifTrue その後
str = "<font color=""#006600"">" & s1 & "</font>"
それ以外
str = "<font color=""#FF0000"">" & s2 & "</font>"
終了の場合
IfThenFont = str
関数終了
'辞書オブジェクトの作成
関数 NewHashTable()
Set NewHashTable = Server.CreateObj("Scripting.Dictionary")
NewHashTable.CompareMode = 1 'キー値は大文字と小文字を区別しません
関数終了
'XmlHttp の作成
関数 NewXmlHttp()
Set NewXmlHttp = Server.createobject("MSXML2.XMLHTTP")
終了関数
'XmlDom の作成
関数 NewXmlDom()
関数の終了
'AdoStream の作成
関数 NewAdoStream()
Set NewAdoStream = Server.CreateObject("Adodb.Stream")
End Function
'1次元配列の作成
'n 要素の空の配列を返します
'n: 要素の数
FunctionNewArray(n)
ディメンション : ary = array()
ReDim ary(n-1)
NewArray = ary
終了関数
'Try..Catch の構築
サブトライ()
エラー時は次へ再開
End Sub
' Try..Catch を構築する
'msg: スローされたエラー メッセージ。空の場合は Err.Description がスローされます。
サブキャッチ(メッセージ)
薄暗いHTML
html = "<ul><li>$1</li></ul>"
エラーの場合はその後
If msg <> "" then
echo Replace(html, "$1", msg)
停止
それ以外
echo Replace(html, "$1", Err.Description)
停止
終了の場合
エラークリア
Response.End()
終了の場合
End Sub
'--------------------------------配列操作が開始されます
'配列に特定の値が存在するかどうかを判断します
関数 InArray(arr, s)
IsArray(arr) でない場合は InArray = False : 関数を終了します
ディム・アイ
For i = LBound(arr) から UBound(arr)
s = arr(i) の場合、InArray = True : 関数を終了
次
InArray = False
End Function
' 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)
ディム i、j、L1、L2 : j = 0
IsArray(ary) の場合
L1 = LBound(ary) : L2 = UBound(ary)
For i = L1 から L2
str = 置換(str, "$"&j, ary(i))
j = j+1
次
終了の場合
ReplaceByAry = str
終了機能
'----------------------------配列操作が終了します
'--------------- --- ---------------乱数演算の開始
'乱数を取得する
うーん乱数
関数 RndNumber(m,n)
ランダム化
RndNumber = Int((n - m + 1) * Rnd + m)
End Function
'ランダムな文字列を取得する
'n : 生成された長さ
関数 RndText(n)
Dim str1、str2、i、x、L
str1 = "NOPQRSTUVWXYZ012ABCDEFGHIJKLM3456abcdefghijklm789nopqrstuvwxyz"
L = 長さ(str1)
ランダム化
i = 1 To n の場合
x = Int((L - 1 + 1) * Rnd + 1)
str2 = str2 & Mid(str1,x,1)
次
RndText = str2
End Function
'文字列 str から m ～ n 個のランダムな文字列を生成します
' str が空の場合、デフォルトで数字と文字からランダムな文字列が生成されます
'str : この文字列からランダムな文字列を生成するには
'm,n: n ～ m ビットを生成します
関数 RndByText(str, m, n)
Dim i、k、str2、L、x
str = "" の場合、str = "NOPQRSTUVWXYZ012ABCDEFGHIJKLM3456abcdefghijklm789nopqrstuvwxyz"
L = 長さ(長さ)
n = m の場合
k = n
それ以外
ランダム化
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
End Function
'日付と時刻を乱数から生成
' 現在時刻の数値の組み合わせを返す
関数 RndByDateTime()
ディム dt : dt = Now()
RndByDateTime = 年(dt) & 月(dt) & 日(dt) & 時(dt) & 分(dt) & 秒(dt)
終了機能
'----------------------------乱数演算終了
'--------------- ------ --------文字列操作の開始
' 文字列 str2 が別の文字列 str1 に出現する回数を調べます
'回数を返し、そうでない場合は0を返します
'str1: 検索を受け付ける文字列式
'str2: 検索する文字列式
'start: 検索する開始位置。空の場合、デフォルトでは 1 から開始することを意味します。
関数 InStrTimes(str1, str2, start)
薄暗いa、c
start = "" の場合、start = 1
c = 0
a = InStr(開始, str1, str2)
> 0 の間実行する
c = c + 1
a = InStr(a+1, str1, str2)
ループ
InStrTimes = c
関数の終了
'文字列連結
『返品不可
'strResult: 接続後に保存された文字
'str : 連結する文字
'partition: 接続文字間の分離記号
Sub JoinStr(byref strResult,str,partition)
If strResult <> "" then
strResult = strResult & パーティション & str
それ以外
strResult = str
終了の場合
End Sub
'文字列のバイト長を計算します。漢字 1 文字 = 2 バイトです。
関数StrLen(str)
isNull(str) または Str = "" の場合
StrLen = 0
終了関数
終了の場合
薄暗いWINNT_CHINESE
WINNT_CHINESE = (len("例")=2)
WINNT_CHINESE の場合
薄暗い l、t、c
ディム・アイ
l = レン(str)
t = l
For i = 1 To l
c = asc(mid(str,i,1))
c<0 の場合、c = c + 65536
c>255 の場合、t = t + 1
次
StrLen = t
それ以外
StrLen = レン(str)
終了の場合
終了関数
'インターセプト文字列
'str: インターセプトされる文字列
'strlen: インターセプトされる長さ
' addStr: 次のように長さを超える場合は、代わりにこれを使用します。
関数 CutStr(str, strlen, addStr)
薄暗い i、l、t、c
If Is_Empty(str) then CutStr = "" : 関数を終了
l = len(str) : t = 0
For i = 1 To l
c = Abs(Asc(Mid(str,i,1)))
c > 255 の場合
t=t+2
それ以外
t=t+1
終了の場合
t > strlen の場合
CutStr = left(str, i) & addStr
出口
それ以外
CutStr = str
終了の場合
次
関数終了
'全角を半角に変換
関数 SBCcaseConvert(str)
ディムb、c、i
b = "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、 Ｙ、Ｚ」
c = "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、ワイ、ズ」
b = スプリット(b,",")
c = スプリット(c,",")
i = 0 から Ubound(b) へ
instr(str,b(i)) > 0 の場合
str = 置換(str, b(i), c(i))
終了の場合
次
SBCcaseConvert = str
End Function
'はJavaScriptのescape()に相当します
関数 VbsEscape(str)
ディミ、s、c、a
s = ""
i=1 の場合 Len(str)
c = Mid(str,i,1)
a = ASCW(c)
(a>=48 かつ a<=57) または (a>=65 かつ a<=90) または (a>=97 かつ a<=122) の場合
s = s&c
ElseIf InStr("@*_+-./",c) > 0 then
s = s&c
ElseIf a>0 かつ a<16 then
s = s & "%0" & Hex(a)
ElseIf a>=16 and a<256 then
s = s & "%" & Hex(a)
それ以外
s = s & "%u" & Hex(a)
終了の場合
次
VbsEscape=s
End Function
'ajax呼び出し時に使用されるJavaScriptのescape()を使用してエンコードされたデータをデコードします
関数 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 = 中間(str,x+6)
それ以外
VbsUnEscape = VbsUnEscape & Chr(CLng("&H"&Mid(str,x+1,2)))
str = 中間(str,x+3)
終了の場合
x = InStr(str,"%")
ループ
VbsUnEscape = VbsUnEscape & str
終了機能
'ASCII 文字を Unicode エンコード形式に変換します
関数 A2U(str)
Dim i、L、uText
L = 長さ(長さ)
For i = 1 から L
uText = uText & "&#" & AscW(Mid(str,i,1)) & ";"
次
A2U = uText
関数終了
'Unicode エンコーディングを ASCII に変換します
'str: トランスコードする文字列はすべて Unicode 文字である必要があります。そうでない場合はエラーが発生します。
関数 U2A(str)
ディムアリー、i、L、newStr
ary = Split(str,";")
L = UBound(ary)
i = 0 ～ L - 1 の場合
newStr = newStr & ChrW(Replace(ary(i),"&#",""))
次
U2A = 新しいStr
終了機能
'URLエンコーディング
関数 URLEncode(str)
URLEncode = Server.UrlEncode(str)
関数の終了
'URL デコード
FunctionUrlDecode(str)
Dim newstr、havechar、lastchar、i、char_c、next_1_c、next_1_Num
newstr = ""
havechar = false
lastchar = ""
For i = 1 To Len(str)
char_c = Mid(str,i,1)
char_c = "+" の場合
newstr = newstr & " "
ElseIf char_c = "%" then
next_1_c = Mid(str, i+1, 2)
next_1_num = Cint("&H" & next_1_c)
ハッシュ文字の場合
havechar = false
newstr = newstr & Chr(CInt("&H" & lastchar & next_1_c))
それ以外
Abs(next_1_num) <= 127 の場合
newstr = newstr & Chr(next_1_num)
それ以外
havechar = true
lastchar = next_1_c
終了の場合
終了の場合
i = i + 2
それ以外
newstr = newstr & char_c
終了の場合
次
URLDecode = newstr
終了機能
'GB から UTF8 -- GB でエンコードされたテキストを UTF8 でエンコードされたテキストに変換します
関数 GBToUTF8(gbStr)
薄暗いwch、uch、szRet、szInput
ディム×
ディム nAsc、nAsc2、nAsc3
szInput = gbStr
'入力パラメータが空の場合、関数を終了します
szInput = "" の場合
toUTF8 = szInput
終了関数
終了の場合
'変換を開始します
x = 1 の場合、To Len(szInput)
'mid 関数を使用して GB エンコードされたテキストを分割します
wch = Mid(szInput, x, 1)
'ascW 関数を使用して、各 GB エンコードされたテキストの Unicode 文字コードを返します
'注: asc 関数は ANSI 文字コードを返します。違いに注意してください。
nAsc = AscW(wch)
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(&U)
それ以外
'GBエンコードテキストのUnicode文字コードは0800～FFFFの3バイトテンプレートを採用
uch = "%" & Hex((nAsc 2 ^ 12) または &HE0) & "%" & _
Hex((nAsc 2 ^ 6) And &H3F または &H80) & "%" & _
16 進数 (nAsc および &H3F または &H80)
szRet = szRet(&U)
終了の場合
終了の場合
次
GBToUTF8 = szRet
終了機能
'バイトストリームから文字ストリームへの変換
関数 Bytes2Str(vin,charset)
ディムミリ秒、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 'ストリーム オブジェクトのエンコード モードを charset に設定します
strRet = ms.ReadText '文字ストリームを取得します
ms.close 'ストリームオブジェクトを閉じる
ms = 何も設定しない
Bytes2Str = strRet
終了機能
'CharストリームからByteストリームへの変換
関数 Str2Bytes(str,charset)
ディムミリ秒、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 'ストリームオブジェクトを閉じる
ms = 何も設定しない
Str2Bytes = vout
終了機能
'--------------------------------文字列操作が終了しました
'--------------- -------- ------------------------ 日時演算開始
'年と月に基づいて、その月の対応する日数を取得します
'日数を返す
'y: 年、例: 2008
'm: 月、例: 3
関数 GetDayCount(y,m)
ディムc
ケース選択 m
ケース1、3、5、7、8、10、12
c=31
ケース2
If IsDate(y&"-"&m&"-"&"29") then
c=29
それ以外
c=28
終了の場合
それ以外の場合
c=30
エンドセレクト
GetDayCount = c
End Function
' 日付と時刻が、比較の両端の時刻を含め、特定の期間内にあるかどうかを判断します。
関数 IsBetweenTime(fromTime,toTime,strTime)
DateDiff("s",fromTime,strTime) >= 0 かつ DateDiff("s",toTime,strTime) <= 0 の場合
IsBetweenTime = True
それ以外
IsBetweenTime = False
終了の場合
終了機能
'---------------------日時の操作が終了しました
'----------- ---------- -------------------セキュリティ暗号化関連の運用開始
'----------------------------セキュリティ暗号化関連操作終了
'---------- ---- -----------------データの合法性検証作業が開始されます
'正規表現で文字列を検出し、true|falseを返します
関数 RegExpTest(strPatrn,strText)
Dim objRegExp、一致
objRegExp = 新しい RegExp を設定します
objRegExp.Pattern = strPatrn
objRegExp.IgnoreCase = False
objRegExp.Global = True
RegExpTest = objRegExp.Test(strText)
'マッチを設定 = objRegExp.Execute(strText)
objRegExp = 何も設定しない
終了関数
'正の整数ですか?
FunctionIsPint(str)
IsPint = RegExpTest("^[1-9]{1}d*$", str)
End Function
'0か正の整数か
FunctionIsInt(str)
IsInt = RegExpTest("^0|([1-9]{1}d*)$", str)
終了機能
'メール
FunctionIsEmail(str)
薄暗いパターン
patrn = "^w+((-w+)|(.w+))*@[A-Za-z0-9]+((.|-)[A-Za-z0-9]+ )*.[A-Za-z0-9]+$"
IsEmail = RegExpTest(patrn,str)
終了機能
'携帯電話
FunctionIsMobile(str)
薄暗いパターン
パターン = "^(130|131|132|133|153|134|135|136|137|138|139|158|159){1}d{8}$"
IsMobile = RegExpTest(patrn,str)
終了機能
「QQ」
関数IsQQ(str)
薄暗いパターン
パターン = "^[1-9]d{4,8}$"
IsQQ = RegExpTest(patrn,str)
終了機能
「IDカード」
FunctionIsIdCard(e)
Dim arrVerifyCode、Wi、チェッカー
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 の場合
IsIdCard = False
終了関数
終了の場合
ディムA
Len(e) = 18 の場合
Ai = Mid(e, 1, 17)
ElseIf Len(e) = 15 then
アイ＝エ
Ai = 左(Ai, 6) & "19" & 中(Ai, 7, 9)
終了の場合
IsNumeric(Ai) ではない場合
IsIdCard= False
終了関数
終了の場合
Dim stryear、strMonth、strDay、BirthDay
stryear = CInt(Mid(Ai, 7, 4))
strMonth = CInt(Mid(Ai, 11, 2))
strDay = CInt(Mid(Ai, 13, 2))
BirthDay = Trim(str Year) + "-" + Trim(strMonth) + "-" + Trim(strDay)
If IsDate(BirthDay) then
DateDiff("yyyy",Now,BirthDay)<-140 または cdate(BirthDay)>date() の場合
IsIdCard= False
終了関数
終了の場合
strMonth > 12 または strDay > 31 の場合
IsIdCard= False
終了関数
終了の場合
それ以外
IsIdCard= False
終了関数
終了の場合
Dim i、TotalmulAiWi
i = 0 ～ 16 の場合
TotalmulAiWi = TotalmulAiWi + CInt(Mid(Ai, i + 1, 1)) * Wi(i)
次
ディム modValue
modValue = TotalmulAiWi Mod 11
Dim strVerifyCode
strVerifyCode = arrVerifyCode(modValue)
Ai = Ai & strVerifyCode
IsIdCard = アイ
Len(e) = 18 かつ e <> Ai の場合
IsIdCard= False
終了関数
終了の場合
IsIdCard=True
終了機能
'郵便番号
関数 IsZipCode(str)
薄暗いパターン
パターン = "^[1-9]d{2,5}$"
IsZipCode = RegExpTest(patrn,str)
終了機能
'空かどうか (IsEmpty()、IsNull()、"" の関数を含む)
関数 Is_Empty(str)
IsNull(str) または IsEmpty(str) または str="" の場合
Is_Empty=True
それ以外
Is_Empty=False
終了の場合
終了機能
'--------------------------------データの有効性検証操作が終了しました
'---------- -- ----------ファイル操作開始
'jpgなどのファイル拡張子を取得します
関数 GetFileExt(f)
GetFileExt = Lcase(Mid(f,InStrRev(f,".") + 1))
終了機能
'フォルダーを生成
'path: 生成されるフォルダーへのパス。相対パスを使用します。
サブCフォルダー(パス)
ディムfso
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.FolderExists(path) でない場合
fso.CreateFolder(パス)
終了の場合
fso = 何も設定しない
End Sub
'フォルダーを削除
'パス: フォルダー パス、相対パスを使用します
サブフォルダ(パス)
ディムfso
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.FolderExists(path) の場合
fso.DeleteFolder パス、true
それ以外
echo "パスが存在しません:" & パス
終了の場合
fso = 何も設定しない
End Sub
'ファイルを生成
'path: 名前を含むファイル パスを生成します
'strText: ファイルの内容
サブ CFile(パス,strText)
ディム f,fso
Set fso = Server.CreateObject("Scripting.FileSystemObject")
f = fso.CreateTextFile(パス) を設定します。
f.strTextの書き込み
f = 何も設定しない
fso = 何も設定しない
End Sub
'ファイルを削除
'パス: 名前を含むファイルパス
サブDファイル(パス)
ディムfso
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.FileExists(path) の場合
Fso.DeleteFile(パス)
終了の場合
fso = 何も設定しない
End Sub
'収集
関数 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()
'if err.number<>0 then err.Clear
関数終了
'エンコード変換
関数 BytesToBstr(body,Cset)
ディムストリームオブジェクト
StreamObj = Server.CreateObject("Adodb.Stream") を設定します。
StreamObj.Type = 1
ストリームオブジェクトモード = 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 に移動します。
サブ ShowMsg(メッセージ、URL、タイプ番号)
message = replace(メッセージ,"'","'")
ケースのタイプ番号を選択してください
ケース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)
ディム str、スタイル、i
スタイル = "スタイル=""背景色:#FFCCCC"""
str = ""
IsNull(curValue) の場合、curValue = ""
I = LBound(textArr) から 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
終了の場合
次
ShowOpList = str
関数終了
'複数選択リスト
'注: InArray() 関数を使用する必要があります
'textArr: テキスト配列
'valueArr: 値の配列
'curValue: 現在選択されている値の配列
関数 ShowMultiOpList(textArr,valueArr,curValueArr)
Dim スタイル、str、isCurr、I
スタイル = "スタイル=""背景色:#FFCCCC"""
str = "" : isCurr = False
IsNull(curValue) の場合、curValue = ""
I = LBound(textArr) から 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 = str
終了機能
関数 GetIP()
Dim strIPAddr,actforip
Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" または InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 の場合
strIPAddr = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 then
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 then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
それ以外
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
終了の場合
GetIP = strIPAddr
終了機能
'配列を辞書オブジェクトストレージに変換します
'hashObj: 辞書オブジェクト
'ary: 配列。形式は次の 2 つのいずれかでなければなりません。最初の形式は文字列値のみを保存できます。
' : array("Id:12","UserName:xilou","Sex:1")、つまり array("key:value",...) 形式
' : array(array("Id","12"),array("UserName","xilou"),array("Sex","1"))
'辞書オブジェクトを返す
「www.chinacms.org」
Sub AryAddToHashTable(ByRef hashObj,ary)
ディム str,ht,i,k,v,pos
For i = 0 から UBound(ary)
IsArray(ary(i)) の場合
IsObject(ary(i)(0)) の場合
Response.Write "エラー:AryToHashTable(ary)、キー値はオブジェクト型であってはなりません。"
Response.Write "現在の ary("& i &")(0) 値の型は次のとおりです:" & TypeName(ary(i)(0))
Response.End()
終了の場合
If IsObject(ary(i)(1)) then '値がオブジェクトの場合
hashObj(ary(i)(0)) = ary(i)(1) を設定します。
それ以外
hashObj(ary(i)(0)) = ary(i)(1)
終了の場合
それ以外
str = ary(i) & ""
pos = InStr(str,":")
「www.chinacms.org」
pos < 1 の場合
Response.Write "エラー:AryToHashTable(ary),"":""存在しません"
Response.Write ",発生場所:" & ary(i)
Response.End()
終了の場合
pos = 1 の場合
Response.Write "エラー:AryToHashTable(ary)、キー値が存在しません"
Response.Write ",発生場所:" & ary(i)
Response.End()
終了の場合
k = 左(str,pos-1)
v = 中間(str,pos+1)
ハッシュObj(k) = v
終了の場合
次
End Sub
'配列を辞書オブジェクトストレージに変換します
'ary: 配列。形式は次の 2 つのいずれかでなければなりません。最初のものは文字列値のみを保存できます。
' : array("Id:12","UserName:xilou","Sex:1")、つまり array("key:value",...) 形式
' : array(array("Id","12"),array("UserName","xilou"),array("Sex","1"))
'辞書オブジェクトを返す
関数AryToHashTable(ary)
ディム str,ht,i,k,v,pos
Set ht = Server.CreateObject("Scripting.Dictionary")
ht.比較モード = 1
AryAddToHashTable ht 、ary
AryToHashTable = ht を設定します
End Function
' 配列を文字列に変換します。これは配列をシリアル化するのと同じです。許可される形式は次のとおりです。
'array("p1:v1","p2:v2",array("p3",true))
'文字列を返す
関数AryToVbsString(arr)
ディム str,i,c
If Not IsArray(arr) then Response.Write "エラー: AryToString(arr) エラー、パラメータ arr は配列ではありません"
c = UBound(arr)
i = 0 から c まで
IsArray(arr(i)) の場合
ケースを選択 LCase(TypeName(arr(i)(1)))
「日付」、「文字列」、「空」の場合
str = str & ",array(""" & arr(i)(0) & ""","""& arr(i)(1) &""")"
ケース「整数」、「長整数」、「単数」、「倍精度」、「通貨」、「10 進数」、「ブール値」
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)
Response.End()
エンドセレクト
それ以外
str = str & ",""" & arr(i) & """"
終了の場合
次
str <> "" の場合、str = Mid(str, 2, Len(str) - 1)
str = "配列(" & str & ")"
AryToVbsString = str
終了機能
'--------------------------------その他の操作は終了
%>