2017年 08月 16日 ( 1 )
[VBScript] 全角英数&記号を半角へ変換する
どーもボキです。

定型業務のツール支援するにも、文字バイトが統一されていないとそれすらままならない。

というか、たいていの人は文字バイトなど意識しない。
本当にわからないのだろう、言っても直らない。ツール側で吸収したほうが早い。

以下のZenToHan関数で文字サイズを半角に統一するとよい。
a0021757_09255103.png
ZenToHan関数での変換事例

SetScriptHost("cscript")

s = "yozda ( … > Z_ ̄∂ "
dprintf " 前:" & s
dprintf " 後:" & ZenToHan(s)

' ===============================================================================
' 全角→半角
Function ZenToHan(iStr)
Dim i,r

r = ""
For i = 1 To Len(iStr)
r = r & ZenToHan_func(Mid(iStr, i, 1))
Next
ZenToHan = r
end function
' 関数
Function ZenToHan_func(iStr)
Dim r
r = iStr
ZenToHan_func = r
If Asc(r) < Asc(" ") Then Exit Function
If Asc(r) > Asc("z") Then Exit Function

Select Case r
Case " " r = " "
Case "," r = ","
Case "." r = "."
Case ":" r = ":"
Case ";" r = ";"
Case "?" r = "?"
Case "!" r = "!"
Case "^" r = "^"
Case "_" r = "_"
Case "ー" r = "-"
Case "―" r = "-"
Case "‐" r = "-"
Case "/" r = "/"
Case "~" r = "~"
Case "|" r = "|"
Case "’" r = "'"
Case "”" r = """"
Case "(" r = "("
Case ")" r = ")"
Case "[" r = "["
Case "]" r = "]"
Case "{" r = "{"
Case "}" r = "}"
Case "+" r = "+"
Case "-" r = "-"
Case "=" r = "="
Case "<" r = "<"
Case ">" r = ">"
Case "′" r = "'"
Case "″" r = """"
Case "¥" r = "\"
Case "
" r = "$"
Case "
" r = "%"
Case "
" r = "#"
Case "
" r = "&"
Case "
" r = "*"
Case "
" r = "@"
Case Else
If Asc(r) >= Asc("
") Then
r = Chr(Asc(r) -Asc("
") +Asc("a"))
ElseIf Asc(r) >= Asc("
") Then
r = Chr(Asc(r) -Asc("
") +Asc("A"))
ElseIf Asc(r) >= Asc("
") Then
r = Chr(Asc(r) -Asc("
") +Asc("0"))
End If
End Select
ZenToHan_func = r
End Function
' ===============================================================================
' 実行ホストを切り替える
Sub SetScriptHost(HostName)
Dim i,s

If InStr(LCase(WSCript.FullName), LCase(HostName)) <> 0 Then Exit Sub

s = HostName & "
""" & WScript.ScriptFullName & """"
If WScript.Arguments.Count > 0 Then
For i = 0 To WScript.Arguments.Count -1
s = s &"
""" & WScript.Arguments.Item(i) & """" ' 引数
Next
End If
CreateObject("
WScript.Shell").Run s
WScript.Quit
End Sub
' -------------------------------------------------------------------------------
' デバッグ ※ここだけ抜粋してもOK
Dim objDbg
' クラス
Class TDebug
Dim FCScript

' 初期化処理
Private Sub Class_Initialize()
FCScript = InStr(LCase(WSCript.FullName), "
cscript") > 0
End Sub

' 終了処理
Private Sub Class_Terminate()
If Not FCScript Then Exit Sub

WScript.StdOut.WriteLine NOW & "
[END]"
WScript.StdIn.ReadLine
End Sub

' CScriptホストかどうか
Public Property Get CScript
CScript = FCScript
End Property

' デバッグメッセージ処理
Public Sub dprintf(v)
Dim i,s,ityp
If Not FCScript Then Exit Sub

s = v
ityp = VarType(v)
If ityp = vbBoolean Then
s = CStr(v)
ElseIf VarType(v) >= vbArray Then
s = "
"
For i = 0 to UBound(v)
s = s & "
dprintf(" &i& ")=" & v(i) & vbCRLF
Next
End If
WScript.Echo s
End Sub
End Class
' 関数
Sub dprintf(v)
If VarType(objDbg) = vbEmpty Then
Set objDbg = New TDebug
objDbg.dprintf(NOW & "
" & WScript.ScriptFullName)
End If
objDbg.dprintf(v)
End Sub



[PR]
by yozda | 2017-08-16 22:11 | プログラミング | Trackback | Comments(0)