VBScript : GINPRO / SQLの窓と銀プログラマ

TOP / VBScript

- 1 2 3 4 5 >>

2021年01月23日

【VBS】WshShell.Runによる外部プログラムの実行のバリエーションと注意事項

外部プログラムの実行
VBScript を何の為に使うかという場合、最も一般的に利用価値の高いのは、やはりプログラムの実行です。

わりと簡単に使えるのですが、プログラム(言語)でもあるので、専門知識が無ければ、なかなか難しい部分もあります。しかし、実行だけで言えば、2行で書けるので、その場合に「できること」を知っておくと絶対に得をします。

同期処理(コマンドプロンプトウインドウを開かない)

Set WshShell = WScript.CreateObject("WScript.Shell")
Call WshShell.Run( "zip.exe -r homepage D:\nifty\homepage", 0, True )


同期処理(コマンドプロンプトウインドウを開く)

Set WshShell = WScript.CreateObject("WScript.Shell")
Call WshShell.Run( "zip.exe -r homepage D:\nifty\homepage", , True )


非同期処理
Call WshShell.Run( "zip.exe -r homepage D:\nifty\homepage",0 ) でコマンドプロンプトウインドウは開きません

Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run( "zip.exe -r homepage D:\nifty\homepage" )


関連するページ
WshShell.Run による外部プログラムの実行 :外部プログラムの実行

posted by at 2021-01-23 20:43 | VBScript |

VBScript で GUID 生成

GUID の取得
このコードは、VBScript のノウハウの詰まった『Hey, Scripting Guy!』に掲載されていたものです。

Scripting Guy さん、よろしくお願いします。スクリプトを使用して GUID を作成することはできますか。

Set TypeLib = CreateObject("Scriptlet.TypeLib")
WScript.Echo TypeLib.Guid


GUID をクリップボードに
この記事(Hey, Scripting Guy!)では後半に、InternetExplorer.Application を使って GUID をクリップボードらコピーする方法が続きます。しかし、今の時代ではコマンドプロンプトで、clip.exe が使用できるので、そちらを使うのもいいかもしれません。( 以下のコードでは最後に改行が入るのがタマにキズ )

sCommand = "cmd /c echo Set TypeLib=CreateObject(""Scriptlet.TypeLib""):Wscript.echo TypeLib.Guid>%temp%\_.vbs&cscript.exe /NOLOGO %temp%\_.vbs | clip"

Set WshShell = WScript.CreateObject("WScript.Shell")
' 同期処理(コマンドプロンプトウインドウを開かない)
Call WshShell.Run( sCommand, 0, True )

WshShell.Run
0 : ウィンドウを非表示にし、別のウィンドウをアクティブにします
TRUE : プログラムの実行が終了するまでスクリプトの実行は中断

【VBS】WshShell.Runによる外部プログラムの実行のバリエーションと注意事項

posted by at 2021-01-23 20:42 | VBScript |

2020年08月02日

Windows 標準の CDO.Message で(GmailまたはYahoo!メールを使って)簡単にバッチ処理からメールを送る



▼ バッチファイル


▼ スクリプト


SSL/465 で暗号化通信をします。
Gmail は、smtp.gmail.com
Yahoo メールは smtp.mail.yahoo.co.jp  ( アカウントは @ の前の部分 )

※ Gmail の場合、安全性の低いアプリの許可を『有効』にする必要があります


ファイルを添付する場合は、
Call Cdo.AddAttachment( "ファイルのフルパス" )
と追加します

※ ファイルのパスは、URL でも可能です。

HTML メールも送りたい場合は、
Cdo.HTMLBody = "HTMLの記述"
です

CC と BCC は、カンマで区切られた複数のアドレスを設定します
Cdo.CC  = """User 1"" , ""User 2"" "


関連する記事

C# : TKMP.DLLを使った、メール送信テンプレート



Windows10 で確認しました。この記事の後半にあるダウンロードとソースコードは昔のものですが、動作するのでそのままおいて置きますが、今回新たにテストしたのはメールを送る機能に特化したスクリプトです。

ただ、Windows として過去の経緯からして必ず動くと保証できないので、XAMPP + Fake sendmail という環境で PHP の mb_send_mail を使用する方法も視野にいれておくといいと思います。

バッチファイル

@echo off

cscript //Nologo mail.vbs "ここは 題名" "ここは 本文\nです。\n簡単なメッセージを送ります"

VBScript : mail.vbs

' ****************************************************
' 【 対象 : Windows XP 以降 】
'
' HTML メールは Cdo.Htmlbody を使用します
' "<PRE>" & strBody & "</PRE>" をセットすると
' 良いでしょう )
'
' 添付ファイルは 
' Cdo.AddAttachment( "添付ﾌｧｲﾙへのﾊﾟｽ" ) を実行します
' ****************************************************

strFrom = "username@gmail.com"
strTo = "宛先"

' サーバ
strServer = "smtp.gmail.com"
nPort = 465
strUser = "username@gmail.com"
strPass = "パスワード"

Set Cdo = WScript.CreateObject("CDO.Message")

' 差出人
Cdo.From = "わたしです<" & strFrom & ">"
' 宛先
Cdo.To = strTo
' 件名
Cdo.Subject = WScript.Arguments(0)
' 本文
Cdo.Textbody = Replace( WScript.Arguments(1), "\n", vbCrLf )

' ポート利用( 2 )
Cdo.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
Cdo.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strServer
' メールサーバの仕様に合わせる
Cdo.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = nPort
' SSL 使用
Cdo.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = true
' ユーザ/パスワードでログイン
Cdo.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
Cdo.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUser
Cdo.Configuration.Fields.Item  ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strPass

Cdo.Configuration.Fields.Update

on error resume next
Cdo.Send
if Err.Number <> 0 then
	strMessage = Err.Description
else
	strMessage = "送信が完了しました"
end if
on error goto 0

Wscript.Echo strMessage

ここから古い記事の部分

Windows XP 以降で実行可能です。
( Ping 部分 )
※ Mail 送信部分は Windows 2000 以降です。

' ****************************************************
' 【 対象 : Windows XP 以降 】
' Ping を実行して応答が返って来たら、
' 指定アドレスにメールを送ります
'
' HTML メールは Cdo.Htmlbody を使用します
'
' 添付ファイルは 
' Cdo.AddAttachment( "添付ﾌｧｲﾙへのﾊﾟｽ" ) を実行します
' ****************************************************
strTarget = "192.168.1.1"

strFrom = "xxxx@xxxxxxxxxx"
strTo = "yyyy@yyyyyyyyy"

strServer = "zzzzzzzzzzzzzz"
nPort = 587
strUser = "aaaa"
strPass = "????"

' ****************************************************
' WMI による PING 処理
' 最大4回リトライ(正常なら1回)
' ****************************************************
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
bReply = false
For I = 1 to 4
	Set colItems = objWMIService.ExecQuery _
		("Select * from Win32_PingStatus " & _
			"Where Address = '" & strTarget & "'")
	For Each objItem in colItems
		if objItem.StatusCode = 0 then 
			bReply = true
			I = 4
			Exit For
		end if
	Next
Next

if bReply then
	strSubject	= strTarget & " は稼動中です"
	strBody = "よろしくお願いします"
else
	strSubject	= strTarget & " は問題があります"
	strBody = "調査をお願いします"
end if

Set Cdo = WScript.CreateObject("CDO.Message")

Cdo.From = strFrom
Cdo.To = strTo
Cdo.Subject	= strSubject
Cdo.Textbody = strBody

Cdo.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
Cdo.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strServer
Cdo.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = nPort

Cdo.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
Cdo.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUser
Cdo.Configuration.Fields.Item _ 
 ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strPass

Cdo.Configuration.Fields.Update

on error resume next
Cdo.Send
if Err.Number <> 0 then
	strMessage = Err.Description
else
	strMessage = "送信が完了しました"
end if
on error goto 0

Wscript.Echo strMessage

関連する Microsoft ドキュメント

CdoSendUsing Enum

関連する記事

IE拡張メニューで取得したテキストをメールで送る(CDO.Message版)

更新履歴
初回投稿 : 不明
2013-01-06 : 部分変更
2013-07-26 : Gmail をベースにして、SSL/465 で暗号化処理
2013-07-31 : Yahoo でテストして、添付ファイル、HTMLメール、CC、BCC の使い方を追加

タグ：メール VBScript バッチ処理

posted by at 2020-08-02 09:58 | VBScript |

2020年08月01日

バックアップスクリプトを作るスクリプト





出来上がったスクリプトの名前は、以下のような仕様です。

BK_ドライブ_パス.vbs

パスの部分は、スペースを除いて \ を _ に変更しています。この名前でディレクトリがスクリプトのあるディレクトリに作成されてファイルが XCOPY でコピーされます。

スクリプトの名前を変更すると、コピー先(スクリプトがあるディレクトリ)のディレクトリ名も変更されます。

XCOPY は、新しいファイルのみをディレクトリ以下全てコピーします。

' ***********************************************************
' 処理開始
' ***********************************************************
Set Fso = Wscript.CreateObject( "Scripting.FileSystemObject" )
Set Shell = Wscript.CreateObject( "Shell.Application" )

' ***********************************************************
' 実行中ディレクトリの取得
' ***********************************************************
strPath = Wscript.ScriptFullName 
Set objFile = Fso.GetFile( strPath )
strBackupFolder = Fso.GetParentFolderName( objFile )

' ***********************************************************
' バックアップ対象ディレクトリの取得
' ***********************************************************
' マイ コンピュータを基準にディレクトリ選択
Set objFolder = Shell.BrowseForFolder( 0, "バックアップするフォルダを選択してください", &H4B, _
	"::{20D04FE0-3AEA-1069-A2D8-08002B30309D}" )
if objFolder is nothing then
	WScript.Quit
end if
if not objFolder.Self.IsFileSystem then
	WScript.Echo "ファイルシステムではありません"
	WScript.Quit
end if

strTargetFolder = objFolder.Self.Path
strName = Replace( strTargetFolder, ":", "" )
strName = Replace( strName, "\", "_" )
strName = Replace( strName, " ", "" )
strName = "BK_" & strName

' ***********************************************************
' スクリプト作成
' ***********************************************************
Set OutFile = Fso.OpenTextFile( strBackupFolder & "\" & strName & ".vbs", 2, True )

OutFile.WriteLine "strName = """ & strName & """"
OutFile.WriteLine "strTarget = """ & strTargetFolder & """"
OutFile.WriteLine "strBackupFolder = """ & strBackupFolder & """"
OutFile.Write "if MsgBox( strTarget & vbCrLf & ""のバックアップを開始します。よろしいですか? (保存先:"" & strBackupFolder & ""\"" & strName & "")"""
OutFile.WriteLine ", 1 ) = 2 then"
OutFile.WriteLine "	Wscript.Quit"
OutFile.WriteLine "end if"

OutFile.WriteLine "Set WshShell = Wscript.CreateObject( ""WScript.Shell"" )"
OutFile.Write "ExecCommand = ""cmd.exe /C """"xcopy.exe """""" & strTarget & """""" """""" & strBackupFolder & ""\"" & strName & ""\"""""
OutFile.WriteLine " /D /E /C /S /Y & PAUSE"""""""
OutFile.WriteLine "Call WshShell.Run( ExecCommand )"

OutFile.Close

WScript.Echo "バックアップスクリプト : " &  strName & ".vbs" & " を作成しました"

関連する記事

ディレクトリごと新しいファイルのみをコピーする
XCOPYで新しいファイルのみバックアップする為のスクリプトを作成するスクリプト
ディレクトリ選択

posted by at 2020-08-01 20:34 | VBScript |

2019年11月18日

バッチ処理の為の .wsf スケルトン / cscript.exe での実行を強制する / 自分自身の呼び出し

Wscript.Echo は、Wscript.exe から実行すると、一回の処理毎にメッセージボックスを表示するので、連続処理する場合は避けなければなりません(wscript.exe をタスクマネージャから強制終了する事になります)

Wscript.exe は、通常エクスプローラからダブルクリックでスクリプトを実行した際に使用されるので、誤って実行してしまう事を避ける方法です。以下のサンプルでは、スクリプトにデータを含めて、そのデータをループ処理で表示する処理ですが、コマンドプロンプトからの実行を強制しています( コマンドプロンプトから、cscript.exe を使用しないと Quit されます )

右端のアイコンよりダウンロードできます

<JOB>
<SCRIPT language="VBScript">

' コマンドプロンプトより起動される為の処理
str = WScript.FullName
str = Right( str, 11 )
str = Ucase( str )
if str <> "CSCRIPT.EXE" then
	strMessage = "コマンドプロンプトより cscript " & WScript.ScriptFullName
	strMessage = strMessage & " と指定して実行して下さい　　　" & vbCrLf & vbCrLf
	strMessage = strMessage & "( この文字列をクリップボードにコピーしたい場合は"
	strMessage = strMessage & "ctrl+c です )"
	WScript.Echo strMessage
	WScript.Quit
end if

aData = Split( getResource("myText"), vbCrLf )
For I = 0 to Ubound( aData )
	if Trim( aData(I) ) <> "" then
		Wscript.Echo aData(I)
	end if
Next

</SCRIPT>

<RESOURCE id="myText">
コード名称マスタ
商品マスタ
得意先マスタ
社員マスタ
取引データ
</RESOURCE>
</JOB>


以下は、Wscript.exe で起動された場合は、cscript.exe で自分自身を呼び出して再度実行しています( 最後にコマンドプロンプトの pause で停止 )

右端のアイコンよりダウンロードできます

<JOB>
<SCRIPT language="VBScript">

' コマンドプロンプトより起動される為の処理
str = WScript.FullName
str = Right( str, 11 )
str = Ucase( str )
if str <> "CSCRIPT.EXE" then
	str = WScript.ScriptFullName
	Set WshShell = Wscript.CreateObject("WScript.Shell")
	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( "cmd.exe /c cscript.exe """ & str & """" & strParam & " & pause", 3 )
	WScript.Quit
end if

aData = Split( getResource("myText"), vbCrLf )
For I = 0 to Ubound( aData )
	if Trim( aData(I) ) <> "" then
		Wscript.Echo aData(I)
	end if
Next

</SCRIPT>

<RESOURCE id="myText">
コード名称マスタ
商品マスタ
得意先マスタ
社員マスタ
取引データ
</RESOURCE>
</JOB>


そして、最後は面倒な記述部分を WEB 上に置いて呼び出して実行しています
(Crun と言う関数)

右端のアイコンよりダウンロードできます

<JOB>
<COMMENT>
************************************************************
 WSH 実行スケルトン
************************************************************
</COMMENT>

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

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

Crun()

aData = Split( getResource("myText"), vbCrLf )
For I = 0 to Ubound( aData )
	if Trim( aData(I) ) <> "" then
		Wscript.Echo aData(I)
	end if
Next

</SCRIPT>

<RESOURCE id="myText">
コード名称マスタ
商品マスタ
得意先マスタ
社員マスタ
取引データ
</RESOURCE>
</JOB>

タグ：VBScript wsf VBS WScript cscript

posted by at 2019-11-18 13:52 | VBScript |

2019年02月11日

【VBS + Excel】シンプルな詳細設計書のフォーマット。1) Excel のダウンロード、2) VBScript で作成するサンプル

▼ B4 基本設計書セット


これは、Excle(2010) ブックをダウンロードします。
( ※ プログラム一覧、概要書、テーブル一覧、テーブル設計、画面設計、入力設計、出力設計 )

PDF サンプル 


▼ スクリプトによる詳細設計書作成

Microsoft Excel がインストールされている必要があります

Excel 2007 以降の場合、.xls で保存する形式として 97-2003 として保存するようにしています。VBScript のライブラリはWEB上にあり、それらを参照して実行しています

実行すると、ドキュメントフォルダに作成されます




作成されるのは、非常にシンプルな4種類の設計書フォーマットです。

1) 概要書
　処理を中心とした入出力をオートシェイプの
　フローチャートで示し、概要を記述して正確
　な入出力エントリ列挙します

2) 画面設計書
　最近では画面の画像をはりつける事がほとん
　どです

3) 入力設計書
　入力チェックを中心とした GUI の操作手順を
　ベースとしてアプリケーションの定義をして
　いきます。入力フィールドの属性も通常示さ
　れます

4) 出力設計書
　更新処理はここで記述されます。最近では、
　DBテーブルの更新仕様と考えて良いでしょう。
　但し例外として、印刷処理のフォーマット指示
　である事もあります

作成するのは、詳細設計書書式なのですが、もし、VBScript を書く事ができるのであれば、Excel にアクセスしている部分は WEB 上のライブラリですが、常に Hosting しているので利用していただいて結構です。

ライブラリそのものは、テキストとして Hosting しているので、都合上 UTF-8 で書かれています。以下からダウンロード可能です。

baseFunction.vbs
excelFunction.vbs

※ 以下は仕様を書き込んだ作成イメージです

<JOB>
<COMMENT>
************************************************************
 WSH 実行スケルトン
************************************************************
</COMMENT>

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

<SCRIPT language=VBScript>
' ***********************************************************
' 処理開始
' ***********************************************************
Call laylaFunctionTarget( "http://lightbox.in.coocan.jp/" )
Call laylaLoadFunction( "baseFunction.vbs" )
Call laylaLoadFunction( "excelFunction.vbs" )

Crun

str = InputBox( MyDocDir & " に作成されるExcelブック名を指定します",, _
	"簡易詳細設計書フォーマット" )
if str = "" then
	Wscript.Quit
end if

strTarget = MyDocDir & "\" & str & ".xls"

Set MyBook = CreateBook( strTarget )
' Call ExcelVisible( True )

' ******************************************************
' 画面設計書フォーマット作成
' ******************************************************
strSheetName = "画面設計書"
Wscript.Echo strSheetName & " を作成しています"

Call AddSheetTop(MyBook, strSheetName)
Call ExcelSelectSheet(MyBook, strSheetName)
on error resume next
Call DeleteSheet( MyBook, "Sheet1" )
Call DeleteSheet( MyBook, "Sheet2" )
Call DeleteSheet( MyBook, "Sheet3" )
on error goto 0

Call Format_Page(MyBook)

Call ExcelSize_Disp(MyBook, strSheetName)
Call ExcelLine_Disp(MyBook, strSheetName)
Call ExcelSetText_Disp(MyBook, strSheetName)

' ******************************************************
' 概要書
' ******************************************************
strSheetName = "概要書"
Wscript.Echo strSheetName & " を作成しています"

Call AddSheetTop(MyBook, strSheetName)
Call ExcelSelectSheet(MyBook, strSheetName)
Call Format_Page(MyBook)
Call ExcelSize_Plan(MyBook, strSheetName)
Call ExcelLine_Plan(MyBook, strSheetName)
Call ExcelSetText_Plan(MyBook, strSheetName)

' ******************************************************
' 入力設計書
' ******************************************************
strSheetName = "入力設計書"
Wscript.Echo strSheetName & " を作成しています"

Call AddSheetLast(MyBook, strSheetName)
Call ExcelSelectSheet(MyBook, strSheetName)
Call Format_Page(MyBook)
Call ExcelSize_Plan(MyBook, strSheetName)
Call ExcelLine_Plan(MyBook, strSheetName)
Call ExcelSetText_Plan(MyBook, strSheetName)

' ******************************************************
' 出力設計書
' ******************************************************
strSheetName = "出力設計書"
Wscript.Echo strSheetName & " を作成しています"

Call AddSheetLast(MyBook, strSheetName)
Call ExcelSelectSheet(MyBook, strSheetName)
Call Format_Page(MyBook)
Call ExcelSize_Plan(MyBook, strSheetName)
Call ExcelLine_Plan(MyBook, strSheetName)
Call ExcelSetText_Plan(MyBook, strSheetName)


' ******************************************************
' 終了処理
' ******************************************************
Call ExcelSave( MyBook )
Call ExcelQuit( MyBook )
Call ExcelLoad( Dd(strTarget) )

' ******************************************************
' セルサイズの設定
' ******************************************************
Function ExcelSize_Disp(MyBook, Target)

	'セルの高さ合わせ
	Call ExcelSetRowHeight(MyBook, Target, 1, 13.50)
	Call ExcelSetRowHeight(MyBook, Target, 2, 24.50)
	Call ExcelSetRowHeight(MyBook, Target, 3, 13.50)
	Call ExcelSetRowHeight(MyBook, Target, 4, 24.50)

	For i = 5 To 25
		Call ExcelSetRowHeight(MyBook, Target, i, 24.75)
	Next

	For i = 26 To 38
		Call ExcelSetRowHeight(MyBook, Target, i, 19.00)
	Next

	'セルの幅合わせ
	Call ExcelSetColumnWidth(MyBook, Target, 1, 3.50)
	Call ExcelSetColumnWidth(MyBook, Target, 2, 22.38)
	Call ExcelSetColumnWidth(MyBook, Target, 3, 7.50)
	Call ExcelSetColumnWidth(MyBook, Target, 4, 6.00)
	Call ExcelSetColumnWidth(MyBook, Target, 5, 6.00)
	Call ExcelSetColumnWidth(MyBook, Target, 6, 11.50)
	Call ExcelSetColumnWidth(MyBook, Target, 7, 25.00)
	Call ExcelSetColumnWidth(MyBook, Target, 8, 12.00)

End Function

' ******************************************************
' 罫線の設定
' ******************************************************
Function ExcelLine_Disp(MyBook, Target)

	' BOX罫線
	Call ExcelRange(MyBook, Target, 1, 1, 8, 38 )
	Call ExcelBox(xlContinuous, xlMedium)

	' 上罫線
	Call ExcelRange(MyBook, Target, 1, 2, 8, 2 )
	Call ExcelLine(xlDot, xlThin)

	Call ExcelRange(MyBook, Target, 1, 3, 8, 3 )
	Call ExcelLine(xlContinuous, xlThin)

	Call ExcelRange(MyBook, Target, 1, 4, 8, 4 )
	Call ExcelLine(xlDot, xlThin)

	Call ExcelRange(MyBook, Target, 1, 5, 8, 5 )
	Call ExcelLine(xlContinuous, xlMedium)

	Call ExcelRange(MyBook, Target, 1, 26, 8, 26 )
	Call ExcelLine(xlContinuous, xlMedium)

	for i = 27 to 38
		Call ExcelRange(MyBook, Target, 1, i, 8, i )
		Call ExcelLine(xlDot, xlThin)
	Next

	' 右罫線
	Call ExcelRange(MyBook, Target, 2, 1, 2, 4 )
	Call ExcelLineRight(xlContinuous, xlThin)

	Call ExcelRange(MyBook, Target, 6, 1, 6, 4 )
	Call ExcelLineRight(xlContinuous, xlThin)

	Call ExcelRange(MyBook, Target, 7, 1, 7, 4 )
	Call ExcelLineRight(xlContinuous, xlThin)

End Function

' ******************************************************
' セルのテキストの設定
' ******************************************************
Function ExcelSetText_Disp(MyBook, Target)

	Call ExcelRange(MyBook, Target, 1, 1, 7, 49 )
	Call ExcelVAlign()

	' １行目
	Call ExcelSetCell(MyBook, Target, 1, 1, "　システム名")
	Call ExcelSetCell(MyBook, Target, 3, 1, "　サブシステム名")
	Call ExcelSetCell(MyBook, Target, 7, 1, "　プログラムID")
	Call ExcelSetCell(MyBook, Target, 8, 1, "ページ")
	Call ExcelRange(MyBook, Target, 8, 1, 8, 1 )
	Call ExcelHAlign()

	' ２行目
	Call ExcelSetCell(MyBook, Target, 8, 2, "／")
	Call ExcelRange(MyBook, Target, 8, 2, 8, 2 )
	Call ExcelHAlign()

	' ３行目
	Call ExcelSetCell(MyBook, Target, 1, 3, "　画面ID")
	Call ExcelSetCell(MyBook, Target, 3, 3, "　画面名")

	Call ExcelSetCell(MyBook, Target, 7, 3, "作成日")
	Call ExcelRange(MyBook, Target, 7, 3, 7, 3 )
	Call ExcelHAlign()

	Call ExcelSetCell(MyBook, Target, 8, 3, "作成者")
	Call ExcelRange(MyBook, Target, 8, 3, 8, 3 )
	Call ExcelHAlign()

	' ４行目
	Call ExcelRange(MyBook, Target, 7, 4, 7, 4 )
	Call ExcelHAlign()

	Call ExcelRange(MyBook, Target, 8, 4, 8, 4 )
	Call ExcelHAlign()

End Function

' ******************************************************
' セルサイズの設定
' ******************************************************
Function ExcelSize_Plan(MyBook, Target)

	if Target = "概要書" then

		'セルの高さ合わせ
		Call ExcelSetRowHeight(MyBook, Target, 1, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 2, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 3, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 4, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 5, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 34, 20.25)

		For i = 6 To 49
			if 6 <= i AND i <= 33then
				Call ExcelSetRowHeight(MyBook, Target, i, 13.50)
			elseif 35 <=  i AND i  <= 44 then
				Call ExcelSetRowHeight(MyBook, Target, i, 24.50)
			elseif 45 <=  i AND i  <= 49 then
				Call ExcelSetRowHeight(MyBook, Target, i, 18.50)
			end if
		Next

		'セルの幅合わせ
		Call ExcelSetColumnWidth(MyBook, Target, 1, 3.50)
		Call ExcelSetColumnWidth(MyBook, Target, 2, 22.38)
		Call ExcelSetColumnWidth(MyBook, Target, 3, 12.38)
		Call ExcelSetColumnWidth(MyBook, Target, 4, 8.25)
		Call ExcelSetColumnWidth(MyBook, Target, 5, 11.50)
		Call ExcelSetColumnWidth(MyBook, Target, 6, 25.00)
		Call ExcelSetColumnWidth(MyBook, Target, 7, 12.00)

	elseif Target = "入力設計書" then

		'セルの高さ合わせ
		Call ExcelSetRowHeight(MyBook, Target, 1, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 2, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 3, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 4, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 5, 20.25)

		For i = 6 To 38
			if 6 <= i AND i <= 25then
				Call ExcelSetRowHeight(MyBook, Target, i, 24.75)
			elseif 26 <=  i AND i  <= 38 then
				Call ExcelSetRowHeight(MyBook, Target, i, 19.00)
			end if
		Next

		'セルの幅合わせ
		Call ExcelSetColumnWidth(MyBook, Target, 1, 3.50)
		Call ExcelSetColumnWidth(MyBook, Target, 2, 22.38)
		Call ExcelSetColumnWidth(MyBook, Target, 3, 7.50)
		Call ExcelSetColumnWidth(MyBook, Target, 4, 6.00)
		Call ExcelSetColumnWidth(MyBook, Target, 5, 6.00)
		Call ExcelSetColumnWidth(MyBook, Target, 6, 11.50)
		Call ExcelSetColumnWidth(MyBook, Target, 7, 25.00)
		Call ExcelSetColumnWidth(MyBook, Target, 8, 12.00)

	elseif Target = "出力設計書" then

		'セルの高さ合わせ
		Call ExcelSetRowHeight(MyBook, Target, 1, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 2, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 3, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 4, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 5, 20.25)

		For i = 6 To 38
			if 6 <= i AND i <= 25then
				Call ExcelSetRowHeight(MyBook, Target, i, 24.75)
			elseif 26 <=  i AND i  <= 38 then
				Call ExcelSetRowHeight(MyBook, Target, i, 19.00)
			end if
		Next

		'セルの幅合わせ
		Call ExcelSetColumnWidth(MyBook, Target, 1, 3.50)
		Call ExcelSetColumnWidth(MyBook, Target, 2, 22.38)
		Call ExcelSetColumnWidth(MyBook, Target, 3, 7.50)
		Call ExcelSetColumnWidth(MyBook, Target, 4, 6.00)
		Call ExcelSetColumnWidth(MyBook, Target, 5, 6.00)
		Call ExcelSetColumnWidth(MyBook, Target, 6, 11.50)
		Call ExcelSetColumnWidth(MyBook, Target, 7, 25.00)
		Call ExcelSetColumnWidth(MyBook, Target, 8, 12.00)

	end if

End Function

' ******************************************************
' 罫線の設定
' ******************************************************
Function ExcelLine_Plan(MyBook, Target)

	if Target = "概要書" then
		' BOX罫線
		Call ExcelRange(MyBook, Target, 1, 1, 7, 49 )
		Call ExcelBox(xlContinuous, xlMedium)

		' 上罫線
		Call ExcelRange(MyBook, Target, 1, 2, 7, 2 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 3, 7, 3 )
		Call ExcelLine(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 1, 4, 7, 4 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 5, 7, 5 )
		Call ExcelLine(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 5, 6, 7, 6 )
		Call ExcelLine(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 1, 34, 7, 34 )
		Call ExcelLine(xlContinuous, xlMedium)

		Call ExcelRange(MyBook, Target, 1, 35, 7, 35 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 36 to 44
			' 線種→点線, 太さ→標準
			Call ExcelRange(MyBook, Target, 1, i, 7, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		Call ExcelRange(MyBook, Target, 1, 45, 7, 45 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 46 to 49
			' 線種→点線, 太さ→標準
			Call ExcelRange(MyBook, Target, 1, i, 7, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		' 右罫線
		Call ExcelRange(MyBook, Target, 1, 35, 1, 44 )
		Call ExcelLineRight(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 4, 3, 4, 33 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 5, 1, 5, 4 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 6, 1, 6, 4 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 2, 34, 2, 44 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 3, 34, 3, 44 )
		Call ExcelLineRight(xlContinuous, xlThin)

	elseif Target = "入力設計書" then

		' BOX罫線
		Call ExcelRange(MyBook, Target, 1, 1, 8, 38 )
		Call ExcelBox(xlContinuous, xlMedium)

		' 上罫線
		Call ExcelRange(MyBook, Target, 1, 2, 8, 2 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 3, 8, 3 )
		Call ExcelLine(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 1, 4, 8, 4 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 5, 8, 5 )
		Call ExcelLine(xlContinuous, xlMedium)

		Call ExcelRange(MyBook, Target, 1, 6, 8, 6 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 7 to 25
			Call ExcelRange(MyBook, Target, 1, i, 8, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		Call ExcelRange(MyBook, Target, 1, 26, 8, 26 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 27 to 38
			Call ExcelRange(MyBook, Target, 1, i, 8, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		' 右罫線
		Call ExcelRange(MyBook, Target, 1, 6, 1, 25 )
		Call ExcelLineRight(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 2, 1, 2, 2 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 2, 5, 2, 25 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 3, 5, 3, 25 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 4, 5, 4, 25 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 5, 3, 5, 25 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 6, 1, 6, 25 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 7, 1, 7, 4 )
		Call ExcelLineRight(1, 2)

	elseif Target = "出力設計書" then

		' BOX罫線
		Call ExcelRange(MyBook, Target, 1, 1, 8, 38 )
		Call ExcelBox(xlContinuous, xlMedium)

		' 上罫線
		Call ExcelRange(MyBook, Target, 1, 2, 8, 2 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 3, 8, 3 )
		Call ExcelLine(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 1, 4, 8, 4 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 5, 8, 5 )
		Call ExcelLine(xlContinuous, xlMedium)

		Call ExcelRange(MyBook, Target, 1, 6, 8, 6 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 7 to 25
			Call ExcelRange(MyBook, Target, 1, i, 8, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		Call ExcelRange(MyBook, Target, 1, 26, 8, 26 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 27 to 38
			Call ExcelRange(MyBook, Target, 1, i, 8, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		' 右罫線
		Call ExcelRange(MyBook, Target, 1, 6, 1, 25 )
		Call ExcelLineRight(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 2, 1, 2, 2 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 2, 5, 2, 25 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 5, 3, 5, 4 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 6, 1, 6, 4 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 7, 1, 7, 25 )
		Call ExcelLineRight(xlContinuous, xlThin)
	end if

End Function

' ******************************************************
' セルのテキストの設定
' ******************************************************
Function ExcelSetText_Plan(MyBook, Target)

	if Target = "概要書" then

		Call ExcelRange(MyBook, Target, 1, 1, 7, 49 )
		Call ExcelVAlign()

		Call ExcelSetCell(MyBook, Target, 1, 1, "　システム名")
		Call ExcelSetCell(MyBook, Target, 3, 1, "　サブシステム名")
		Call ExcelSetCell(MyBook, Target, 6, 1, "　プログラムID")
		Call ExcelSetCell(MyBook, Target, 1, 3, "　プログラム名")
		Call ExcelSetCell(MyBook, Target, 1, 34, "　テーブル名")

		Call ExcelSetCell(MyBook, Target, 7, 1, "ページ")
		Call ExcelRange(MyBook, Target, 7, 1, 7, 1 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 7, 2, "／")
		Call ExcelRange(MyBook, Target, 7, 2, 7, 2 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 5, 3, "種別")
		Call ExcelRange(MyBook, Target, 5, 3, 5, 3 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 6, 3, "作成日")
		Call ExcelRange(MyBook, Target, 6, 3, 6, 3 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 7, 3, "作成者")
		Call ExcelRange(MyBook, Target, 7, 3, 7, 3 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 5, 5, "処理概要")
		Call ExcelRange(MyBook, Target, 5, 5, 7, 5 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 3, 34, "入出力")
		Call ExcelRange(MyBook, Target, 3, 34, 3, 34 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 4, 34, "備考")
		Call ExcelRange(MyBook, Target, 4, 34, 7, 34 )
		Call ExcelHAlign()

		for i = 35 to 44
			Call ExcelSetCell(MyBook, Target, 1, i, i - 34)
			Call ExcelRange(MyBook, Target, 1, i, 1, i )

			' 配置
			Call ExcelHAlign()
			' 書式設定
			Call ExcelSetFont("太字", 12)
		next

	elseif Target = "入力設計書" then

		Call ExcelRange(MyBook, Target, 1, 1, 8, 38 )
		Call ExcelVAlign()

		Call ExcelSetCell(MyBook, Target, 1, 1, "　システム名")

		Call ExcelSetCell(MyBook, Target, 3, 1, "　サブシステム名")

		Call ExcelSetCell(MyBook, Target, 7, 1, "　プログラムID")

		Call ExcelSetCell(MyBook, Target, 8, 1, "ページ")
		Call ExcelRange(MyBook, Target, 8, 1, 8, 1 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 8, 2, "／")
		Call ExcelRange(MyBook, Target, 8, 2, 8, 2 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 1, 3, "　プログラム名")

		Call ExcelSetCell(MyBook, Target, 6, 3, "種別")
		Call ExcelRange(MyBook, Target, 6, 3, 6, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 7, 3, "作成日")
		Call ExcelRange(MyBook, Target, 7, 3, 7, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 8, 3, "作成者")
		Call ExcelRange(MyBook, Target, 8, 3, 8, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 1, 5, "　項目名")

		Call ExcelSetCell(MyBook, Target, 3, 5, "型式")
		Call ExcelRange(MyBook, Target, 3, 5, 3, 5 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 4, 5, "桁数")
		Call ExcelRange(MyBook, Target, 4, 5, 4, 5 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 5, 5, "I/O")
		Call ExcelRange(MyBook, Target, 5, 5, 5, 5 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 6, 5, "種別")
		Call ExcelRange(MyBook, Target, 6, 5, 6, 5 )
		Call ExcelHAlign()

		For i = 6 to 25
			Call ExcelSetCell(MyBook, Target, 1, i, i - 5 )
			Call ExcelRange(MyBook, Target, 1, i, 1, i )
			Call ExcelHAlign()
		Next

	elseif Target = "出力設計書" then

		Call ExcelRange(MyBook, Target, 1, 1, 8, 38 )
		Call ExcelVAlign()

		Call ExcelSetCell(MyBook, Target, 1, 1, "　システム名")

		Call ExcelSetCell(MyBook, Target, 3, 1, "　サブシステム名")

		Call ExcelSetCell(MyBook, Target, 7, 1, "　プログラムID")

		Call ExcelSetCell(MyBook, Target, 8, 1, "ページ")
		Call ExcelRange(MyBook, Target, 8, 1, 8, 1 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 8, 2, "／")
		Call ExcelRange(MyBook, Target, 8, 2, 8, 2 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 1, 3, "　プログラム名")

		Call ExcelSetCell(MyBook, Target, 6, 3, "種別")
		Call ExcelRange(MyBook, Target, 6, 3, 6, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 7, 3, "作成日")
		Call ExcelRange(MyBook, Target, 7, 3, 7, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 8, 3, "作成者")
		Call ExcelRange(MyBook, Target, 8, 3, 8, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 1, 5, "　列名")

		Call ExcelSetCell(MyBook, Target, 3, 5, "　更新説明")

		Call ExcelSetCell(MyBook, Target, 8, 5, "対象")
		Call ExcelRange(MyBook, Target, 8, 5, 8, 5 )
		Call ExcelHAlign()

		For i = 6 to 25
			Call ExcelSetCell(MyBook, Target, 1, i, i - 5 )
			Call ExcelRange(MyBook, Target, 1, i, 1, i )
			Call ExcelHAlign()
		Next

	end if

End Function

' ******************************************************
' ヘッダー,余白の指定
' ******************************************************
Function Format_Page(MyBook)

	on error resume next
	With MyBook.ActiveSheet.PageSetup
		.CenterHeader = "&18&A"
		.LeftMargin = ExcelApp.InchesToPoints(0.393700787401575)
		.RightMargin = ExcelApp.InchesToPoints(0.196850393700787)
		.TopMargin = ExcelApp.InchesToPoints(0.551181102362205)
		.BottomMargin = ExcelApp.InchesToPoints(0.393700787401575)
		.HeaderMargin = ExcelApp.InchesToPoints(0.196850393700787)
		.FooterMargin = ExcelApp.InchesToPoints(0.196850393700787)
	End With
	on error goto 0

End Function
</SCRIPT>
</JOB>

タグ：設計書 VBScript

posted by at 2019-02-11 10:45 | VBScript |

2019年01月11日

VBScript : CAPICOM を使った通常文字列の Base64エンコードと SHA1 と MD5 と SHA256/384/512

Windows10 でCAPICOM.Utilities を使用するには、こちらからダウンロードしてインストールが必要です。

但し 32 ビットでインストールされるので、VBScript で実行する際に、『C:\Windows\SysWOW64\cscript.exe』で実行する必要があります。
( または C:\Windows\SysWOW64\wscript.exe )

ドキュメント

以下の方法と同様で、バイナリファイルの変換に使う事が可能です。(PHPの文字列はバイナリ扱いです)

結果は PHP の関数で同じになる事を確かめています。
( php -r "print hash('sha256','変換する文字列');" )

変換する種類は、こちらの定数を使用します(HashedData.Algorithm)( VBscript で最後に小文字に変換してますが、PHP の結果と合わす為です )

Base64 の変換では、本来良く使われて来た用途としてバイナリデータのテキスト表現で、メールの添付ファイルに使用する際に改行を含めて76文字になるようになっています。CAPIUtil.Base64Encode の仕様もそうなっているので、PHP と比較する為に、ここではわざわざ改行を取り除いています。

それと、CAPICOM.HashedData で作成したオブジェクトを使いまわすとエラーになる事があったので、毎回作成して処理しました。

Set CAPIUtil = Wscript.CreateObject( "CAPICOM.Utilities" )
Set Stream = Wscript.CreateObject("ADODB.Stream")
Set StreamBin = Wscript.CreateObject("ADODB.Stream")

'***********************************
' Base64
'***********************************
Stream.Open
Stream.Charset = "shift_jis"
' shift_jis で入力文字を書き込む
Stream.WriteText "日本語表示OK日本語表示OK日本語表示OK日本語表示OK日本語表示OK"
Stream.Position = 0

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

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

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

str = CAPIUtil.ByteArrayToBinaryString( StreamBin.Read )
str2 = CAPIUtil.Base64Encode( str )
' ' 長い文字列は仕様として、(\r\n を含めて 76文字で) 改行されます
str2 = Replace(str2,vbCrLf,"")

Wscript.Echo str2

'***********************************
' SHA1,SHA256,SHA384,SHA512 と MD5
'***********************************
' SHA1
Set HashedData = Wscript.CreateObject( "CAPICOM.HashedData" )
HashedData.Algorithm = 0
HashedData.Hash(str)

Wscript.Echo LCase(HashedData.Value)

' SHA256
Set HashedData = Wscript.CreateObject( "CAPICOM.HashedData" )
HashedData.Algorithm = 4
HashedData.Hash(str)

Wscript.Echo LCase(HashedData.Value)

' SHA384
Set HashedData = Wscript.CreateObject( "CAPICOM.HashedData" )
HashedData.Algorithm = 5
HashedData.Hash(str)

Wscript.Echo LCase(HashedData.Value)

' SHA512
Set HashedData = Wscript.CreateObject( "CAPICOM.HashedData" )
HashedData.Algorithm = 6
HashedData.Hash(str)

Wscript.Echo LCase(HashedData.Value)

' MD5
Set HashedData = Wscript.CreateObject( "CAPICOM.HashedData" )
HashedData.Algorithm = 3
HashedData.Hash(str)

Wscript.Echo LCase(HashedData.Value)

posted by at 2019-01-11 16:41 | VBScript |

2018年12月08日

【VBS汎用】SHIFT_JISデータを各種キャラクタセットのテキストファイルへ変換

Microsoft のデータはメモ帳でも解るように、SHIFT_JIS と Unicode と (UTF8) しか通常では対応していないので、このような処理が実は結構必要になります。

しかし、このような方法はたぶんあまり知られて無いので、他のアプリケーションを利用している場合が多いのでは無いでしょうか。(というか、そもそもファイルシステムオブジェクトで UTF8、UTF8N、EUC-JP を対応しろって思いますけど。)

変換は全てメモリ上で処理します。

外部ライブラリを WEB 上に置いて読み込んで処理しているので、その部分は『コマンド』だと思って下さい。
例) Crun は、コマンドプロンプトでの実行を強制します


VBScript の中に埋め込んだデータはファイルとしては Shift_JIS です。VBScript のインタープリタの内部的には Unicode ですが、何も考えなければ出力されたデータは Shift_JIS になってしまいます。

これを 5 種類のキャラクタセットとして意図的に出力します
1) SHIFT_JIS
2) UNICODE
3) EUC-JP
4) UTF8
5) UTF8N

※ UTF8 が少し特殊です(BOMを付加しています)

右端のアイコンよりダウンロードできます

<JOB>
<SCRIPT
	language="VBScript"
	src="http://lightbox.in.coocan.jp/laylaClass.vbs">
</SCRIPT>

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

' Csript.exe で実行を強制
Crun

' 元となる shift_jis の文字列
strShiftJis = GetInline("shift_jis")

' このディレクトリ
strDir = ScriptDir()

' ファイルシステムオブジェクト作成
GetFso

' 出力パス
strPath1 = strDir & "\sjis.txt"
strPath2 = strDir & "\unicode.txt"
strPath3 = strDir & "\ujis.txt"
strPath4 = strDir & "\utf8.txt"
strPath5 = strDir & "\utf8n.txt"

' ファイルシステムオブジェクトで、sjis と unicode
Call PutTextFile( strPath1, strShiftJis )
Call PutTextFileUnicode( strPath2, strShiftJis )

' キャラクタセット変換用の Stream オブジェクト
Set Stream = Wscript.CreateObject("ADODB.Stream")
Set Stream2 = Wscript.CreateObject("ADODB.Stream")

' 開く
Stream.Open
Stream2.Open
' 二つ目はバイナリ専用
Stream2.Type = 1

Stream.Charset = "euc-jp"
Stream.WriteText strShiftJis
Stream.SaveToFile strPath3, 2

' 先頭に移動
Stream.Position = 0
Stream.Charset = "utf-8"
Stream.WriteText strShiftJis
Stream.SaveToFile strPath4, 2

' バイナリにコピー
Stream.CopyTo Stream2

' 一つ目もバイナリにする為、いったん閉じる
Stream.Close
' 再度開いてバイナリにする
Stream.Open
Stream.Type = 1

' バイナリを読んでバイナリに書く
Stream2.Position = 0
Stream2.Read(3)
Do while not Stream2.EOS
	Stream.Write Stream2.Read(16)
Loop

' utn-8n
Stream.SaveToFile strPath5, 2


' 閉じる
Stream2.Close
Stream.Close


print "処理が終了しました"
print ""

Wscript.Quit

</SCRIPT>

<RESOURCE id="shift_jis">
<![CDATA[
ここは、VBScript なので shift_jis になります。
必要に応じてキャラクタセットを変更します
]]>
</RESOURCE>

</JOB>

posted by at 2018-12-08 14:20 | VBScript |

VBScript : デスクトップの列挙

オンライン上にある、VBScript のライブラリを使用しています。

<JOB>
<COMMENT>
************************************************************
 WSH 実行スケルトン
************************************************************
</COMMENT>

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

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

GetShell

Crun2 130

Wscript.Echo "【デスクトップ/一般】"
Wscript.Echo "----------------------------------------------------"
Set objFolder = Shell.NameSpace( 0 )

Set objFolderItems = objFolder.Items()
nCount = objFolderItems.Count

' 列挙1
strData = ""
For i = 0 to nCount - 1

	strData = strData & RpadB(objFolderItems.Item(i).Name," ",30 )
'	strData = strData & RpadB(objFolderItems.Item(i).ModifyDate," ",30 )
	strData = strData & RpadB(objFolderItems.Item(i).Path," ",89 )
'	strData = strData & RpadB(objFolderItems.Item(i).Size," ",20 )
'	strData = strData & RpadB(objFolderItems.Item(i).Type," ",20 )
	WScript.Echo strData
	strData = ""

Next


' 列挙2
Wscript.Echo
Wscript.Echo "【デスクトップ/詳細情報】"
Wscript.Echo "----------------------------------------------------"
strData = ""
For Each obj In objFolderItems

	strData = strData & RpadB(objFolder.GetDetailsOf(obj, 0)," ",20 )
	strData = strData & RpadB(objFolder.GetDetailsOf(obj, 1)," ",20 )
	strData = strData & RpadB(objFolder.GetDetailsOf(obj, 2)," ",20 )
	strData = strData & RpadB(objFolder.GetDetailsOf(obj, 3)," ",20 )
	strData = strData & RpadB(objFolder.GetDetailsOf(obj, 4)," ",20 )
	strData = strData & RpadB(objFolder.GetDetailsOf(obj, -1)," ",20 )
	WScript.Echo strData
	strData = ""

Next

Wscript.Echo

</SCRIPT>
</JOB>


▼ Windows10 での実行結果サンプル


結果をテキストファイルに残すには、以下のようにして表示をファイルにリダイレクトします
cscript ginpro_1517239356526.wsf > log.txt



一部特殊フォルダが表示されていますが、それらを使用してエクスプローラを起動する事ができます。Winows10 で、PC を選択してエクスプローラを開く記述は以下のようになります。

Explorer /e,/root,::{20D04FE0-3AEA-1069-A2D8-08002B30309D}

posted by at 2018-12-08 13:30 | VBScript |

2018年06月24日

Excel シートから Basp21 を使用してメールの送受信をして、今後の何かに役立てる

Basp21 は Down Load! BASP21-2003-0211.exe (1.44MB) がおすすめです。

※ ボタンは ActiveX でないとダメです



これだけではただのお遊びですが、メールというのはとても応用手段の多いものです。とりあえず Basp21 が古すぎて、Gmail はアウトだと思います。テストはさくらインターネットのメールで行っています。

でも、ローカルとか社内なら十分に使えます。

※ 受信は Subject、From、Dateヘッダーの内容のみを返します

Const SMTP As String = "xxxxxxxx.sakura.ne.jp:587"
Const POP As String = "xxxxxxxx.sakura.ne.jp"
Const RCVDIR As String = ">C:\temp\rcvmail"
Dim Basp21 As Object

Private Sub ボタン_Click()


    MsgBox ("OK")
    
    Set Basp21 = CreateObject("Basp21")
    
    Dim ErrMessage As Variant
    ErrMessage = Basp21.SendMail( _
        SMTP, _
        Worksheets("Sheet1").Cells(3, 5).Value, _
        Worksheets("Sheet1").Cells(3, 8).Value & vbTab & Worksheets("Sheet1").Cells(4, 8).Value & ":" & Worksheets("Sheet1").Cells(5, 8).Value, _
        Worksheets("Sheet1").Cells(1, 5).Value, _
        Worksheets("Sheet1").Cells(2, 5).Value, _
        "" _
    )
    
    If ErrMessage <> "" Then
        MsgBox (ErrMessage)
    Else
        MsgBox ("メール送信が終了しました｡")
    End If

    
    Dim output As Variant
    Dim I As Integer
    
    output = Basp21.RcvMail(POP, _
                Worksheets("Sheet1").Cells(4, 8).Value, _
                Worksheets("Sheet1").Cells(5, 8).Value, _
                "LIST", _
                RCVDIR)
                
    If IsArray(output) Then
    
        For I = 0 To UBound(output)
        
            Worksheets("Sheet1").Cells(I + 6, 4).Value = output(I)
    
        Next
        
    Else
    
        MsgBox (output)
        
    End If

    Set Basp21 = Nothing

End Sub

メールアドレスをリンクしないようにするのは、オプションの文書校正 => オートコレクトのオプション => 入力オートフォーマットの先頭のチェックボックスをオフ


パスワードの編集は、ユーザ定義で **;**;**;** 
( こんなのあるんですね )

posted by at 2018-06-24 21:05 | VBScript |

- 1 2 3 4 5 >>

Seesaa ブログ

Seesaa の各ページの表示について

Seesaa の 記事がたまに全く表示されない場合があります。その場合は、設定＞ 詳細設定＞ ブログ設定 で 最新の情報に更新の『実行ボタン』で記事やアーカイブが最新にビルドされます。

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

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

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

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


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

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

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

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

<% if:page_name eq 'tag' -%>
タグページでのみ表示される内容
<% /if %>

この記述は、以下の場所で使用します

	写真素材足成
	ぱくたそ
	Image * After
	空フリー写真素材
	WEBデザイナーが作った超シンプル素材集
	無料イラスト/春夏秋冬/イラストわんパグ

	切絵字・モフ字・水面字・三次元切絵字・イバラ字
	武蔵システム無料フォント
	Gray Graphics
	梅フォント
	ホリデイMDJP03（Holiday-MDJP03）
	Fontopo
	たぬきフォント
	Font Foundry iAi-jp
	ALT-DESIGN@clip
	Gutenberg Labo
	:::STUDIO twoG:::
	フォーマット変換

	JavaScript : 文字列で表現された日付を論理チェック
	複数行のグループデータを1行にまとめるSQL
	jQuery プラグイン jquery.balloon.js の外部からのコントロール
	C# の delegate : メソッドの引数にメソッドを渡して使用する方法と、JavaScript の function(){} と同じ使用方法( 匿名 )
	Windows 標準の CDO.Message で(GmailまたはYahoo!メールを使って)簡単にバッチ処理からメールを送る
	VBScript : 3種のMDB(または accdb)内のテーブル一覧取得方法
	jQuery/JavaScript : 新しく開かれたウインドウのウインドウコントロール
	【VBS + Excel】シンプルな詳細設計書のフォーマットをExcelがインストールされている環境で簡単に作成する

	GIMP で星空の作り方
	GIMP で誰でも炎を簡単に作ったり使ったりする方法
	炎の画像から GIMP の炎ブラシを作成する方法
	爆炎画像作成(ブラシ)
	Imageafter の画像を加工してイラスト調背景に ( Landscape Painter )
	GIMP 効果の Landscape Illustrator
	Scripts that work in GIMP-2.8+
	GIMP FX Foundry
	GIMP 2.8にて、ステンドグラスロゴ。