この記事では、アドレスの元の文字の抽出、ローカルのシミュレートされたログインへのリモート ファイルの保存、Web ページのソース コードの取得、およびその他の機能関数を含む、ASP コレクション関数の完全なセットについて説明します。 次のようにコードをコピーします。
'================================================ = =
'関数名: GetHttpPage
'機能: Web ページのソースコードを取得します
'パラメータ: HttpUrl -------Web ページのアドレス
'================================================ = =
関数 GetHttpPage(HttpUrl)
IsNull(HttpUrl)=True または Len(HttpUrl)<18 または HttpUrl=$False$ の場合
GetHttpPage=$False$
終了関数
終了の場合
薄暗いHTTP
Http=server.createobject(MSX & ML2.XM & LHT & TP) を設定します。
Http.open GET,HttpUrl,False
Http.Send()
Http.Readystate<>4 の場合、
Http=Nothing を設定します
GetHttpPage=$False$
終了機能
次の場合に終了
GetHTTPPage=bytesToBSTR(Http.responseBody,GB2312)
GetHTTPPage=replace(replace(GetHTTPPage , vbCr,),vbLf,)
Http=Nothing を設定します
Err.number<>0 の場合
エラークリア
終了の場合
終了機能
'================================================ = =
'関数名: BytesToBstr
'機能: 取得したソースコードを中国語に変換します
'パラメータ: 本体 -------変換対象の変数
'パラメータ: Cset ------変換するタイプ
'================================================ = =
関数 BytesToBstr(Body,Cset)
薄暗いオブジェクトストリーム
Objstream = Server.CreateObject(ad & odb.str & eam) を設定します
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.本体の書き込み
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
objstream = 何も設定しない
終了機能
'================================================ = =
'関数名: PostHttpPage
'機能: ログイン
'================================================ = =
関数 PostHttpPage(RefererUrl,PostUrl,PostData)
DimxmlHTTP
DimRetStr
xmlHttp = CreateObject(Msx & ml2.XM & LHT & TP) を設定します。
xmlHttp.Open POST、PostUrl、False
XmlHTTP.setRequestHeader Content-Length,Len(PostData)
xmlHttp.setRequestHeader Content-Type、application/x-www-form-urlencoded
xmlHttp.setRequestHeader リファラー、RefererUrl
xmlHttp.PostData の送信
Err.Number <> 0 の場合、次に
xmlHttp=Nothing を設定します
PostHttpPage = $False$
終了関数
終了の場合
PostHttpPage=bytesToBSTR(xmlHttp.responseBody,GB2312)
xmlHttp = 何も設定しない
終了機能
'================================================ = =
'関数名: URLEncoding
'機能: エンコーディングを変換する
'================================================ = =
関数 URLEncoding(DataStr)
Dim StrReturn、Si、ThisChr、InnerCode、Hight8、Low8
StrReturn =
Si = 1 の場合 Len(DataStr)
ThisChr = Mid(DataStr,Si,1)
If Abs(Asc(ThisChr)) < &HFF then
StrReturn = StrReturn & ThisChr
それ以外
InnerCode = Asc(ThisChr)
InnerCode < 0 の場合
インナーコード = インナーコード + &H10000
終了の場合
Hight8 = (内部コードと &HFF00)/ &HFF
Low8 = インナーコードと &HFF
StrReturn = StrReturn & % & Hex(Hight8) & % & Hex(Low8)
終了の場合
次
URLEncoding = StrReturn
終了機能
'================================================ = =
'関数名: GetBody
'関数: インターセプト文字列
'パラメータ: ConStr -------インターセプトされる文字列
'パラメータ: StartStr -------開始文字列
'パラメータ: OverStr -------終了文字列
'パラメータ: IncluL ------StartStr が含まれるかどうか
'パラメータ:IncluR -------OverStr を含めるかどうか
'================================================ = =
関数 GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
ConStr=$False$ または ConStr= または IsNull(ConStr)=True または StartStr= または IsNull(StartStr)=True または OverStr= または IsNull(OverStr)=True の場合
GetBody=$False$
終了関数
終了の場合
DimConStrTemp
ディムスタート、オーバー
ConStrTemp=Lcase(ConStr)
StartStr=Lcase(StartStr)
OverStr=Lcase(OverStr)
Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
開始<=0 の場合
GetBody=$False$
終了関数
それ以外
IncluL=False の場合
Start=Start+LenB(StartStr)
終了の場合
終了の場合
Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
オーバー<=0 またはオーバー<=スタートの場合
GetBody=$False$
終了関数
それ以外
InclR=True の場合
オーバー=オーバー+LenB(オーバーStr)
終了の場合
終了の場合
GetBody=MidB(ConStr,Start,Over-Start)
終了機能
'================================================ = =
'関数名: GetArray
'機能: $Array$ で区切られたリンク アドレスを抽出します
'パラメータ: ConStr -------アドレスの元の文字を抽出します
'パラメータ: StartStr -------開始文字列
'パラメータ: OverStr -------終了文字列
'パラメータ: IncluL ------StartStr が含まれるかどうか
'パラメータ:IncluR -------OverStr を含めるかどうか
'================================================ = =
関数 GetArray(Byval ConStr,StartStr,OverStr,IncluL,IncluR)
ConStr=$False$ または ConStr= または IsNull(ConStr)=True または StartStr= または OverStr= または IsNull(StartStr)=True または IsNull(OverStr)=True の場合
GetArray=$False$
終了関数
終了の場合
Dim TempStr,TempStr2,objRegExp,Matches,Match
TempStr=
objRegExp = 新しい正規表現を設定します
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = (&StartStr&).+?(&OverStr&)
一致を設定 =objRegExp.Execute(ConStr)
試合中の各試合について
TempStr=TempStr & $Array$ & Match.Value
次
一致=なしを設定します
TempStr= の場合
GetArray=$False$
終了関数
終了の場合
TempStr=Right(TempStr,Len(TempStr)-7)
IncluL=False の場合
objRegExp.Pattern =StartStr
TempStr=objRegExp.Replace(TempStr,)
次の場合に終了
InclR=False の場合
objRegExp.Pattern =OverStr
TempStr=objRegExp.Replace(TempStr,)
次の場合に終了
objRegExp=nothing を設定します
一致=なしを設定します
TempStr=Replace(TempStr,,)
TempStr=Replace(TempStr,',)
TempStr=Replace(TempStr, ,)
TempStr=Replace(TempStr,(,)
TempStr=置換(TempStr,),)
TempStr= の場合
GetArray=$False$
それ以外
GetArray=TempStr
次の場合に終了
終了機能
'================================================ = =
'関数名: DefiniteUrl
'機能: 相対アドレスを絶対アドレスに変換
'パラメータ: PrimitiveUrl ------ 変換する相対アドレス
'パラメータ: ConsultUrl ------現在の Web ページのアドレス
'================================================ = =
関数 DefiniteUrl(Byval PrimitiveUrl,Byval ConsultUrl)
Dim ConTemp、PriTemp、Pi、Ci、PriArray、ConArray
PrimitiveUrl= または ConsultUrl= または PrimitiveUrl=$False$ または ConsultUrl=$False$ の場合
DefiniteUrl=$False$
終了関数
終了の場合
If Left(Lcase(ConsultUrl),7)<>http:// then
ConsultUrl= http:// & ConsultUrl
終了の場合
ConsultUrl=Replace(ConsultUrl,/,/)
ConsultUrl=Replace(ConsultUrl,://,://)
PrimitiveUrl=Replace(PrimitiveUrl,/,/)
正しい場合(ConsultUrl,1)<>/ 次に
Instr(ConsultUrl,/)>0 の場合
Instr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,/)),.)>0 の場合
それ以外
ConsultUrl=ConsultUrl & /
終了の場合
それ以外
ConsultUrl=ConsultUrl & /
終了の場合
終了の場合
ConArray=Split(ConsultUrl,/)
Left(LCase(PrimitiveUrl),7) = http:// の場合、
DefiniteUrl=Replace(PrimitiveUrl,://,://)
ElseIf Left(PrimitiveUrl,1) = / 次に
DefiniteUrl=ConArray(0) & PrimitiveUrl
ElseIf Left(PrimitiveUrl,2)=./ then
PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-2)
正しい場合(ConsultUrl,1)=/ 次に
DefiniteUrl=ConsultUrl および PrimitiveUrl
それ以外
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,/)) & PrimitiveUrl
終了の場合
ElseIf Left(PrimitiveUrl,3)=../ then
Do While Left(PrimitiveUrl,3)=../
PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-3)
円周率=円周率+1
ループ
Ci=0 から (Ubound(ConArray)-1-Pi) の場合
DefiniteUrl<> の場合、次に
DefiniteUrl=DefiniteUrl & / & ConArray(Ci)
それ以外
DefiniteUrl=ConArray(Ci)
終了の場合
次
DefiniteUrl=DefiniteUrl & / & PrimitiveUrl
それ以外
Instr(PrimitiveUrl,/)>0 の場合
PriArray=Split(PrimitiveUrl,/)
Instr(PriArray(0),.)>0 の場合
右の場合(PrimitiveUrl,1)=/ 次に
DefiniteUrl=http:// & PrimitiveUrl
それ以外
Instr(PriArray(Ubound(PriArray)-1),.)>0 の場合
DefiniteUrl=http:// & PrimitiveUrl
それ以外
DefiniteUrl=http:// & PrimitiveUrl & /
終了の場合
終了の場合
それ以外
正しい場合(ConsultUrl,1)=/ 次に
DefiniteUrl=ConsultUrl および PrimitiveUrl
それ以外
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,/)) & PrimitiveUrl
終了の場合
終了の場合
それ以外
Instr(PrimitiveUrl,.)>0 の場合
正しい場合(ConsultUrl,1)=/ 次に
right(LCase(PrimitiveUrl),3)=.cn または right(LCase(PrimitiveUrl),3)=com または right(LCase(PrimitiveUrl),3)=net または right(LCase(PrimitiveUrl),3)=org の場合
DefiniteUrl=http:// & PrimitiveUrl & /
それ以外
DefiniteUrl=ConsultUrl および PrimitiveUrl
終了の場合
それ以外
right(LCase(PrimitiveUrl),3)=.cn または right(LCase(PrimitiveUrl),3)=com または right(LCase(PrimitiveUrl),3)=net または right(LCase(PrimitiveUrl),3)=org の場合
DefiniteUrl=http:// & PrimitiveUrl & /
それ以外
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,/)) & / & PrimitiveUrl
終了の場合
終了の場合
それ以外
正しい場合(ConsultUrl,1)=/ 次に
DefiniteUrl=ConsultUrl & PrimitiveUrl & /
それ以外
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,/)) & / & PrimitiveUrl & /
終了の場合
終了の場合
終了の場合
終了の場合
Left(DefiniteUrl,1)=/ の場合
DefiniteUrl=Right(DefiniteUrl,Len(DefiniteUrl)-1)
次の場合に終了
If DefiniteUrl<> then
DefiniteUrl=Replace(DefiniteUrl,//,/)
DefiniteUrl=Replace(DefiniteUrl,://,://)
それ以外
DefiniteUrl=$False$
終了の場合
終了機能
'================================================ = =
'関数名: ReplaceSaveRemoteFile
'機能: リモート画像を置き換えて保存
'パラメータ: ConStr ------ 置換される文字列
'パラメータ: SaveTf ------ ファイルを保存するかどうか、False は保存しません、True は保存します
'パラメータ: TistUrl----- 現在の Web ページのアドレス
'================================================ = =
関数 ReplaceSaveRemoteFile(ConStr,InstallPath,strChannelDir,SaveTf,TistUrl)
ConStr=$False$ または ConStr= または InstallPath= または strChannelDir= の場合
ReplaceSaveRemoteFile=ConStr
終了関数
終了の場合
Dim TempStr,TempStr2,TempStr3,Re,Matches,Match,Tempi,TempArray,TempArray2
Set Re = 新しい正規表現
Re.IgnoreCase = True
Re.Global = True
Re.Pattern =<img.+?>
一致を設定 =Re.Execute(ConStr)
試合中の各試合について
TempStr<> の場合、
TempStr=TempStr & $Array$ & Match.Value
それ以外
TempStr=Match.Value
次の場合に終了
次
TempStr<> の場合、その後
TempArray=Split(TempStr,$Array$)
TempStr=
Tempi=0 から Ubound(TempArray) の場合
Re.Pattern =src/s*=/s*.+?/.(gifjpgbmpjpegpsdpngsvgdxfwmftiff)
一致を設定 =Re.Execute(TempArray(Tempi))
試合中の各試合について
TempStr<> の場合、
TempStr=TempStr & $Array$ & Match.Value
それ以外
TempStr=Match.Value
次の場合に終了
次
次
次の場合に終了
TempStr<> の場合、その後
Re.Pattern =src/s*=/s*
TempStr=Re.Replace(TempStr,)
終了の場合
一致=なしを設定します
Re=nothing を設定する
TempStr= または IsNull(TempStr)=True の場合
ReplaceSaveRemoteFile=ConStr
終了機能
次の場合に終了
TempStr=Replace(TempStr,,)
TempStr=Replace(TempStr,',)
TempStr=Replace(TempStr, ,)
Dim RemoteFileurl、SavePath、PathTemp、DtNow、strFileName、strFileType、ArrSaveFileName、RanNum、Arr_Path
DtNow=Now()
「**********************************
SaveTf=True の場合、
SavePath=インストールパス&strChannelDir
CheckDir(InstallPath & strChannelDir)=False の場合
CreateMultiFolder(InstallPath & strChannelDir) でない場合は、
応答.Write InstallPath & strChannelDir& ディレクトリの作成に失敗しました
SaveTf=False
終了の場合
終了の場合
終了の場合
'重複した画像を削除することから始めます
TempArray=Split(TempStr,$Array$)
TempStr=
Tempi=0 から Ubound(TempArray) の場合
Instr(Lcase(TempStr),Lcase(TempArray(Tempi)))<1 の場合
TempStr=TempStr & $Array$ & TempArray(Tempi)
終了の場合
次
TempStr=Right(TempStr,Len(TempStr)-7)
TempArray=Split(TempStr,$Array$)
'重複した画像を削除して終了
response.Write <br>画像が見つかりました:<br>&Replace(TempStr,$Array$,<br>)
'相対画像アドレスの変換を開始します
TempStr=
Tempi=0 から Ubound(TempArray) の場合
TempStr=TempStr & $Array$ & DefiniteUrl(TempArray(Tempi),TistUrl)
次
TempStr=Right(TempStr,Len(TempStr)-7)
TempStr=Replace(TempStr,Chr(0),)
TempArray2=Split(TempStr,$Array$)
TempStr=
'相対画像アドレスの変換終了
'画像の差し替え・保存
Set Re = 新しい正規表現
Re.IgnoreCase = True
Re.Global = True
Tempi=0 から Ubound(TempArray2) の場合
「************************************
RemoteFileUrl=TempArray2(Tempi)
RemoteFileUrl<>$False$ かつ SaveTf=True の場合、画像を保存します
ArrSaveFileName = Split(RemoteFileurl,.)
strFileType=Lcase(ArrSaveFileName(Ubound(ArrSaveFileName)))'ファイルの種類
strFileType=asp または strFileType=asa または strFileType=aspx または strFileType=cer または strFileType=cdx または strFileType=exe または strFileType=rar または strFileType=zip の場合
アップロードファイル=
ReplaceSaveRemoteFile=ConStr
終了関数
終了の場合
ランダム化
RanNum=Int(900*Rnd)+100
strFileName = year(DtNow) & right(0 & month(DtNow),2) & right(0 & day(DtNow),2) & right(0 & 時間(DtNow),2) & right(0 & 分(DtNow) ) ),2) & right(0 & Second(DtNow),2) & ranNum & .
Re.Pattern =TempArray(Tempi)
response.Write <br>ローカル アドレスに保存:&InstallPath & strChannelDir & strFileName
SaveRemoteFile(InstallPath & strChannelDir & strFileName,RemoteFileUrl,RemoteFileUrl)=True の場合
応答。書き込み<font color=blue>成功</font><br>
PathTemp=インストールパス & strChannelDir & strFileName
ConStr=Re.Replace(ConStr,PathTemp)
Re.Pattern=インストールパス&strChannelDir
UploadFiles=アップロードファイル & & インストールパス & strChannelDir & strFileName
それ以外
PathTemp=リモートファイルURL
ConStr=Re.Replace(ConStr,PathTemp)
終了の場合
ElseIf RemoteFileurl<>$False$ かつ SaveTf=False then' 画像を保存しません
Re.Pattern =TempArray(Tempi)
ConStr=Re.Replace(ConStr,RemoteFileUrl)
終了の場合
「************************************
次
Re=nothing を設定する
ReplaceSaveRemoteFile=ConStr
終了機能
'================================================ = =
'関数名: ReplaceSwfFile
'機能: アニメーションパスを解析
'パラメータ: ConStr ------ 置換される文字列
'パラメータ: TistUrl----- 現在の Web ページのアドレス
'================================================ = =
関数 ReplaceSwfFile(ConStr,TistUrl)
ConStr=$False$ または ConStr= または TistUrl= または TistUrl=$False$ の場合
ReplaceSwfFile=ConStr
終了関数
終了の場合
Dim TempStr,TempStr2,TempStr3,Re,Matches,Match,Tempi,TempArray,TempArray2
Set Re = 新しい正規表現
Re.IgnoreCase = True
Re.Global = True
Re.Pattern =<object.+?[^/>]>
一致を設定 =Re.Execute(ConStr)
試合中の各試合について
TempStr<> の場合、
TempStr=TempStr & $Array$ & Match.Value
それ以外
TempStr=Match.Value
次の場合に終了
次
TempStr<> の場合、その後
TempArray=Split(TempStr,$Array$)
TempStr=
Tempi=0 から Ubound(TempArray) の場合
Re.Pattern =value/s*=/s*.+?/.swf
一致を設定 =Re.Execute(TempArray(Tempi))
試合中の各試合について
TempStr<> の場合、
TempStr=TempStr & $Array$ & Match.Value
それ以外
TempStr=Match.Value
次の場合に終了
次
次
次の場合に終了
TempStr<> の場合、その後
Re.Pattern =値/s*=/s*
TempStr=Re.Replace(TempStr,)
終了の場合
TempStr= または IsNull(TempStr)=True の場合
ReplaceSwfFile=ConStr
終了機能
次の場合に終了
TempStr=Replace(TempStr,,)
TempStr=Replace(TempStr,',)
TempStr=Replace(TempStr, ,)
一致=なしを設定します
Re=nothing を設定する
' 重複ファイルを削除することから始めます
TempArray=Split(TempStr,$Array$)
TempStr=
Tempi=0 から Ubound(TempArray) の場合
Instr(Lcase(TempStr),Lcase(TempArray(Tempi)))<1 の場合
TempStr=TempStr & $Array$ & TempArray(Tempi)
終了の場合
次
TempStr=Right(TempStr,Len(TempStr)-7)
TempArray=Split(TempStr,$Array$)
'重複ファイルを削除して終了
'相対アドレスの変換を開始します
TempStr=
Tempi=0 から Ubound(TempArray) の場合
TempStr=TempStr & $Array$ & DefiniteUrl(TempArray(Tempi),TistUrl)
次
TempStr=Right(TempStr,Len(TempStr)-7)
TempStr=Replace(TempStr,Chr(0),)
TempArray2=Split(TempStr,$Array$)
TempStr=
'相対アドレス変換終了
'交換する
Set Re = 新しい正規表現
Re.IgnoreCase = True
Re.Global = True
Tempi=0 から Ubound(TempArray2) の場合
RemoteFileUrl=TempArray2(Tempi)
Re.Pattern =TempArray(Tempi)
ConStr=Re.Replace(ConStr,RemoteFileUrl)
次
Re=nothing を設定する
ReplaceSwfFile=ConStr
終了機能
'================================================ = =
'プロセス名: SaveRemoteFile
'機能: リモート ファイルをローカルに保存
'パラメータ: LocalFileName ------ ローカル ファイル名
'パラメータ: RemoteFileUrl ------ リモート ファイル URL
'パラメータ: リファラー ------ リモート呼び出しファイル (収集防止の場合は、コンテンツ ページのアドレスを使用します。収集防止がない場合は空白のままにします)
'================================================ = =
関数 SaveRemoteFile(LocalFileName,RemoteFileUrl,Referer)
SaveRemoteFile=True
dim 広告、取得、GetRemoteData
取得 = Server.CreateObject(Microsoft.XMLHTTP) を設定します。
検索あり
.Open Get、RemoteFileUrl、False、、
if Referer<> then .setRequestHeader Referer,Referer
。送信
.Readystate<>4 の場合、
SaveRemoteFile=False
終了関数
終了の場合
GetRemoteData = .ResponseBody
で終わる
取得 = なしを設定します
Ads = Server.CreateObject(Adodb.Stream) を設定します。
広告あり
.Type = 1
。開ける
.Write GetRemoteData
.SaveToFile サーバー.MapPath(ローカルファイル名),2
。キャンセル（）
。近い（）
で終わる
「広告=なし」を設定します
関数の終了
'================================================ = =
'関数名: GetPaing
'機能: ページネーションの取得
'================================================ = =
関数 GetPaing(Byval ConStr,StartStr,OverStr,IncluL,IncluR)
ConStr=$False$ または ConStr= または StartStr= または OverStr= または IsNull(ConStr)=True または IsNull(StartStr)=True または IsNull(OverStr)=True の場合
GetPaing=$False$
終了関数
終了の場合
ディムスタート、オーバー、ConTemp、TempStr
TempStr=LCase(ConStr)
StartStr=LCase(StartStr)
OverStr=LCase(OverStr)
Over=Instr(1,TempStr,OverStr)
Over<=0 の場合
GetPaing=$False$
終了関数
それ以外
InclR=True の場合
オーバー=オーバー+レン(オーバーStr)
終了の場合
終了の場合
TempStr=Mid(TempStr,1,Over)
Start=InstrRev(TempStr,StartStr)
IncluL=False の場合
開始=開始+Len(StartStr)
終了の場合
開始<=0 または開始>=オーバーの場合
GetPaing=$False$
終了関数
終了の場合
ConTemp=Mid(ConStr,Start,Over-Start)
ConTemp=トリム(ConTemp)
'ConTemp=Replace(ConTemp, ,)
ConTemp=Replace(ConTemp,,,)
ConTemp=Replace(ConTemp,',)
ConTemp=Replace(ConTemp,,)
ConTemp=Replace(ConTemp,>,)
ConTemp=Replace(ConTemp,<,)
ConTemp=Replace(ConTemp, ;,)
GetPaing=ConTemp
終了機能
「************************************************
'関数名: gotTopic
'機能: 文字列を切り詰めます。各中国語文字は 2 文字としてカウントされ、英語文字は 1 文字としてカウントされます。
'パラメータ: str ---- 元の文字列
' strlen ---- 切片の長さ
'戻り値: インターセプトされた文字列
「************************************************
関数 gotTopic(str,strlen)
str= の場合
gotTopic=
終了関数
終了する場合
薄暗い l、t、c、i
str=replace(replace(replace(replace(str, , ),,chr(34)),>,>),<,<)
l=レン(文字列)
t=0
i=1 ～ l の場合
c=Abs(Asc(Mid(str,i,1)))
c>255 の場合
t=t+2
それ以外
t=t+1
終了する場合
t>=strlen の場合
gotTopic=left(str,i) & …
のために出る
それ以外
gotTopic=str
終了する場合
次
gotTopic=replace(replace(replace(replace(gotTopic, , ),chr(34),),>,>),<,<;)
終了関数
「**********************************************
'関数名: JoinChar
'機能: アドレスに ? または & を追加します。
'パラメータ: strUrl ---- URL
'戻り値: ?または&を付加したURL
「**********************************************
関数 JoinChar(strUrl)
if strUrl= then
結合文字=
終了関数
終了する場合
if InStr(strUrl,?)<len(strUrl) then
If InStr(strUrl,?)>1 then
if InStr(strUrl,&)<len(strUrl) then
JoinChar=strUrl & &
それ以外
JoinChar=strUrl
終了する場合
それ以外
JoinChar=strUrl & ?
終了する場合
それ以外
JoinChar=strUrl
終了する場合
終了関数
'************************************************ *
'関数名: CreateKeyWord
'機能: 指定された文字列からキーワードを生成します
'パラメータ: Constr --- キーワードを生成する元の文字列
'戻り値: 生成されたキーワード
'************************************************ *
関数 CreateKeyWord(byval Constr,Num)
Constr= または IsNull(Constr)=True または Constr=$False$ の場合
CreateKeyWord=$False$
終了関数
終了の場合
Num= または IsNumeric(Num)=False の場合
番号=2
終了の場合
Constr=Replace(Constr,CHR(32),)
Constr=Replace(Constr,CHR(9),)
Constr=Replace(Constr, ,)
Constr=Replace(Constr, ,)
Constr=Replace(Constr,(,)
Constr=Replace(Constr,),)
Constr=Replace(Constr,<,)
Constr=Replace(Constr,>,)
Constr=Replace(Constr,,)
Constr=Replace(Constr,?,)
Constr=Replace(Constr,*,)
Constr=Replace(Constr,,)
Constr=Replace(Constr,,,)
Constr=Replace(Constr,.,)
Constr=Replace(Constr,/,)
Constr=Replace(Constr,/,)
Constr=Replace(Constr,-,)
Constr=Replace(Constr,@,)
Constr=Replace(Constr,#,)
Constr=Replace(Constr,$,)
Constr=Replace(Constr,%,)
Constr=Replace(Constr,&,)
Constr=Replace(Constr,+,)
Constr=Replace(Constr,:,)
Constr=Replace(Constr,：,)
Constr=Replace(Constr,',)
Constr=Replace(Constr,,)
Constr=Replace(Constr,,)
Dim i、ConstrTemp
For i=1 To Len(Constr)
ConstrTemp=ConstrTemp & & Mid(Constr,i,Num)
次
Len(ConstrTemp)<254 の場合
ConstrTemp=ConstrTemp &
それ以外
ConstrTemp=Left(ConstrTemp,254) &
終了の場合
CreateKeyWord=ConstrTemp
終了機能
'================================================ = =
'関数名：CheckUrl
'機能: URLをチェック
'パラメータ: strUrl ------ URLを確認する場合
'================================================ = =
関数 CheckUrl(strUrl)
ディム・レ
Re=新しい正規表現を設定
Re.IgnoreCase=true
Re.Global=True
Re.Pattern=http://([/w-]+/.)+[/w-]+(/[/w-./?%&=]*)?
Re.test(strUrl)=True の場合
CheckUrl=strUrl
それ以外
CheckURL=$False$
終了の場合
Rs=何も設定しない
終了機能
'================================================ = =
'関数名：ScriptHtml
'機能: HTMLタグをフィルターします
'パラメータ: ConStr ------ フィルタリングする文字列
'================================================ = =
関数 ScriptHtml(Byval ConStr,TagName,FType)
ディム・レ
Re=新しい正規表現を設定
Re.IgnoreCase=true
Re.Global=True
ケースFタイプを選択してください
ケース1
Re.Pattern=< & タグ名 & ([^>])*>
ConStr=Re.Replace(ConStr,)
ケース2
Re.Pattern=< & タグ名 & ([^>])*>.*?</ & タグ名 & ([^>])*>
ConStr=Re.Replace(ConStr,)
ケース3
Re.Pattern=< & タグ名 & ([^>])*>
ConStr=Re.Replace(ConStr,)
Re.Pattern=</ & タグ名 & ([^>])*>
ConStr=Re.Replace(ConStr,)
エンドセレクト
ScriptHtml=ConStr
Re=Nothing を設定する
終了機能
'================================================ = =
'関数名: RemoveHTML
'機能: HTMLタグを完全に削除します
'パラメータ: strHTML ------ フィルタリングする文字列
'================================================ = =
関数 RemoveHTML(strHTML)
Dim objRegExp、一致、一致
objRegExp = 新しい正規表現を設定します
objRegExp.IgnoreCase = True
objRegExp.Global = True
'閉じた <> を取得します
objRegExp.Pattern = <.+?>
'マッチ
一致を設定 = objRegExp.Execute(strHTML)
' 一致するセットを走査し、一致する項目を置き換えます
試合中の各試合について
strHtml=Replace(strHTML,Match.Value,)
次
RemoveHTML=strHTML
objRegExp = なしを設定します
終了機能
'================================================ = =
'関数名: CheckDir
'機能: フォルダーが存在するかどうかを確認します
'パラメータ: FolderPath ------ フォルダー パス
'================================================ = =
関数 CheckDir(byval FolderPath)
薄暗いfso
fso = Server.CreateObject(Scripting.FileSystemObject) を設定します。
fso.FolderExists(Server.MapPath(folderpath)) の場合
'存在する
CheckDir = True
それ以外
「存在しない」
CheckDir = False
次の場合に終了
fso = 何も設定しない
終了機能
'================================================ = =
'関数名: MakeNewsDir
'機能: フォルダーを作成します
'パラメータ: フォルダ名 ------ フォルダ名
'================================================ = =
関数 MakeNewsDir(byval フォルダー名)
薄暗いfso
fso = Server.CreateObject(Scri & pti & ng.Fil & eSyst & emOb & ject) を設定します。
fso.CreateFolder(Server.MapPath(フォルダ名))
fso.FolderExists(Server.MapPath(フォルダ名)) の場合
MakeNewsDir = True
それ以外
MakeNewsDir = False
終了の場合
fso = 何も設定しない
終了機能
'================================================ = =
'関数名: DelDir
'機能: フォルダーを作成します
'パラメータ: フォルダ名 ------ フォルダ名
'================================================ = =
関数 DelDir(byval フォルダー名)
薄暗いfso
fso = Server.CreateObject(Scri & pti & ng.Fil & eSyst & emOb & ject) を設定します。
If fso.FolderExists(Server.MapPath(foldername)) then 'フォルダーが存在するかどうかを判断します
fso.DeleteFolder (Server.MapPath(フォルダ名)) 'フォルダを削除します
終了の場合
fso = 何も設定しない
終了機能
'************************************************ *
'関数名: IsObjInstalled
'機能: コンポーネントがインストールされているかどうかを確認します
'パラメータ: strClassString ---- コンポーネント名
'戻り値: True ---- すでにインストールされています
' False ---- インストールされていません
'************************************************ *
関数 IsObjInstalled(strClassString)
IsObjInstalled = False
エラー = 0
DimxTestObj
xTestObj = Server.CreateObject(strClassString) を設定します
0 = エラーの場合、IsObjInstalled = True
xTestObj = なしを設定します
エラー = 0
終了機能
'************************************************ *
'関数名: strLength
'機能: 文字列の長さを調べます。中国語は 2 文字、英語は 1 文字としてカウントされます。
'パラメータ: str ----必要な長さの文字列
'戻り値: 文字列長
'************************************************ *
関数 strLength(str)
エラー時は次へ再開
薄暗いWINNT_CHINESE
WINNT_CHINESE = (len(中国)=2)
WINNT_CHINESEの場合
薄暗い l、t、c
薄暗い私
l=レン(文字列)
t=l
i=1 ～ l の場合
c=asc(mid(str,i,1))
c<0 の場合、c=c+65536
c>255 の場合
t=t+1
終了する場合
次
strLength=t
それ以外
strLength=len(str)
終了する場合
if err.number<>0 then err.clear
終了関数
'************************************************ * **
'関数名: CreateMultiFolder
'機能: マルチレベルのディレクトリを作成します。存在しないルート ディレクトリを作成できます
'パラメータ: 作成するディレクトリの名前。複数レベルにすることができます。
'戻り値の論理値: 成功した場合は True、失敗した場合は False
'カレントディレクトリから始まるディレクトリのルートディレクトリを作成
'************************************************ * **
関数 CreateMultiFolder(ByVal CFolder)
Dim objFSO、PhCreateFolder、CreateFolderArray、CreateFolder
Dim i、ii、CreateFolderSub、PhCreateFolderSub、BlInfo
BlInfo=False
CreateFolder = CFolder
エラー時は次へ再開
objFSO = Server.CreateObject(Scri & pti & ng.Fil & eSyst & emOb & ject) を設定します。
エラーの場合はその後
エラークリア()
終了関数
終了の場合
CreateFolder = Replace(CreateFolder,/,/)
If Left(CreateFolder,1)=/ then
'CreateFolder = Right(CreateFolder,Len(CreateFolder)-1)
終了の場合
右の場合(CreateFolder,1)=/ 次に
CreateFolder = Left(CreateFolder,Len(CreateFolder)-1)
終了の場合
CreateFolderArray = Split(CreateFolder,/)
i = 0 の場合、UBound(CreateFolderArray)
CreateFolderSub =
ii = 0 ～ i の場合
CreateFolderSub = CreateFolderSub & CreateFolderArray(ii) & /
次
PhCreateFolderSub = Server.MapPath(CreateFolderSub)
'response.Write PhCreateFolderSub&<br>
objFSO.FolderExists(PhCreateFolderSub) でない場合
objFSO.CreateFolder(PhCreateFolderSub)
終了の場合
次
エラーの場合はその後
エラークリア()
それ以外
BlInfo=True
終了の場合
objFSO=nothing を設定します
CreateMultiFolder = BlInfo
終了機能
'************************************************ *
'関数名: FSOFileRead
'機能: FSO を使用してファイルの内容を読み取る関数
'パラメータ: ファイル名 ---- ファイル名
'戻り値: ファイルの内容
'************************************************ *
関数 FSOFileRead(ファイル名)
Dim objFSO、objCountFile、FiletempData
objFSO = Server.CreateObject(Scripting.FileSystemObject) を設定します。
Set objCountFile = objFSO.OpenTextFile(Server.MapPath(ファイル名),1,True)
FSOFileRead = objCountFile.ReadAll
objCountFile.Close
objCountFile=Nothing を設定します
objFSO = なしを設定します
終了機能
'************************************************ *
'関数名：FSOlinedit
'機能: FSO を使用してファイル関数の特定の行を読み取ります
'パラメータ: ファイル名 ---- ファイル名
' lineNum ---- 行番号
'戻り値: ファイル内の行の内容
'************************************************ *
関数 FSOlinedit(ファイル名,行番号)
linenum < 1 の場合、関数を終了します
dim fso、f、temparray、tempcnt
set fso = server.CreateObject(scripting.filesystemobject)
fso.fileExists(server.mappath(filename)) でない場合は関数を終了します
set f = fso.opentextfile(server.mappath(ファイル名),1)
f.AtEndofStream ではない場合
tempcnt = f.readall
f.閉じる
f = 何も設定しない
temparray = split(tempcnt,chr(13)&chr(10))
if lineNum>ubound(temparray)+1 then
終了関数
それ以外
FSOlineedit = temparray(lineNum-1)
終了する場合
終了する場合
終了関数
'************************************************ *
'関数名: FSOlinewrite
'機能: FSO を使用してファイル関数の特定の行を書き込みます
'パラメータ: ファイル名 ---- ファイル名
' lineNum ---- 行番号
' 行内容 ---- 内容
'戻り値: なし
'************************************************ *
関数 FSOlinewrite(ファイル名,行番号,行内容)
linenum < 1 の場合、関数を終了します
dim fso、f、temparray、tempCnt
set fso = server.CreateObject(scripting.filesystemobject)
fso.fileExists(server.mappath(filename)) でない場合は関数を終了します
set f = fso.opentextfile(server.mappath(ファイル名),1)
f.AtEndofStream ではない場合
tempcnt = f.readall
f.閉じる
temparray = split(tempcnt,chr(13)&chr(10))
if lineNum>ubound(temparray)+1 then
終了関数
それ以外
temparray(lineNum-1) = lineContent
終了する場合
tempcnt = join(temparray,chr(13)&chr(10))
set f = fso.createtextfile(server.mappath(ファイル名),true)
f.writetempcnt
終了する場合
f.閉じる
f = 何も設定しない
終了関数
'************************************************ *
'関数名：HTMLmake
'機能: FSO を使用してファイルを作成する
'パラメータ: HtmlFolder ---- パス
' HtmlFilename ---- ファイル名
'HtmlContent ----コンテンツ
'************************************************ *
function Htmlmake(HtmlFolder,HtmlFilename,HtmlContent)
エラー時は次へ再開
dim ファイルパス、fso、fout
ファイルパス = HtmlFolder&/&HtmlFilename
fso = Server.CreateObject(Scripting.FileSystemObject) を設定します。
fso.FolderExists(HtmlFolder) の場合
それ以外
マルチフォルダーの作成(HTMLフォルダー)
&、;nbs、p;
fout = fso.Createtextfile(server.mappath(filepath),true) を設定します。
fout.writeline HTMLContent
fout.close
fso=何も設定しない
fso = Server.CreateObject(Scripting.FileSystemObject) を設定します。
fso.fileexists(Server.MapPath(filepath)) の場合
Response.Write ファイル<font color=red>&HtmlFilename&</font>が生成されました!<br>
それ以外
'Response.Write Server.MapPath(ファイルパス)
Response.Write ファイル<font color=red>&HtmlFilename&</font> は生成されませんでした!<br>
終了の場合
fso = 何も設定しない
終了機能
'************************************************ *
'関数名：HTMLdel
'機能: FSO を使用してファイルを削除する
'パラメータ: HtmlFolder ---- パス
' HtmlFilename ---- ファイル名
'************************************************ *
サブ Htmldel(HtmlFolder,HtmlFilename)
dim ファイルパス、fso
ファイルパス = HtmlFolder&/&HtmlFilename
fso = CreateObject(Scripting.FileSystemObject) を設定します。
fso.DeleteFile(Server.mappath(ファイルパス))
fso = 何も設定しない
fso = Server.CreateObject(Scripting.FileSystemObject) を設定します。
fso.fileexists(Server.MapPath(filepath)) の場合
Response.Write ファイル<font color=red>&HtmlFilename&</font>は削除されていません!<br>
それ以外
'Response.Write Server.MapPath(ファイルパス)
Response.Write ファイル<font color=red>&HtmlFilename&</font> は削除されました!<br>
終了の場合
fso = 何も設定しない
エンドサブ
'================================================ =
'プロセス名: HTMLEncode
'機能: HTML形式をフィルタリングします
'パラメータ: fString ----変換内容
'================================================ =
関数 HTMLEncode(ByVal fString)
IsNull(fString)=False または fString<> または fString<>$False$ の場合
fString = 置換(fString, >, >)
fString = 置換(fString, <, <)
fString = Replace(fString, Chr(32), )
fString = Replace(fString, Chr(9), )
fString = Replace(fString, Chr(34), )
fString = Replace(fString, Chr(39), ')
fString = Replace(fString, Chr(13), )
fString = 置換(fString, , )
fString = Replace(fString, CHR(10) & CHR(10), </P><P>)
fString = Replace(fString, Chr(10), <br /> )
HTMLエンコード = fString
それ以外
HTMLエンコード = $False$
終了する場合
終了関数
'================================================ =
'プロセス名: unHTMLEncode
'機能: HTML 形式を復元
'パラメータ: fString ----変換内容
'================================================ =
関数 unHTMLEncode(ByVal fString)
IsNull(fString)=False または fString<> または fString<>$False$ の場合
fString = 置換(fString, >, >)
fString = 置換(fString, <, <)
fString = Replace(fString, , Chr(32))
fString = Replace(fString, , Chr(34))
fString = Replace(fString, ', Chr(39))
fString = Replace(fString, , Chr(13))
fString = 置換(fString, , )
fString = Replace(fString, </P><P> , CHR(10) & CHR(10))
fString = Replace(fString, <br> , Chr(10))
unHTMLEncode = fString
それ以外
unHTMLEncode = $False$
終了する場合
終了関数
関数 unhtmllist(コンテンツ)
unhtmllist=コンテンツ
コンテンツ <> の場合
unhtmllist=replace(unhtmllist,',;)
unhtmllist=replace(unhtmllist,chr(10),)
unHtmllist=replace(unHtmllist,chr(13),<br>)
終了する場合
終了関数
関数 unhtmllists(コンテンツ)
unhtmllists=コンテンツ
コンテンツ <> の場合
unhtmllists=replace(unhtmllists,,)
unhtmllists=replace(unhtmllists,',)
unhtmllists=replace(unhtmllists,chr(10),)
unHtmllists=replace(unHtmllists,chr(13),<br>)
終了する場合
終了関数
関数 htmllists(コンテンツ)
htmlリスト=コンテンツ
コンテンツ <> の場合
htmllists=replace(htmllists,'',)
htmllists=replace(htmllists,,')
htmllists=replace(htmllists,<br>,chr(13)&chr(10))
終了する場合
終了関数
関数 uhtmllists(コンテンツ)
uhtmllists=コンテンツ
コンテンツ <> の場合
uhtlists=replace(uhtlists,,'')
uhtlists=replace(uhtlists,',;)
uhtlists=replace(uhtlists,chr(10),)
uHtmllists=replace(uHtmllists,chr(13),<br>)
終了する場合
終了関数
'================================================ =
'プロセス: スリープ
'機能: プログラムはここで数秒間停止します
'パラメータ: iSeconds 一時停止する秒数
'================================================ =
サブスリープ(i秒)
response.Write <font color=blue>&iSeconds& 秒間の一時停止を開始</font><br>
ディム t:t=タイマー()
While(Timer()<t+iSeconds)
「何もしないで」
ウェン
response.Write <font color=blue>一時停止&iSeconds& 秒終了</font><br>
エンドサブ
'================================================ = =
'関数名: MyArray
'機能: 分離するタグを抽出します
'パラメータ: ConStr -------アドレスの元の文字を抽出します
'================================================ = =
関数 MyArray(ByvalConStr)
objRegExp = 新しい正規表現を設定します
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = ({).+?(})
一致を設定 =objRegExp.Execute(ConStr)
試合中の各試合について
TempStr=TempStr & & Match.Value
次
一致=なしを設定します
TempStr=Right(TempStr,Len(TempStr)-1)
objRegExp.Pattern ={
TempStr=objRegExp.Replace(TempStr,)
objRegExp.Pattern =}
TempStr=objRegExp.Replace(TempStr,)
objRegExp=nothing を設定します
一致=なしを設定します
TempStr=Replace(TempStr,$,)
TempStr= の場合
MyArray=コード内に抽出するものがありません
それ以外
MyArray=TempStr
次の場合に終了
終了機能
'================================================ = =
'関数名: randm
'機能: 6桁の乱数を生成
'================================================ = =
関数ランダム
ランダム化する
randm=Int((900000*rnd)+100000)
終了機能
%>