この記事では、アドレスの元の文字の抽出、ローカルのシミュレートされたログインへのリモート ファイルの保存、Web ページのソース コードの取得などの機能を含む、ASP コレクション関数の完全なセットを提供します。
次のようにコードをコピーします。
'================================================ = =
'関数名: GetHttpPage
'機能: Web ページのソースコードを取得します
'パラメータ: HttpUrl -------Web ページのアドレス
'================================================ = =
関数 GetHttpPage(HttpUrl)
IsNull(HttpUrl)=True または Len(HttpUrl)<18 または HttpUrl="$False$" の場合
GetHttpPage="$False$"
終了関数
終了の場合
薄暗いHTTP
Set 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)
薄暗いオブジェクトストリーム
Set 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
Set 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 "Referer"、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=Replace(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)<>"/" then
Instr(ConsultUrl,"/")>0 の場合
If 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) = "/" then
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 の場合
Right(PrimitiveUrl,1)="/" の場合
DefiniteUrl="http://" & PrimitiveUrl
それ以外
If Instr(PriArray(Ubound(PriArray)-1),".")>0 then
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)="組織" 次に、
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)="組織" 次に、
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)
次の場合に終了
DefiniteUrl<>"" の場合、次に
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) でない場合は、
response.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 = 年(DtNow) & right("0" & 月(DtNow),2) & right("0" & 日(DtNow),2) & right("0" & 時間(DtNow) ),2) & right ("0" & 分(DtNow),2) & right("0" & 秒(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
Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
検索あり
.Open "Get"、RemoteFileUrl、False、""、""
if Referer<>"" then .setRequestHeader "Referer",Referer
。送信
.Readystate<>4 の場合、
SaveRemoteFile=False
終了関数
終了の場合
GetRemoteData = .ResponseBody
で終わる
取得 = なしを設定します
Set 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(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(gotTopic," "," "),chr(34),"""),">",">"),"<","<;")
終了関数
「**********************************************
'関数名: JoinChar
'機能: アドレスに ? または & を追加します。
'パラメータ: strUrl ---- URL
'戻り値: ?または&を付加したURL
「**********************************************
関数 JoinChar(strUrl)
strUrl="" の場合
JoinChar=""
終了関数
終了する場合
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
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.FolderExists(Server.MapPath(folderpath)) の場合
'存在する
CheckDir = True
それ以外
「存在しない」
CheckDir = False
次の場合に終了
fso = 何も設定しない
終了機能
'================================================ = =
'関数名: MakeNewsDir
'機能: フォルダーを作成します
'パラメータ: フォルダ名 ------ フォルダ名
'================================================ = =
関数 MakeNewsDir(byval フォルダー名)
薄暗いfso
Set 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
Set 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
エラー時は次へ再開
Set objFSO = Server.CreateObject("Scri" & "pti" & "ng.Fil" & "eSyst" & "emOb" & "ject")
エラーの場合はその後
エラークリア()
終了関数
終了の場合
CreateFolder = Replace(CreateFolder,"/","/")
Left(CreateFolder,1)="/" の場合
'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
Set 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
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.FolderExists(HtmlFolder) の場合
それ以外
マルチフォルダーの作成(HTMLフォルダー)
&、;nbs、p;
fout = fso.Createtextfile(server.mappath(filepath),true) を設定します。
fout.writeline HTMLContent
fout.close
fso=何も設定しない
Set 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
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile(Server.mappath(ファイルパス))
fso = 何も設定しない
Set 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 = Replace(fString, ">", ">")
fString = Replace(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 = Replace(fString, " ", " ")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P>")
fString = Replace(fString, Chr(10), "<br /> ")
HTMLエンコード = fString
それ以外
HTMLEncode = "$False$"
終了する場合
終了関数
'================================================ =
'プロセス名: unHTMLEncode
'機能: HTML 形式を復元
'パラメータ: fString ----変換内容
'================================================ =
関数 unHTMLEncode(ByVal fString)
IsNull(fString)=False または fString<>"" または fString<>"$False$" の場合
fString = Replace(fString, ">", ">")
fString = Replace(fString, "<", "<")
fString = Replace(fString, " ", Chr(32))
fString = Replace(fString, """, Chr(34))
fString = Replace(fString, "'", Chr(39))
fString = Replace(fString, "", Chr(13))
fString = Replace(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リスト=コンテンツ
if content <> "" then
htmllists=replace(htmllists,""","""")
htmllists=replace(htmllists,"","'")
htmllists=replace(htmllists,"<br>",chr(13)&chr(10))
終了する場合
終了関数
関数 uhtmllists(コンテンツ)
uhtmllists=コンテンツ
if content <> "" then
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>Pause"&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)
終了機能
%>