SQLの窓

2015年02月25日


VBScript : WMI と NT Provider(ADSI) をそれぞれ使用して、共有を『登録』『一覧』『削除』するサンプル

処理が失敗して共有がもし残った場合は、Windows のコンピュータの管理(%windir%\system32\compmgmt.msc /s)から『共有の停止』を実行します

サンプルでは、WMI と ADSI の両方で処理を記述していますが、WMI のほうが今では推奨されると思います。ADSI のドキュメントは解りにくい上にちゃんとしたものが無いので、これ以上の事をしようとすると苦労すると思います。但し、ローカルユーザを自動的に大量に登録する必要がある場合は、NT Provider は比較的簡単かもしれません。

関連する Microsoft のドキュメント

ADSI を使用してファイル共有を管理する方法
How Can I Share a Folder on a Remote Computer?
Win32_Share class
<JOB>
<OBJECT id="WshShell" progid="WScript.Shell" />
<OBJECT id="Fso" progid="Scripting.FileSystemObject" />
<SCRIPT language="VBScript">

Crun

' **************************************
' スクリプトが存在するディレクトリを取得
' **************************************
strScriptPath = WScript.ScriptFullName
Set obj = Fso.GetFile( strScriptPath )
Set obj = obj.ParentFolder
strScriptPath = obj.Path

' **************************************
' 共有作成(WMI)
' **************************************
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set objShare = objWMIService.Get("Win32_Share")
Call objShare.Create( strScriptPath, "ここが共有名ですA", 0 )

' **************************************
' 共有一覧(WMI)
' **************************************
Set colShares = objWMIService.ExecQuery("Select * from Win32_Share")
Wscript.Echo "【共有一覧】"
Wscript.Echo "----------------------------------------------------"
For Each Share In colShares
	Wscript.Echo RpadB(Share.Name, " ", 20) & " : " & Share.Path
Next
Wscript.Echo

' **************************************
' 共有削除(WMI)
' **************************************
Set colShares = objWMIService.ExecQuery("Select * from Win32_Share where Name = 'ここが共有名ですA'")
For Each Share In colShares
	Share.Delete
Next
Wscript.Echo

' **************************************
' 共有作成(WinNT Provider)
' **************************************
Set colShares = GetObject("WinNT://./LanmanServer")
Set objShare = colShares.Create("fileshare", "ここが共有名ですB")
objShare.Path = strScriptPath
objShare.SetInfo

' **************************************
' 共有一覧(WinNT Provider)
' **************************************
Wscript.Echo "【共有一覧】"
Wscript.Echo "----------------------------------------------------"
For Each Share In colShares
	Wscript.Echo RpadB(Share.Name, " ", 20) & " : " & Share.Path
Next
Wscript.Echo

' **************************************
' 共有削除(WinNT Provider)
' **************************************
colShares.Delete "fileshare", "ここが共有名ですB"
Wscript.Echo

' 終了確認
Wscript.Echo "処理が終了しました"

' **************************************
' Cscript.exe で実行を強制
' Cscript.exe の実行終了後 pause で一時停止
' **************************************
Function Crun( )

	Dim str

	str = WScript.FullName
	str = Right( str, 11 )
	str = Ucase( str )
	if str <> "CSCRIPT.EXE" then
		str = 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 & Dd(Wscript.Arguments(I)) & " "
			end if
		Next
		Call WshShell.Run( "cmd.exe /c cscript.exe " & Dd(str) & strParam & " & pause", 3 )
		WScript.Quit
	end if

End Function
' **************************************
' 文字列を " で囲む関数
' **************************************
Function Dd( strValue )

	Dd = """" & strValue & """"

End function

' **************************************
' 文字列の右側をスペースで埋める
' **************************************
Function RpadB( strValue, str, nLen )

	Dim strWork,nLen2

	strWork = Left( strValue & String(nLen,str), nLen )
	nLen2 = nLen

	Do While ByteLen( strWork ) > nLen
		nLen2 = nLen2 - 1
		if nLen2 <= 0 then
			Exit Do
		end if
		strWork = Left( strValue & String(nLen,str), nLen2 )
	Loop
	RpadB = strWork

End function
' **************************************
' 文字列のバイト計算
' **************************************
Function ByteLen( strTarget )

	Dim i,nLen,nRet,strMoji,nAsc

	nRet = 0

	nLen = Len( strTarget )

	For i = 1 to nLen
		nRet = nRet + 2
		strMoji = Mid( strTarget, i, 1 )
		nAsc = Asc( strMoji )
		if &H0 <= nAsc and nAsc <= &H80 then
			nRet = nRet - 1
		end if
		if &HA0 <= nAsc and nAsc <= &HDF then
			nRet = nRet - 1
		end if
		if &HFD <= nAsc and nAsc <= &HFF then
			nRet = nRet - 1
		end if
	Next

	ByteLen = nRet

End Function
</SCRIPT>
</JOB>


実行結果

Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation 1996-2001. All rights reserved.

【共有一覧】
----------------------------------------------------
ADMIN$               : C:\Windows
C$                   : C:\
D$                   : D:\
IPC$                 :
print$               : C:\Windows\system32\spool\drivers
temp                 : C:\Users\lightbox\AppData\Local\Temp
Users                : C:\Users
ここが共有名ですA    : C:\user\vbs


【共有一覧】
----------------------------------------------------
print$               : C:\Windows\system32\spool\drivers
temp                 : C:\Users\lightbox\AppData\Local\Temp
Users                : C:\Users
ここが共有名ですB    : C:\user\vbs


処理が終了しました
続行するには何かキーを押してください . . .
※ 実行終了後、共有は削除されています
posted by lightbox at 2015-02-25 16:00 | VBS + WMI | このブログの読者になる | 更新情報をチェックする

2015年02月24日


VBScript : Access のテーブルを TransferText メソッドを使用して UTF-8 で CSV または HTML にして出力する



syain.html

Microsoft ドキュメント

DoCmd.TransferText メソッド

AcTextTransferType

サポートするコード ページ

概要

CSV と HTML で出力していますが、どちらも最後の引数にコードページを示す値で、UTF-8 を意味する 65001 をセットしています。そうすると、HTML では自動的に META 要素に UTF-8 が設定されて、ファイルは UTF8N になります。CSV もまた UTF8N で出力されます。

最初の引数で、エクスポートタイプを指定していますが、本来定数定義されているタイプライブラリを GUID で参照してそのまま使用しています。

GUID は、OLE-COM Object Viewer(Visual Studio 2010) で、Type Libraries ツリーより Microsoft Access 14.0 Object Library を開いて 取得しています。
<JOB>
<OBJECT id="Acc" progid="Access.Application" />
<OBJECT id="Fso" progid="Scripting.FileSystemObject" />
<REFERENCE guid="4AFFC9A0-5F99-101B-AF4E-00AA003F0F07" />
<SCRIPT language="VBScript">
' **************************************
' スクリプトのあるディレクトリの取得
' **************************************
strCurPath = WScript.ScriptFullName
Set obj = Fso.GetFile( strCurPath )
Set obj = obj.ParentFolder
strCurPath = obj.Path

Acc.OpenCurrentDatabase( strCurPath & "\社員マスタ.accdb") 

Acc.docmd.TransferText acExportDelim, "", "社員マスタ", strCurPath & "\syain.csv", true, "", 65001
Acc.docmd.TransferText acExportHTML, "", "社員マスタ", strCurPath & "\syain.html", true, "", 65001

Acc.docmd.Closedatabase

' 終了確認
Wscript.Echo "処理が終了しました"

</SCRIPT>
</JOB>

ファイルのバスの後の True は、1 行目をフィールド名として使用すると言う意味です。。テキスト ファイルの 1 行目をデータとして処理する場合は、False (0) を使います。この引数を指定しないと、False (既定値) が使われます。


タグ:VBScript access
posted by lightbox at 2015-02-24 21:17 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする

2015年02月18日


IE11 を IE8として設定して VBScript から jQuery を使う方法

想定する環境は、社内の IE11 でのイントラネットです。jQuery を使う事によってページ上のコンテンツを効率良く扱えるはずで、Excel との連携に役立つと思います。

デモページ( 開発者ツールを表示させてから再表示して下さい )

5行目の空のスクリプト要素は、このページのデフォルトのスクリプトを VBScript にする為にできるだけ先頭に置いています。その上の META 要素によって、VBScript が一番安心して動作すると思われる IE8 のドキュメントモードに変更しています。また、その動作が正常に行われている事を確認する為に、11行目で document.documentMode を出力しています。

VBScript から呼ばれるサポート関数

やはり、VBScript だけでは関数の扱いで無理があるので、サポート関数を JavaScript 側に用意しています。jQuery の全ての処理で使えるわけではありませんが、each メソッドと click メソッドのサポートができるようにしています。

VBScript の関数名は、文字列で指定して JavaScript 側で eval で実際に呼び出しています。想定する環境が閉鎖環境なので、このような使い方で問題無いと思います。( そもそも、IE でないとこのページは動作しません )

jQuery は、1.9.1 でテストしました。あまり新しいと IE には都合が悪いかもしれないのでこのへんのバージョンを使用しています。
<!DOCTYPE html>
<html>
<head>
<meta http-equiv="x-ua-compatible" content="IE=8">
<script language="VBScript"></script>
<script language="JScript" type="text/javascript" src="//ajax.googleapis.com/ajax/libs/jquery/1.9.1/jquery.min.js"></script>
</head>
<body>
<div style='position:absolute;left:0px;top:0px;font-size:8px;color:#999999;'>
<script language="VBScript">
Call document.write(document.documentMode)
</script>
</div>

<pre>

	<input type="button" value="実行">
	<input type="text" name="f001" value="1234567"     > 番号
	<input type="text" name="f002" value="あいうえお"  > 氏名
	<input type="text" name="f003" value="123-1567"    > 郵便番号
	<input type="text" name="f004" value="日本のどこか"> 住所
	<input type="text" name="f005" value="1999/01/10"  > 誕生日

	<input
		type="button"
		value="直イベント"
		onclick="Call alert('VBScriptがデフォルトです')">
</pre>

<script language="JScript" type="text/javascript">
// **********************************
// VBScript から呼ばれるサポート関数
// **********************************
function eachLoop( ) {
	eval( arguments[0] + "("+window.vbscnt+",this)" );
	window.vbscnt++;
}
function callback( obj ) {
	eval( obj.data )
}
function arr( param ) {
	window.vbscnt = 0;
	var a = [];
	a[0] = param;
	return a;
}
</script>
<script language="VBScript">
' **********************************
' click イベントを MyFunc で呼び出す
' **********************************
Call jQuery("input").eq(0).click( "MyFunc(this)", callback )
' 引数を二つで、click メソッドを呼んでいるので、Call が必要です

' **********************************
' jQuery オブジォクトの作成
' **********************************
Set gdata = jQuery("pre input")

' **********************************
' Each 処理を VBS の MyLoop で呼び出す
' **********************************
Call gdata.each( eachLoop, arr("MyLoop") )

' **********************************
' Each 処理用 MyLoop
' **********************************
function MyLoop( idx, objThis )
	console.log( objThis )
	console.log( idx )
end function

' **********************************
' イベント用 MyFunc
' **********************************
function MyFunc( objThis )
	console.dir( objThis )
end function

</script>

</form>
</body>
</html>




タグ:jquery VBScript IE11
posted by lightbox at 2015-02-18 16:33 | jQuery | このブログの読者になる | 更新情報をチェックする

2015年02月14日


PHP による『超簡易掲示板』 / アプリケーションからの POST 検証用



デモページ

2015-02-14 : 更新
コメントを追加して、特殊な文字を無効化しました

2013/01/07 : 更新
Chrome での表示で、\n 埋め込まれているデータを <br /> に変換して、実際に改行して見えるようにしました。

Windows Phone(C#) から使うと、エミュレータ内では取得しにくい長い文字列を LOG 等の目的で出力可能です。

1) Google Chrome から実行すると、『掲示板として動作します』
※ F12 の開発者ツールでデバイスモードにしてから、リセットして UA に適当な文字を入力して再表示すると JSON 表示されます( iPad 等でもいいですが、それではテキスト選択ができません )







2) それ以外のブラウザからだと、表示されるのは JSON です
<?php
// **************************************
// ブラウザの判定をしています
// ( $_SERVER['HTTP_USER_AGENT'] )
// **************************************
$AGENT = "";
if ( strpos( $_SERVER['HTTP_USER_AGENT'], "Chrome") !== false ) {
	$AGENT = "Chrome";
}

// **************************************
// ブラウザが Google Chrome の場合のみ
// 通常の HTML として出力します
// ※ キャラクタセットは UTF-8 です
// **************************************
if ( $AGENT == "Chrome" ) {
	header( "Content-Type: text/html; Charset=utf-8" );
}
else {
	header( "Content-Type: text/plain; Charset=utf-8" );
}

// **************************************
// キャッシュを無効にするヘッダです
// **************************************
header( "pragma: no-cache" );
header( "Expires: Wed, 31 May 2000 14:59:58 GMT" );
header( "Cache-control: no-cache" );

$log_text = @file_get_contents("./text.log");
// **************************************
// 書き込み処理です
// **************************************
if ( $_POST['send'] != "" && $_POST['text'] != "" ) {
	// **************************************
	// 本文中の改行コードを "\n" という
	// 文字列に変換しています
	// **************************************
	$log_wk = str_replace("\r\n","\\n",$_POST['text']);
	$log_wk = str_replace("\n","\\n", $log_wk );
	$log_wk = str_replace("\r","\\n", $log_wk );

	// **************************************
	// 特殊な文字を無効化します
	// **************************************
	$log_wk = str_replace("&","&amp;",$log_wk);
	$log_wk = str_replace("<","&lt;",$log_wk);
	$log_wk = str_replace(">","&gt;",$log_wk);
	// シングルクォート
	$log_wk = str_replace("'","&#39;",$log_wk);
	// ダブルクォート
	$log_wk = str_replace("\"","&#34;",$log_wk);

	// **************************************
	// 前回データとの境界に改行コードを
	// 設定しています
	// **************************************
	$log_text = $log_wk . "\n" . $log_text;

	file_put_contents("./text.log", $log_text );
	if ( $AGENT == "Chrome" ) {
		// GET メソッドで再表示します
		header( "Location: {$_SERVER["PHP_SELF"]}" );
		exit();
	}
}

// **************************************
// 環境によって必要ありませんが、
// エラー時の設定です
// **************************************
error_reporting(E_ALL ^ E_NOTICE);
ini_set( "display_errors", "1" );

// **************************************
// Chrome 以外では JSON 文字列で返します
// ※ text.log にデータが保存されています
// **************************************
if ( $AGENT != "Chrome" ) {
?>
{
	"item" : [ 
<?php
	$json_data = @file( "./text.log" );

	$cnt = count($json_data);
	for( $i = 0; $i < $cnt; $i++ ) {
		if ( $i != 0 ) {
			print "\t\t,{ \"text\": \"" . chop($json_data[$i]) . "\" }\n";
		}
		else {
			print "\t\t{ \"text\": \"" . chop($json_data[$i]) . "\" }\n";
		}
	}
?>

	]
}
<?
}
else {
	// **************************************
	// 記事の境界を hr 要素で表現します
	// **************************************
	$log_text = str_replace("\n", "<hr style='color:#c0c0c0;'>\n", $log_text );

	// **************************************
	// 本文の改行は br 要素で表現します
	// **************************************
	$log_text = str_replace("\\n", "<br>\n", $log_text );
?>
<!DOCTYPE html>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<meta name="viewport" content="width=1280,initial-scale=1.0">
</head>

<body>

<form method="POST">
<textarea name="text" style="width:400px;height:100px;"></textarea>
<br>
<input type="submit" name="send" value="送信">
</form>

<?= $log_text ?>
</body>
</html>
<? } ?>

関連する記事

コマンドプロンプトから Windows PHP を使って POST 投稿する

関連するオンラインツール

JSON チェック( JSONLint / The JSON Validator )



posted by lightbox at 2015-02-14 11:12 | PHP + WEBアプリ | このブログの読者になる | 更新情報をチェックする

2015年02月08日


Excel 2010 : 上付き文字・下付き文字

インターネットで調べると、いくらでもヒットする使用方法ですが、Excel のセル内に数字だけを使うと、数字が計算対象だからかどうだか解りませんが、部分的な上付き・下付きがキャンセルされてしまいました。

でも、セルを文字列として設定する事によって部分的な上付き・下付きができるようになります。



また、オブジェクト内のテキストは、画像扱いになっているのかどうだか解りませんが、上付き・下付きの位置を『相対位置の%』としてユーザが指定できるようになっています。

Word では、元々機能としてありますが、Office 製品以外で上付き・下付きを実現するには、『IMEパッド』で『上付き文字・下付き文字』を選択して文字単位で利用できます。


( ※ 上付きの 1 2 3 が無いようです )


タグ:office microsoft
posted by lightbox at 2015-02-08 17:13 | Microsoft Office | このブログの読者になる | 更新情報をチェックする

2015年02月06日


VBScript で Seesaaブログへ禁止ワード一括登録( アップロード )

2015-02-06 更新

Google Chrome で拡張子 .vbs が悪者扱いされるので、.wsf に変更して内容も更新しました。再度動作確認も行いました

2013/01/19 更新

Seesaa の最新仕様にあわせて更新しました。
パッケージにデフォルトの『禁止WORD.txt』を同梱しました
実行は、コマンドラインより実行するようにしたので、readme.txt をご覧ください

▼ readme.txt の内容
禁止WORD.txt は、ファイル名を変更せずに使って下さい。内容はいままで運用で使ったものをセットしていますが、適宜変更または追加して下さい。内容は酷い内容なので、ご注意ください。

コマンドプロンプトを開き、今開いているファイル(readme.txt)があるフォルダがカレントになるようにします。

Windows VISTA 以降なら、エクスプローラで、SHIFT キーを押しながらこのフォルダ右クリックして『コマンドウインドウをここで開く』を実行します

以下をコマンドラインから実行します

cscript ignore_words.wsf メールアドレス パスワード ブログID

ブログの ID は、自分のブログ一覧を表示して、ブログタイトルのリンクを取り出すと以下のようになります。

(例)
https://blog.seesaa.jp/cms/home/switch?blog_id=2868467&goto=/cms/article/regist/input

blog_id=2868467 とありますが、2868467 の部分を使用します。
処理としては、ブラウザの代りに処理させるので、実際のやりとりを HTML のコードをページ毎に読んで基本処理部分を構築しています。実際の送信処理で送られる内容は、F12 の開発者ツールで比較的簡単に確認できます。 VBScript では、扱うデータが SHIFT_JIS なので、ADODB.Stream を使って UTF-8 に変換した上で% エンコーディングを行っています。
<JOB>
<SCRIPT language="VBScript">
' ***********************************************************
' サーバーオブジェクトを使用しています
' ***********************************************************
Set objHTTP = Wscript.CreateObject("Msxml2.ServerXMLHTTP")
lResolve = 60 * 1000
lConnect = 60 * 1000
lSend = 60 * 1000
lReceive = 60 * 1000

' ***********************************************************
' キャラクタセット変換用
' ***********************************************************
Set Stream = Wscript.CreateObject("ADODB.Stream")
Set Stream2 = Wscript.CreateObject("ADODB.Stream")
' ***********************************************************
' URLエンコード用
' ***********************************************************
Set StreamBin = Wscript.CreateObject("ADODB.Stream")
' ***********************************************************
' POST データ読み込み用
' ***********************************************************
Set Fs = CreateObject( "Scripting.FileSystemObject" )
' ***********************************************************
' 正規表現用
' ***********************************************************
Set regEx = New RegExp

Wscript.Echo "開始します。しばらくお待ち下さい"

' ログインページの取得
Call objHTTP.Open("GET","https://ssl.seesaa.jp/auth",False)
Call objHTTP.setTimeouts(lResolve, lConnect, lSend, lReceive)
Call objHTTP.Send()

' ページ全体
strPage = objHTTP.responseText

' 投稿用のキーを取得
regEx.IgnoreCase = True
regEx.Global = True
regEx.Pattern = "authpost""><input value=""([^""]+)"""
Set Matches = regEx.Execute( strPage )
For Each Match in Matches
	strPostKey = Match.SubMatches(0)
	Exit For
Next
'Wscript.Echo strPostKey

' ***********************************************************
' コマンドラインからの固有の情報の取得
' ***********************************************************
' Seesaa のログインユーザ( メールアドレス )
emailData = Wscript.Arguments(0)
' Seesaa のログインパスワード
passData = Wscript.Arguments(1)
' 登録したいブログの ID を指定します
blogData = Wscript.Arguments(2)

' ***********************************************************
' (1) : POST
' ***********************************************************
' ログイン URL
Call objHTTP.Open("POST","https://ssl.seesaa.jp/auth",False)
' POST 用ヘッダ
Call objHTTP.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
strData = ""
strData = strData & "aXt=" & strPostKey
strData = strData & "&email=" & emailData
strData = strData & "&password=" & passData
strData = strData & "&return_to=http%3A%2F%2Fblog.seesaa.jp%2F"
Call objHTTP.SetRequestHeader("Content-Length",Len(strData))
Call objHTTP.Send(strData)
'strHeaders = objHTTP.getAllResponseHeaders()
'Wscript.Echo strHeaders

' ***********************************************************
' (2) : GET
' ***********************************************************
' 対象ブログ URL
Call objHTTP.Open("GET","https://blog.seesaa.jp/cms/home/switch?blog_id="&blogData&"&goto=/cms/article/regist/input" , False)
Call objHTTP.setTimeouts(lResolve, lConnect, lSend, lReceive)
Call objHTTP.Send()

' 以下デバッグ用
'Set OutObj = Fs.OpenTextFile( "log.txt", 2, True )
'OutObj.Write objHTTP.responseText
'OutObj.Close

' ***********************************************************
' (3) : GET
' ***********************************************************
' 投稿ページ
Call objHTTP.Open("GET","https://blog.seesaa.jp/cms/ignore_words/regist/input" , False)
Call objHTTP.setTimeouts(lResolve, lConnect, lSend, lReceive)
Call objHTTP.Send()

' 投稿用のキーを取得
strPage = objHTTP.responseText
regEx.Pattern = "method=""POST""><input value=""([^""]+)"""
Set Matches = regEx.Execute( strPage )
For Each Match in Matches
	strPostKey = Match.SubMatches(0)
	Exit For
Next

Wscript.Sleep(2000) ' 2秒間の間を置く

' ***********************************************************
' (3) : POST
' ***********************************************************
Set InObj = Fs.OpenTextFile( "禁止WORD.txt", 1 )

nCnt = 0
strData = "aXt=" & strPostKey
Do While not InObj.AtEndOfStream
	Buffer = InObj.ReadLine
	nCnt = nCnt + 1

	if strData <> "" then
		strData = strData & "&"
	end if

	strData = strData & "ignore_words=" & URLEncode( Buffer )

	if nCnt = 5 then
		' 5ワード毎に POST
		Call objHTTP.Open("POST","https://blog.seesaa.jp/cms/ignore_words/regist/input",False)
		Call objHTTP.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
		Call objHTTP.SetRequestHeader("Content-Length",Len(strData))
		Call objHTTP.Send(strData)
		nCnt = 0
		strData = "aXt=" & strPostKey
		Wscript.Sleep(2000) ' 2秒間の間を置く
	end if
Loop

if nCnt <> 0 then
	Call objHTTP.Open("POST","https://blog.seesaa.jp/cms/ignore_words/regist/input",False)
	Call objHTTP.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
	Call objHTTP.SetRequestHeader("Content-Length",Len(strData))
	Call objHTTP.Send(strData)
end if

InObj.Close

Wscript.Echo "終了しました"

' ***********************************************************
' SHIFT_JIS を UTF-8 に変換して URLエンコード
' ※ 全ての文字をパーセントエンコーディングします
' ***********************************************************
Function URLEncode(str)

	Stream.Open
	Stream.Charset = "shift_jis"
	' shift_jis で入力文字を書き込む
	Stream.WriteText str
	' コピーの為にデータポインタを先頭にセット
	Stream.Position = 0
 
	Stream2.Open
	Stream2.Charset = "utf-8"
	' shift_jis を utf-8 に変換
	Stream.CopyTo Stream2
	Stream.Close

	' コピーの為にデータポインタを先頭にセット
	Stream2.Position = 0

	' バイナリで開く
	StreamBin.Open
 	StreamBin.Type = 1

	' テキストをバイナリに変換
	Stream2.CopyTo StreamBin
	Stream2.Close

	' 読み込みの為にデータポインタを先頭にセット
	StreamBin.Position = 0

	Buffer = ""
	' BOMを取り去る
	StreamBin.Read(3)
	Do while not StreamBin.EOS
		LineBuffer = StreamBin.Read(16)
 
		For i = 1 to LenB( LineBuffer )
			CWork = MidB(LineBuffer,i,1)
			Cwork = AscB(Cwork)
			Cwork = Hex(Cwork)
			Cwork = Ucase(Cwork)
			if Len(Cwork) = 1 then
				Buffer = Buffer & "%0" & Cwork
			else
				Buffer = Buffer & "%" & Cwork
			end if
		Next
 
	Loop

	StreamBin.Close

	URLEncode = Buffer

End Function
</SCRIPT>
</JOB>




▼ 初回投稿時の実際の経緯
承認制にしているにも関わらず、週末にいきなりたくさんやってきます。ここ最近急に増えて来ていちいち削除するのが面倒になってきたので、VBScript で一括で禁止ワードをアップロードできるようにしました。

ワードは少しづつ追加していったものですが、26個ほどでピタリと止まっているので。

そのワードも公開したいところですが、とても出せるようなものでは無いので、ロ口工エの組み合わせで4つできる事だけは報告しておきます。( 同梱しています )


関連する記事

Seesaa ブログのエクスポートを呼び出して全てをバックアップするスクリプト



タグ:トラブル
posted by lightbox at 2015-02-06 22:49 | VBS + インターネット | このブログの読者になる | 更新情報をチェックする
Seesaa の各ページの表示について
Seesaa の 記事がたまに全く表示されない場合があります。その場合は、設定> 詳細設定> ブログ設定 で 最新の情報に更新の『実行ボタン』で記事やアーカイブが最新にビルドされます。

Seesaa のページで、アーカイブとタグページは要注意です。タグページはコンテンツが全く無い状態になりますし、アーカイブページも歯抜けページはコンテンツが存在しないのにページが表示されてしまいます。

また、カテゴリページもそういう意味では完全ではありません。『カテゴリID-番号』というフォーマットで表示されるページですが、実際存在するより大きな番号でも表示されてしまいます。

※ インデックスページのみ、実際の記事数を超えたページを指定しても最後のページが表示されるようです

対処としては、このようなヘルプ的な情報を固定でページの最後に表示するようにするといいでしょう。具体的には、メインの記事コンテンツの下に『自由形式』を追加し、アーカイブとカテゴリページでのみ表示するように設定し、コンテンツを用意するといいと思います。


※ エキスパートモードで表示しています

アーカイブとカテゴリページはこのように簡単に設定できますが、タグページは HTML 設定を直接変更して、以下の『タグページでのみ表示される内容』の記述方法で設定する必要があります

<% if:page_name eq 'archive' -%>
アーカイブページでのみ表示される内容
<% /if %>

<% if:page_name eq 'category' -%>
カテゴリページでのみ表示される内容
<% /if %>

<% if:page_name eq 'tag' -%>
タグページでのみ表示される内容
<% /if %>
この記述は、以下の場所で使用します
container 終わり



フリーフォントで簡単ロゴ作成
フリーフォントでボタン素材作成
フリーフォントで吹き出し画像作成
フリーフォントではんこ画像作成
ほぼ自由に利用できるフリーフォント
フリーフォントの書体見本とサンプル
画像を大きく見る為のウインドウを開くボタンの作成

CSS ドロップシャドウの参考デモ
イラストAC
ぱくたそ
写真素材 足成
フリーフォント一覧
utf8 文字ツール
右サイド 終わり
base 終わり