Programmcode
<%
'******************************
'Klassenname:
„Name: Allgemeine Bibliothek.“
'Datum: 28.10.2008
'Autor: von xilou
„Website: http://www.chinacms.org
„Beschreibung: Allgemeine Bibliothek
'Copyright: Bitte geben Sie beim Nachdruck die Quelle und den Autor an
'******************************
'Letzte Änderung: 20090108
'Anzahl der Änderungen: 2
'Änderungsbeschreibung:
'20090108 Fügen Sie die folgenden Funktionen hinzu:
' A2U(),U2A(),UrlEncode(),UrlDecode(),GBToUTF8(),Bytes2Str(),Str2Bytes()
'20090108 Fügen Sie die folgenden Funktionen hinzu:
'AryToVbsString(arr)
'Aktuelle Version:
'******************************/
'Ausgabe
Sub Echo(str)
Response.Write str
End Sub
'Haltepunkt
Sub Halt()
Response.End()
End Sub
'Ausgabe und Wrap
SubBr(str)
Echo str & "<br />" & vbcrlf
End Sub
'Simplify Request.Form()
'f: Formularname
Funktion P(f)
P = Ersetzen(Request.Form(f), Chr(0), "")
Endfunktion
'Empfangen Sie das Formular und ersetzen Sie einfache Anführungszeichen
Funktion Pr(f)
Pr = Ersetzen(Request.Form(f), Chr(0), "")
Pr = Ersetzen(Pr, "'", "''")
Endfunktion
'Simplify Request.Querystring()
'f: Formularname
FunktionG(f)
G = Ersetzen(Request.QueryString(f), Chr(0), "")
Endfunktion
'URL-Parameter empfangen und einfache Anführungszeichen ersetzen
FunktionGr(f)
Gr = Replacement(Request.QueryString(f), Chr(0), "")
Gr = Ersetzen(Gr, "'", "''")
End Function
'//Construction()?:Ternary operation von xilou www.chinacms.org
'ifThen gibt s1 für wahr und s2 für falsch zurück
Funktion IfThen(ifTrue, s1, s2)
Dim t
Wenn wenn wahr, dann
t = s1
Anders
t = s2
Ende wenn
IfThen = t
Endfunktion
'Ja und Nein in verschiedenen Farben anzeigen
Funktion IfThenFont(ifTrue, s1, s2)
Dimstr
Wenn wenn wahr, dann
str = "<font color=""#006600"">" & s1 & "</font>"
Anders
str = "<font color=""#FF0000"">" & s2 & "</font>"
Ende wenn
IfThenFont = str
Endfunktion
'Wörterbuchobjekt erstellen
Funktion NewHashTable()
Setze NewHashTable = Server.CreateObj("Scripting.Dictionary")
NewHashTable.CompareMode = 1 'Bei Schlüsselwerten wird die Groß-/Kleinschreibung nicht beachtet
Endfunktion
'XmlHttp erstellen
Funktion NewXmlHttp()
Setze NewXmlHttp = Server.createobject("MSXML2.XMLHTTP")
Endfunktion
'XmlDom erstellen
Funktion NewXmlDom()
Endfunktion
„AdoStream erstellen
Funktion NewAdoStream()
Setze NewAdoStream = Server.CreateObject("Adodb.Stream")
Endfunktion
'Erstellen Sie ein eindimensionales Array
'Gib ein leeres Array mit n Elementen zurück
'n: Anzahl der Elemente
FunctionNewArray(n)
Dim ary: ary = array()
ReDim ary(n-1)
NewArray = ary
Endfunktion
'Construct Try..Catch
SubTry()
Bei Fehler Weiter fortsetzen
End Sub
'Construct Try..Catch
'msg: Die ausgegebene Fehlermeldung. Wenn sie leer ist, wird Err.Description ausgegeben
Sub Catch(msg)
HTML abdunkeln
html = "<ul><li>$1</li></ul>"
Wenn Sie sich irren, dann
Wenn msg <> "" Dann
echo Replacement(html, „$1“, msg)
Halt
Anders
echo Replacement(html, "$1", Err.Description)
Halt
Ende wenn
Err.Clear
Response.End()
Ende wenn
End Sub
'--------------------------------Der Array-Vorgang beginnt
'Bestimmen Sie, ob ein bestimmter Wert im Array vorhanden ist
Funktion InArray(arr, s)
Wenn nicht IsArray(arr), dann InArray = False: Funktion beenden
Dim ich
Für i = LBound(arr) Zu UBound(arr)
Wenn s = arr(i), dann InArray = True: Funktion beenden
Nächste
InArray = False
Endfunktion
'Ersetzen Sie die Platzhalter in str durch die Werte im ary-Array.
'Gibt die ersetzte Zeichenfolge zurück
'str: Die zu ersetzende Zeichenfolge, die Platzhalter sind $0, $1, $2...
'ary: Array, das zum Ersetzen verwendet wird. Jeder Wert entspricht $0, $1, $2... im Platzhalter.
'Zum Beispiel: ReplacementByAry("$0-$1-$2 $3:$4:$5",Array(y,m,d,h,i,s))
Funktion ReplacementByAry(str,ary)
Dim i, j, L1, L2 : j = 0
Wenn IsArray(ary) Dann
L1 = LBound(ary) : L2 = UBound(ary)
Für i = L1 bis L2
str = Ersetzen(str, "$"&j, ary(i))
j = j+1
Nächste
Ende wenn
ErsetzenByAry = str
Funktion beenden
'--------------Array-Vorgang endet
'------------- --- ---------------Zufallszahlenoperation beginnt
„Erhalten Sie Zufallszahlen.“
Bin eine Zufallszahl
Funktion RndNumber(m,n)
Randomisieren
RndNumber = Int((n - m + 1) * Rnd + m)
Endfunktion
'Eine zufällige Zeichenfolge abrufen
'n: generierte Länge
Funktion RndText(n)
Dim str1, str2, i, x, L
str1 = „NOPQRSTUVWXYZ012ABCDEFGHIJKLM3456abcdefghijklm789nopqrstuvwxyz“
L = Len(str1)
Randomisieren
Für i = 1 bis n
x = Int((L - 1 + 1) * Rnd + 1)
str2 = str2 & Mid(str1,x,1)
Nächste
RndText = str2
Endfunktion
'Generieren Sie m bis n zufällige Strings aus dem String str
'Wenn str leer ist, wird standardmäßig eine zufällige Zeichenfolge aus Zahlen und Buchstaben generiert
'str: Um aus dieser Zeichenfolge eine zufällige Zeichenfolge zu generieren
'm,n: Erzeuge n bis m Bits
Funktion RndByText(str, m, n)
Dim i, k, str2, L, x
Wenn str = "" Dann str = "NOPQRSTUVWXYZ012ABCDEFGHIJKLM3456abcdefghijklm789nopqrstuvwxyz"
L = Len(str)
Wenn n = m Dann
k = n
Anders
Randomisieren
k = Int((n - m + 1) * Rnd + m)
Ende wenn
Randomisieren
Für i = 1 bis k
x = Int((L - 1 + 1) * Rnd + 1)
str2 = str2 & Mid(str, x, 1)
Nächste
RndByText = str2
Endfunktion
'Datum und Uhrzeit bilden Zufallszahlen
'Gibt die Zahlenkombination der aktuellen Uhrzeit zurück
Funktion RndByDateTime()
Dim dt : dt = Now()
RndByDateTime = Jahr (dt) und Monat (dt) und Tag (dt) und Stunde (dt) und Minute (dt) und Sekunde (dt)
Funktion beenden
'--------------Zufallszahlenoperation endet
'--------------- ------ --------------------String-Vorgang beginnt
'Bestimmen Sie, wie oft ein String str2 in einem anderen String str1 vorkommt
'Gib die Häufigkeit zurück, wenn nicht, gib 0 zurück
'str1: Zeichenfolgenausdruck, der die Suche akzeptiert
'str2: String-Ausdruck, nach dem gesucht werden soll
'start: Die zu durchsuchende Startposition. Wenn leer, bedeutet dies, dass standardmäßig bei 1 begonnen wird.
Funktion InStrTimes(str1, str2, start)
Dimmen Sie a,c
Wenn start = "", dann start = 1
c = 0
a = InStr(start, str1, str2)
Machen Sie While a > 0
c = c + 1
a = InStr(a+1, str1, str2)
Schleife
InStrTimes = c
End Function
'String-Verkettung
„Keine Rückkehr
'strResult: Nach der Verbindung gespeicherte Zeichen
'str: Zu verkettendes Zeichen
'Partition: Trennzeichen zwischen verbindenden Zeichen
Sub JoinStr(byref strResult,str,partition)
Wenn strResult <> "" Dann
strResult = strResult & Partition & str
Anders
strResult = str
Ende wenn
End Sub
'Berechne die Bytelänge der Zeichenfolge, ein chinesisches Zeichen = 2 Bytes
FunctionStrLen(str)
Wenn isNull(str) oder Str = "" Dann
StrLen = 0
Exit-Funktion
Ende wenn
Dimmen Sie WINNT_CHINESE
WINNT_CHINESE = (len("example")=2)
Wenn WINNT_CHINESE Dann
Dim l,t,c
Dim ich
l = len(str)
t = l
Für i = 1 bis l
c = asc(mid(str,i,1))
Wenn c<0, dann ist c = c + 65536
Wenn c>255, dann ist t = t + 1
Nächste
StrLen = t
Anders
StrLen = len(str)
Ende wenn
End Function
'String abfangen
'str: die abzufangende Zeichenfolge
'strlen: die Länge, die abgefangen werden soll
' addStr: Verwenden Sie dies stattdessen, wenn es die Länge überschreitet, wie zum Beispiel:...
Funktion CutStr(str, strlen, addStr)
Dim i,l,t,c
Wenn Is_Empty(str) Then CutStr = "" : Funktion beenden
l = len(str) : t = 0
Für i = 1 bis l
c = Abs(Asc(Mid(str,i,1)))
Wenn c > 255, dann
t=t+2
Anders
t=t+1
Ende wenn
Wenn t > strlen Dann
CutStr = left(str, i) & addStr
Ausgang für
Anders
CutStr = str
Ende wenn
Nächste
Endfunktion
'Volle Breite in halbe Breite umwandeln
Funktion SBCcaseConvert(str)
Dim b, c, ich
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, Y,Z"
b = split(b,",")
c = split(c,",")
Für i = 0 bis Ubound(b)
Wenn instr(str,b(i)) > 0 Dann
str = Ersetzen(str, b(i), c(i))
Ende wenn
Nächste
SBCcaseConvert = str
End Function
'entspricht escape() in Javascript
Funktion VbsEscape(str)
dimi,s,c,a
s = ""
Für i=1 bis Len(str)
c = Mitte(str,i,1)
a = ASCW(c)
Wenn (a>=48 und a<=57) oder (a>=65 und a<=90) oder (a>=97 und a<=122) Dann
s = s&c
ElseIf InStr("@*_+-./",c) > 0 Then
s = s&c
ElseIf a>0 und a<16 Then
s = s & „%0“ & Hex(a)
ElseIf a>=16 und a<256 Then
s = s & „%“ & Hex(a)
Anders
s = s & „%u“ & Hex(a)
Ende wenn
Nächste
VbsEscape=s
Endfunktion
„Dekodieren Sie Daten, die mit escape() in Javascript codiert wurden und beim Aufruf von Ajax verwendet werden.“
Funktion VbsUnEscape(str)
Dimmen Sie x
x = InStr(str,"%")
Machen Sie solange x > 0
VbsUnEscape = VbsUnEscape & Mid(str,1,x-1)
Wenn LCase(Mid(str,x+1,1)) = „u“ Dann
VbsUnEscape = VbsUnEscape & ChrW(CLng("&H"&Mid(str,x+2,4)))
str = Mitte(str,x+6)
Anders
VbsUnEscape = VbsUnEscape & Chr(CLng("&H"&Mid(str,x+1,2)))
str = Mitte(str,x+3)
Ende wenn
x = InStr(str,"%")
Schleife
VbsUnEscape = VbsUnEscape & str
Funktion beenden
'Konvertieren Sie ASCII-Zeichen in die Unicode-Kodierungsform
Funktion A2U(str)
Dim i,L,uText
L = Len(str)
Für i = 1 bis L
uText = uText & "&#" & AscW(Mid(str,i,1)) & ";"
Nächste
A2U = uText
Endfunktion
'Unicode-Kodierung in ASCII konvertieren
'str: Die zu transkodierende Zeichenfolge muss ausschließlich aus Unicode-Zeichen bestehen, andernfalls tritt ein Fehler auf
Funktion U2A(str)
Dim ary,i,L,newStr
ary = Split(str,";")
L = UBound(ary)
Für i = 0 bis L - 1
newStr = newStr & ChrW(Replace(ary(i),"&#",""))
Nächste
U2A = newStr
Funktion beenden
'URL-Kodierung
Funktion UrlEncode(str)
UrlEncode = Server.UrlEncode(str)
die URL-Dekodierung der
Funktion
FunctionUrlDecode(str)
Dimmen Sie newstr, havechar, lastchar, i, char_c, next_1_c, next_1_Num
newstr = ""
havechar = false
lastchar = ""
Für i = 1 Zu Len(str)
char_c = Mid(str,i,1)
Wenn char_c = „+“ Dann
newstr = newstr & " "
ElseIf char_c = „%“ Then
next_1_c = Mid(str, i+1, 2)
next_1_num = Cint("&H" & next_1_c)
Wenn havechar Dann
havechar = false
newstr = newstr & Chr(CInt("&H" & lastchar & next_1_c))
Anders
Wenn Abs(next_1_num) <= 127 Dann
newstr = newstr & Chr(next_1_num)
Anders
havechar = true
lastchar = next_1_c
Ende wenn
Ende wenn
ich = ich + 2
Anders
newstr = newstr & char_c
Ende wenn
Nächste
UrlDecode = newstr
Funktion beenden
„GB zu UTF8 – Konvertieren Sie GB-codierten Text in UTF8-codierten Text
Funktion GBToUTF8(gbStr)
Dim wch,uch,szRet,szInput
Dimmen Sie x
Dimmen Sie nAsc, nAsc2, nAsc3
szInput = gbStr
'Wenn der Eingabeparameter leer ist, beenden Sie die Funktion
Wenn szInput = "" Dann
toUTF8 = szInput
Exit-Funktion
Ende wenn
„Konvertierung starten.“
Für x = 1 bis Len(szInput)
'Verwenden Sie die Mid-Funktion, um GB-codierten Text aufzuteilen
wch = Mid(szInput, x, 1)
'Verwenden Sie die Funktion ascW, um den Unicode-Zeichencode jedes GB-codierten Textes zurückzugeben
'Hinweis: Die ASC-Funktion gibt ANSI-Zeichencode zurück. Beachten Sie den Unterschied
nAsc = AscW(wch)
Wenn nAsc < 0, dann nAsc = nAsc + 65536.
Wenn (nAsc und &HFF80) = 0, dann
szRet = szRet & wch
Anders
Wenn (nAsc und &HF000) = 0, dann
uch = "%" & Hex(((nAsc 2 ^ 6)) oder &HC0) & Hex(nAsc und &H3F oder &H80)
szRet = szRet&uch
Anders
„Der Unicode-Zeichencode von GB-codiertem Text verwendet eine Drei-Byte-Vorlage zwischen 0800 und FFFF
uch = "%" & Hex((nAsc 2 ^ 12) oder &HE0) & "%" & _
Hex((nAsc 2 ^ 6) Und &H3F oder &H80) & "%" & _
Hex(nAsc und &H3F oder &H80)
szRet = szRet&uch
Ende wenn
Ende wenn
Nächste
GBToUTF8 = szRet
Funktion beenden
'Konvertierung vom Byte-Stream in den Char-Stream
Funktion Bytes2Str(vin,charset)
Dimmen ms,strRet
Set ms = Server.CreateObject("ADODB.Stream") 'Erstelle ein Stream-Objekt
ms.Type = 1 'Binär
ms.Open
ms.Write vin 'Schreibe vin in das Stream-Objekt
ms.Position = 0 'Setzen Sie die Startposition des Stream-Objekts auf 0, um die Charset-Eigenschaft festzulegen
ms.Type = 2 'Text
ms.Charset = charset 'Setzen Sie den Codierungsmodus des Stream-Objekts auf charset
strRet = ms.ReadText 'Holen Sie sich den Zeichenstream
ms.close 'Schließe das Stream-Objekt
Setze ms = nichts
Bytes2Str = strRet
Funktion beenden
'Konvertierung von Char-Stream in Byte-Stream
Funktion Str2Bytes(str,charset)
Dimmen ms,strRet
Set ms = CreateObject("ADODB.Stream") 'Erstellt ein Stream-Objekt
ms.Type = 2 'Text
ms.Charset = charset 'Setzen Sie den Codierungsmodus des Stream-Objekts auf charset
ms.Open
ms.WriteText str 'Str in das Stream-Objekt schreiben
ms.Position = 0 'Setzen Sie die Startposition des Stream-Objekts auf 0, um die Charset-Eigenschaft festzulegen
ms.Type = 1 'Binary
vout = ms.Read(ms.Size) 'Zeichenstrom abrufen
ms.close 'Schließe das Stream-Objekt
Setze ms = nichts
Str2Bytes = vout
Funktion beenden
'--------------------------------String-Operation endet
'------------- -------- --------------------Uhrzeit- und Datumsbetrieb beginnt
'Ermitteln Sie die entsprechende Anzahl von Tagen im Monat basierend auf Jahr und Monat
'Gibt die Anzahl der Tage zurück
'y: Jahr, wie zum Beispiel: 2008
bin: Monat, wie zum Beispiel: 3
Funktion GetDayCount(y,m)
Schwaches c
Wählen Sie Fall m
Fall 1, 3, 5, 7, 8, 10, 12
c=31
Fall 2
Wenn IsDate(y&"-"&m&"-"&"29") Dann
c=29
Anders
c=28
Ende wenn
Fall anders
c=30
Endauswahl
GetDayCount = c
Endfunktion
„Bestimmen Sie, ob ein Datum und eine Uhrzeit zwischen einem bestimmten Zeitraum liegen, einschließlich der Uhrzeit an beiden Enden des Vergleichs.“
Funktion IsBetweenTime(fromTime,toTime,strTime)
Wenn DateDiff("s",fromTime,strTime) >= 0 und DateDiff("s",toTime,strTime) <= 0, dann
IsBetweenTime = True
Anders
IsBetweenTime = False
Ende wenn
Funktion beenden
'--------------------------------Zeit- und Datumsvorgang endet
'----------- ---------- -------------------Vorgänge im Zusammenhang mit der Sicherheitsverschlüsselung beginnen
'--------------Vorgänge im Zusammenhang mit der Sicherheitsverschlüsselung werden beendet
'---------- ---- -----------------Der Vorgang zur Überprüfung der Datenlegalität beginnt
'String durch regulären Ausdruck erkennen und true|false zurückgeben
Funktion RegExpTest(strPatrn,strText)
Dim objRegExp, Übereinstimmungen
Setze objRegExp = New RegExp
objRegExp.Pattern = strPatrn
objRegExp.IgnoreCase = Falsch
objRegExp.Global = True
RegExpTest = objRegExp.Test(strText)
'Set match = objRegExp.Execute(strText)
Setze objRegExp = nichts
Endfunktion
„Ist es eine positive ganze Zahl?
FunctionIsPint(str)
IsPint = RegExpTest("^[1-9]{1}d*$", str)
Endfunktion
'Ob es 0 oder eine positive ganze Zahl ist
FunctionIsInt(str)
IsInt = RegExpTest("^0|([1-9]{1}d*)$", str)
Funktion beenden
'E-Mail
FunctionIsEmail(str)
Dimmmuster
patrn = "^w+((-w+)|(.w+))*@[A-Za-z0-9]+((.|-)[A-Za-z0-9]+ )*.[A-Za-z0-9]+$"
IsEmail = RegExpTest(patrn,str)
Funktion beenden
'Handy
FunctionIsMobile(str)
Dimmmuster
patrn = "^(130|131|132|133|153|134|135|136|137|138|139|158|159){1}d{8}$"
IsMobile = RegExpTest(patrn,str)
Funktion beenden
„QQ
FunctionIsQQ(str)
Dimmmuster
patrn = "^[1-9]d{4,8}$"
IsQQ = RegExpTest(patrn,str)
Funktion beenden
'Ausweis
FunctionIsIdCard(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", ","")
Wenn Len(e) < 15 oder Len(e) = 16 oder Len(e) = 17 oder Len(e) > 18, dann
IsIdCard = Falsch
Exit-Funktion
Ende wenn
Dim A
Wenn Len(e) = 18, dann
Ai = Mid(e, 1, 17)
ElseIf Len(e) = 15 Dann
Ai=e
Ai = Links (Ai, 6) & „19“ & Mitte (Ai, 7, 9)
Ende wenn
Wenn nicht, istNumeric(Ai) dann
IsIdCard= Falsch
Exit-Funktion
Ende wenn
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(strYear) + „-“ + Trim(strMonth) + „-“ + Trim(strDay)
If IsDate(BirthDay) Then
Wenn DateDiff("yyyy",Now,BirthDay)<-140 oder cdate(BirthDay)>date() Dann
IsIdCard= Falsch
Exit-Funktion
Ende wenn
Wenn strMonth > 12 oder strDay > 31 Dann
IsIdCard= Falsch
Exit-Funktion
Ende wenn
Anders
IsIdCard= Falsch
Exit-Funktion
Ende wenn
Dim i,TotalmulAiWi
Für i = 0 bis 16
TotalmulAiWi = TotalmulAiWi + CInt(Mid(Ai, i + 1, 1)) * Wi(i)
Nächste
ModValue dimmen
modValue = TotalmulAiWi Mod 11
Dimmen Sie strVerifyCode
strVerifyCode = arrVerifyCode(modValue)
Ai = Ai & strVerifyCode
IsIdCard = Ai
Wenn Len(e) = 18 und e <> Ai, dann
IsIdCard= Falsch
Exit-Funktion
Ende wenn
IsIdCard=True
Funktion beenden
'Postleitzahl
Funktion IsZipCode(str)
Dimmmuster
patrn = "^[1-9]d{2,5}$"
IsZipCode = RegExpTest(patrn,str)
Funktion beenden
'Ob es leer ist, einschließlich der Funktionen IsEmpty(), IsNull(), ""
Funktion Is_Empty(str)
Wenn IsNull(str) oder IsEmpty(str) oder str="" Dann
Is_Empty=True
Anders
Is_Empty=False
Ende wenn
Funktion beenden
'--------------------------------Vorgang zur Überprüfung der Datengültigkeit endet
'--------- -- ---------------------Der Dateivorgang wird gestartet
'Holen Sie sich das Dateisuffix, z. B. jpg
Funktion GetFileExt(f)
GetFileExt = Lcase(Mid(f,InStrRev(f,".") + 1))
Funktion beenden
'Ordner erstellen
'Pfad: Der Pfad zum zu generierenden Ordner. Verwenden Sie einen relativen Pfad
Unterordner (Pfad)
Dim fso
Setze fso = Server.CreateObject("Scripting.FileSystemObject")
Wenn nicht fso.FolderExists(path) Dann
fso.CreateFolder(Pfad)
Ende wenn
Setze fso = Nichts
End Sub
'Ordner löschen
'Pfad: Ordnerpfad, relativen Pfad verwenden
Unterordner (Pfad)
Dim fso
Setze fso = Server.CreateObject("Scripting.FileSystemObject")
Wenn fso.FolderExists(path) Dann
fso.DeleteFolder-Pfad, wahr
Anders
echo „Pfad existiert nicht:“ & Pfad
Ende wenn
Setze fso = Nichts
End Sub
'Datei generieren
'Pfad: Dateipfad generieren, einschließlich Name
'strText: Dateiinhalt
Sub CFile(path,strText)
Dim f,fso
Setze fso = Server.CreateObject("Scripting.FileSystemObject")
Setze f = fso.CreateTextFile(path)
f. Schreiben Sie strText
Setze f = Nichts
Setze fso = Nichts
End Sub
'Datei löschen
'Pfad: Dateipfad, einschließlich Name
SubDFile(Pfad)
Dim fso
Setze fso = Server.CreateObject("Scripting.FileSystemObject")
Wenn fso.FileExists(path) Dann
Fso.DeleteFile(Pfad)
Ende wenn
Setze fso = Nichts
End Sub
'Sammeln
Funktion GetHTTPPage(url)
'Http.setTimeouts 10000,10000,10000,10000
„Bei Fehler Weiter fortsetzen.“
Http dimmen
Set Http = Server.createobject("MSXML2.XMLHTTP")
Http.open „GET“,url,false
Http.send()
Wenn Http.Status <> 200, dann
Exit-Funktion
Ende wenn
'Wenn Fehler, dann Response.Write-URL: Response.End()
GetHTTPPage = bytesToBSTR(Http.ResponseBody,"GB2312")
'Http.Close()
'Wenn err.number<>0, dann err.Clear
Endfunktion
'Kodierungskonvertierung
Funktion BytesToBstr(body,Cset)
DimStreamObj
Setze StreamObj = Server.CreateObject("Adodb.Stream")
StreamObj.Type = 1
StreamObj.Mode = 3
StreamObj.Open
StreamObj.Write-Text
StreamObj.Position = 0
StreamObj.Type = 2
StreamObj.Charset = Cset
BytesToBstr = StreamObj.ReadText
StreamObj.Close
Funktion beenden
'--------------------------------Dateivorgang endet
'------------- -------------------Andere Vorgänge beginnen
'Informationen anzeigen
'Nachricht: die anzuzeigende Nachricht
'URL: URL, zu der gesprungen werden soll
'typeNum: Anzeigemodus, 1 zeigt Informationen an und kehrt zur vorherigen Seite zurück; 2 zeigt Informationen an und geht zur URL
Sub ShowMsg(message,url,typeNum)
message = replace(message,"'","'")
Wählen Sie Case TypeNum
Fall 1
echo ("<script language=javascript>alert('" & message & "');history.go(-1)</script>")
Fall 2
echo ("<script language=javascript>alert('" & message & "');location='" & Url &"'</script>")
Endauswahl
End Sub
'Optionsliste und Position anzeigen, von xilou www.chinacms.org
'textArr: Textarray
'valueArr: Wertearray
'curValue: aktuell ausgewählter Wert
Funktion ShowOpList(textArr, valueArr, curValue)
Dim str, Stil, ich
style = "style=""background-color:#FFCCCC"""
str = ""
If IsNull(curValue) Then curValue = ""
Für I = LBound(textArr) Zu UBound(valueArr)
Wenn Cstr(valueArr(I)) = Cstr(curValue) Dann
str = str&"<option value="""&valueArr(I)&""" selected=""selected"" "&style&" >"&textArr(I)&"</option>"&vbcrlf
Anders
str = str&"<option value="""&valueArr(I)&""" >"&textArr(I)&"</option>"&vbcrlf
Ende wenn
Nächste
ShowOpList = str
Endfunktion
'Mehrfachauswahlliste
'Hinweis: Sie müssen die Funktion InArray() verwenden
'textArr: Textarray
'valueArr: Wertearray
'curValue: aktuell ausgewähltes Wertearray
Funktion ShowMultiOpList(textArr,valueArr,curValueArr)
Dim-Stil, str, isCurr, I
style = "style=""background-color:#FFCCCC"""
str = "" : isCurr = False
If IsNull(curValue) Then curValue = ""
Für I = LBound(textArr) Zu UBound(valueArr)
If InArray(curValueArr, valueArr(I)) Then
str = str&"<option value="""&valueArr(I)&""" selected=""selected"" "&style&" >"&textArr(I)&"</option>"&vbcrlf
Anders
str = str&"<option value="""&valueArr(I)&""" >"&textArr(I)&"</option>"&vbcrlf
Ende wenn
Nächste
ShowMultiOpList = str
Funktion beenden
Funktion GetIP()
Dimmen Sie strIPAddr,actforip
Wenn Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" oder InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Dann
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)
Anders
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
Ende wenn
GetIP = strIPAddr
Funktion beenden
'Konvertieren Sie das Array in einen Wörterbuchobjektspeicher
'hashObj: Wörterbuchobjekt
'ary: Array, das Format muss eines der folgenden beiden sein, das erste kann nur Zeichenfolgenwerte speichern
' : array("Id:12","UserName:xilou","Sex:1"), also Array("key:value",...) format
': array(array("Id","12"),array("Benutzername","xilou"),array("Sex",1"))
'Wörterbuchobjekt zurückgeben
'www.chinacms.org
Sub AryAddToHashTable(ByRef hashObj,ary)
Dim str,ht,i,k,v,pos
Für i = 0 Zu UBound(ary)
Wenn IsArray(ary(i)) Dann
Wenn IsObject(ary(i)(0)) Dann
Response.Write „Fehler:AryToHashTable(ary), der Schlüsselwert kann kein Objekttyp sein.“
Response.Write „Der aktuelle ary(“& i &“)(0)-Werttyp ist:“ & TypeName(ary(i)(0))
Response.End()
Ende wenn
If IsObject(ary(i)(1)) Then 'Wenn der Wert ein Objekt ist
Setze hashObj(ary(i)(0)) = ary(i)(1)
Anders
hashObj(ary(i)(0)) = ary(i)(1)
Ende wenn
Anders
str = ary(i) & ""
pos = InStr(str,::)
'www.chinacms.org
Wenn pos < 1 Dann
Response.Write „Error:AryToHashTable(ary),“: „Existiert nicht“
Response.Write „,Occurs at:“ & ary(i)
Response.End()
Ende wenn
Wenn pos = 1, dann
Response.Write „Fehler:AryToHashTable(ary), Schlüsselwert existiert nicht“
Response.Write „,Occurs at:“ & ary(i)
Response.End()
Ende wenn
k = Left(str,pos-1)
v = Mitte(str,pos+1)
hashObj(k) = v
Ende wenn
Nächste
End Sub
'Konvertieren Sie das Array in einen Wörterbuchobjektspeicher
'ary: Array, das Format muss eines der folgenden beiden sein, das erste kann nur Zeichenfolgenwerte speichern
' : array("Id:12","UserName:xilou","Sex:1"), also array("key:value",...) format
' : array(array("Id","12"),array("Benutzername","xilou"),array("Sex",1"))
'Wörterbuchobjekt zurückgeben
Funktion AryToHashTable(ary)
Dim str,ht,i,k,v,pos
Setze ht = Server.CreateObject("Scripting.Dictionary")
ht.CompareMode = 1
AryAddToHashTable ht , ary
Setze AryToHashTable = ht
Endfunktion
„Array in String konvertieren, was der Serialisierung eines Arrays entspricht.“ Die einzigen zulässigen Formate sind:
'array("p1:v1","p2:v2",array("p3",true))
'Rückgabezeichenfolge
Funktion AryToVbsString(arr)
Dim str,i,c
Wenn nicht IsArray(arr), dann Response.Write „Fehler: AryToString(arr) Fehler, Parameter arr ist kein Array“
c = UBound(arr)
Für i = 0 bis c
If IsArray(arr(i)) Then
Fall auswählen LCase(TypeName(arr(i)(1)))
Fall „Datum“, „Zeichenfolge“, „leer“
str = str & ",array(""" & arr(i)(0) & ""","""& arr(i)(1) &""")"
Fall „integer“, „long“, „single“, „double“, „currency“, „decimal“, „boolean“
str = str & ",array(""" & arr(i)(0) & ""","& arr(i)(1) &")"
Fall „null“
str = str & ",array(""" & arr(i)(0) & "",null)"
Fall anders
Response.Write „Fehler: AryToVbsString(arr), der Parameter enthält ungültige Daten, Index i="&i&", der Schlüsselwert ist: „&arr(i)(0)
Response.End()
Endauswahl
Anders
str = str & ",""" & arr(i) & """"
Ende wenn
Nächste
Wenn str <> "" Dann str = Mid(str, 2, Len(str) - 1)
str = "array(" & str & ")"
AryToVbsString = str
Funktion beenden
'--------------------------------Andere Vorgänge werden beendet
%>