2010年07月01日


VBScript(PHP) で氏名をランダムに作成

Random_name
ブラウザでダウンロード
書庫内には PHP バージョンもあります
<JOB>
<COMMENT>
************************************************************
 WEB WSH 実行スケルトン
************************************************************
</COMMENT>

<COMMENT>
************************************************************
 外部スクリプト定義
************************************************************
</COMMENT>
<SCRIPT
	language="VBScript"
	src="http://homepage2.nifty.com/lightbox/laylaClass.vbs">
</SCRIPT>

<SCRIPT language=VBScript>
' ***********************************************************
' 処理開始
' ***********************************************************
Call laylaFunctionTarget( "http://homepage2.nifty.com/lightbox/" )
Call laylaLoadFunction( "baseFunction.vbs" )

nMax = 500

' ***********************************************************
' Cscript.exe で強制実行
' ***********************************************************
Crun

strName1 = "山川森鈴木高田本多村吉岡松丸杉浦中尾安原野内"
strName2 = "和元雅正由克友浩春冬洋輝"
strName3 = "男也一行樹之"
strName4 = "子代美恵"

str = ""

For i = 1 to nMax
	' 姓1文字目
	nTarget = Random( 1, Len(strName1) )
	strName = Mid( strName1, nTarget, 1 )
	' 1文字目と2文字目が一致したら除外
	nTarget2 = nTarget
	Do while( nTarget = nTarget2 )
		nTarget2 = Random( 1, Len(strName1) )
	Loop
	' 姓2文字目
	strName = strName & Mid( strName1, nTarget2, 1 ) & " "
	' 名1文字目
	nTarget = Random( 1, Len(strName2) )
	strName = strName & Mid( strName2, nTarget, 1 )
	' 性別
	nTarget = Random( 0, 1 )
	' 性別によって名2文字目を決定
	if nTarget = 0 then
		nTarget = Random( 1, Len(strName3) )
		strName = strName & Mid( strName3, nTarget, 1 )
	else
		nTarget = Random( 1, Len(strName4) )
		strName = strName & Mid( strName4, nTarget, 1 )
	end if

	str = str & strName & " / "
	if (i-1) Mod 6 = 5 then
		Wscript.Echo str
		str = ""
	end if

Next

if str <> "" then
	Wscript.Echo str
end if

</SCRIPT>
</JOB>

毎回変わるランダム処理は以下のようになります
Function Random( nMin, nMax )

	Randomize
	Random = nMin + Int(Rnd * (nMax - nMin + 1))

End function



posted by at 2010-07-01 15:22 | サンプル | このブログの読者になる | 更新情報をチェックする

2010年06月27日


VBScript : 自分自身をCscript.exe で実行しなおすには

WScript.FullName には、その時使用された Wscript.exe か Cscript.exe の
フルパスが入っていますので、その内容が Wscript.exe であれば、Cscript.exe
で自分自身を実行して、現在の処理は終了してやります。

引数はそのまま全てを文字列に作りなおして呼び出してやるといいです。
Set WshShell = CreateObject( "WScript.Shell" )

' フルパス
strPath = WScript.FullName
strTarget = Right( strPath, 11 )
strTarget = Ucase( strTarget )

' CSCRIPT.EXE で無い場合
if strTarget <> "CSCRIPT.EXE" then
	' 自分自身ののフルパス
	strMyPath = WScript.ScriptFullName
	strParam = " "
	' 引数を全て読みだして、スペースが含まれていた場合は再度引き渡す
	' 為に " で囲み直しています
	For I = 0 to Wscript.Arguments.Count - 1
		if instr(Wscript.Arguments(I), " ") < 1 then
			strParam = strParam & Wscript.Arguments(I) & " "
		else
			strParam = strParam & """" & Wscript.Arguments(I) & """ "
		end if
	Next
	Call WshShell.Run( "cscript.exe """ & strMyPath & """" & strParam, 3 )
	WScript.Quit

end if

' テストの為 強制的に GUI で結果表示
MsgBox( WScript.FullName )
For I = 0 to Wscript.Arguments.Count - 1
	MsgBox( Wscript.Arguments(I) )
Next

関連する記事

VBScript : WEBWSH : Wscript で実行された場合は Cscript で実行しなおす


posted by at 2010-06-27 12:53 | VBScript | このブログの読者になる | 更新情報をチェックする

2010年04月14日


VBScript : 3メガバイト以下のWEB上のバイナリのダウンロード

比較的小さいファイルをダウンロードするのに問題無く使えます。
( 3メガバイトを超えるようなファイルは別の方法を検討します。)
Function HTTPDownload( strUrl, strPath )

	Dim objSrvHTTP,Stream

	Set objSrvHTTP = CreateObject("Msxml2.ServerXMLHTTP.3.0")
	Set Stream = CreateObject("ADODB.Stream")

	HTTPDownload = True

	on error resume next
	Call objSrvHTTP.Open("GET", strUrl, False )
	if Err.Number <> 0 then
		ErrorMessage = Err.Description
		HTTPDownload = False
		Exit Function
	end if
	on error goto 0

	objSrvHTTP.Send

	Stream.Open
	Stream.Type = 1	' バイナリ
	Stream.Write objSrvHTTP.responseBody
	Stream.SaveToFile strPath, 2
	Stream.Close

End Function

関連する記事

WEBのファイルをコマンドラインからダウンロードするスクリプト
 : httpget.vbs ( 2〜3メガまでが目安 )


タグ:XMLHTTP stream
posted by at 2010-04-14 14:48 | ツール関数 | このブログの読者になる | 更新情報をチェックする