2007年06月28日

入力文字を検索文字で検索し検索文字より左側の文字列を返す

'================================================================================
' 説明: 入力文字を検索文字で検索し検索文字より左側の文字列を返す
' 引数: inmoji   >入力文字
'   : search   >検索文字
' 戻り: GetOutMoji >
'================================================================================
Function GetOutMoji(inmoji,search)

 if Instr(inmoji,search) > 0 then
  GetOutMoji = Left(inmoji,Instr(inmoji,search)-1)
 else
  GetOutMoji = inmoji
 end if

End Function
posted by べる at 17:13| 沖縄 ☀| Comment(0) | TrackBack(1) | VBScript | このブログの読者になる | 更新情報をチェックする

2007年03月08日

2006年11月08日

動的配列にデータが設定されているか?

動的配列に値が設定されていない場合

if Join(aryE,",") <> "" then が無いと
UBound(aryE)の所で「VBScript 実行時エラー エラー '800a0009'. インデックスが有効範囲に
ありません。」のエラーになる。
それを回避するために、Join(aryE,",")を使用して
データが設定されているかを確認している。

dim aryE()
For ix=1 to max
 ReDim Preserve aryE(ix)
 aryE(ix) = e
 ix = ix + 1
Next

if Join(aryE,",") <> "" then
 For intCnt = 0 To UBound(aryE)
  ★★★処理★★★
 Next
end if
posted by べる at 14:58| 沖縄 ☔| Comment(0) | TrackBack(0) | VBScript | このブログの読者になる | 更新情報をチェックする

2006年11月06日

配列の初期化 ERASE

dim array() '配列
erase array '初期化
posted by べる at 17:04| 沖縄 ☔| Comment(0) | TrackBack(0) | VBScript | このブログの読者になる | 更新情報をチェックする

2006年10月25日

改行を
タグに置き換える

'================================================================================
' 13.改行を<BR>タグに置き換える
' 引数: str_data  >対象文字列
' 戻り: lbl_crlf  >変換後の文字列
'================================================================================
Function lbl_crlf(str_data,lbl_data)
 dim str_wk
 str_wk = ""
 if not isNull(str_data) then
  str_wk = Replace(str_data,Chr(13) & Chr(10),"<BR>")
 end if
 lbl_data = str_wk
End Function
posted by べる at 12:15| 沖縄 ☔| Comment(2) | TrackBack(0) | VBScript | このブログの読者になる | 更新情報をチェックする

2006年09月27日

半角英数字チェック

'**************************************************************************************************
' 説明: 半角英数字チェック
' 引数: Str >検索文字列(String)
' 戻り: Return >True:半角英数字以外が含まれている
'            False:半角英数字のみである
'**************************************************************************************************
Function isAlpNum(str)

 isAlpNum = PatternChk(str,"[^0-9a-zA-Z]")  '検索パターン文字列チェック

End Function
posted by べる at 11:05| 沖縄 ☔| Comment(0) | TrackBack(0) | VBScript | このブログの読者になる | 更新情報をチェックする

検索パターン文字列チェック

'**************************************************************************************************
' 説明: 検索パターン文字列チェック(Aspの正規表現を使用してチェックする)
' 引数: str >検索文字列(String)
'     pat >検索パターン文字列
' 戻り: Return >True :検索パターン文字列以外が含まれている
'            False:検索パターン文字列のみである
'**************************************************************************************************
Function PatternChk(str,pat)

 Dim Obj            'オブジェクト定義
 Set Obj = New RegExp   'オブジェクトの作成
 Obj.Pattern = pat       '検索パターン文字列設定
 PatternChk = Obj.Test(str)  'Aspの正規表現でチェック
 Set Obj = Nothing     'オブジェクトの開放

End Function
posted by べる at 11:02| 沖縄 ☔| Comment(0) | TrackBack(0) | VBScript | このブログの読者になる | 更新情報をチェックする

2006年09月14日

ASCIIコードでのバイト長を返す

'================================================================================
' 説明: ASCIIコードでのバイト長を返す
' 引数: data  >対象となる文字列
' 戻り: AscLenB   >指定文字列のASCIIコードでのバイト数
' 備考: 半角1文字は"1"を返す。
'   全角1文字は"2"を返す。
'================================================================================
Function AscLenB(data)

 Dim i

 AscLenB = Len(data)
 For i = 1 To Len(data)
  If Len(Hex(Asc(Mid(data, i, 1)))) > 2 Then
   AscLenB = AscLenB + 1
  End If
 Next

End Function
posted by べる at 09:44| 沖縄 ☁| Comment(0) | TrackBack(0) | VBScript | このブログの読者になる | 更新情報をチェックする

2006年09月12日

ErrorVBScriptReport

function ErrorVBScriptReport(naiyo)

 ErrorVBScriptReport=true

 if err.number = 0 then
  exit function
 end if
 Response.Write (" NAIYO : " & naiyo & vbcrlf)
 Response.Write ("<BR><B>===== ERROR VB SCRIPT MESSAGES START =====" & vbcrlf)
 Response.Write ("ERROR NUMBER = " & err.number & vbcrlf)
 Response.Write ("ERROR DESC = " & err.description & vbcrlf)
 Response.Write ("HELP CONTEXT = " & err.helpcontext & vbcrlf)
 Response.Write ("HELP FILE PATH = " & err.helpfile & vbcrlf)
 Response.Write ("ERROR SOURCE = " & err.source & vbcrlf)
 Response.Write ("ERROR FILE = " & err.file & vbcrlf)
 Response.Write ("ERROR LINES = " & err.line & vbcrlf)
 Response.Write ("ERROR COLUMN = " & err.column & vbcrlf)
 Response.Write ("ERROR DESC2 = " & err.aspdescription & vbcrlf)
 Response.Write ("<BR><B>===== ERROR VB SCRIPT MESSAGES END =====" & vbcrlf)

end function
posted by べる at 10:21| 沖縄 ☁| Comment(0) | TrackBack(0) | VBScript | このブログの読者になる | 更新情報をチェックする

2006年09月08日

on error resume nextとErrorVBScriptReport のトリビア??

on error resume next を、プログラムの先頭に入れて
ErrorVBScriptReport sql(→エラーになったsql文を表示) で、VBScriptのエラーを拾って
メッセージなどを表示させる処理を行っている場合

想定していない所で、VBScriptのエラーが発生し
エラー箇所の洗い出しに時間がかかる場合がある。

そういう時には
on error resume nextをコメントにして実行すると、
案外、すぐにエラーになっている箇所が見つかります。
posted by べる at 11:40| 沖縄 ☁| Comment(0) | TrackBack(0) | VBScript | このブログの読者になる | 更新情報をチェックする

2006年08月28日

ファイルのコピー、移動

'================================================================================
'10.ファイルのコピー、移動
'  引数:syuri_f>0:コピー 1:移動
'     cp_moto>元(フルパス)
'     cp_saki>先(フルパス)
'  戻り:cpmv_file>true/false
'================================================================================
Function cpmv_file(syuri_f,cp_moto,cp_saki)
 Dim obj_fil
 Dim res
 cpmv_file = true
 set obj_fil = Server.CreateObject("Scripting.FileSystemObject")
 res = obj_fil.CopyFile(cp_moto,cp_saki,true)
 If Err.Number <> 0 then
  cpmv_file = false
 else
  if syuri_f = "1" then
   res = obj_fil.DeleteFile(cp_moto,true)
  end if
  If Err.Number <> 0 then
   cpmv_file = false
   end if
  end if
 set obj_fil = nothing
End Function
posted by べる at 13:39| 沖縄 ☔| Comment(0) | TrackBack(0) | VBScript | このブログの読者になる | 更新情報をチェックする

2006年08月24日

日付計算ルーチン(±月数)

'================================================================================
' 日付計算ルーチン 取得
' 引数:wdate   >基準日
'   :tuki   >加減したい月数
' 戻り:get_month >計算された日付 (西暦8桁)
'================================================================================
Function get_month(wdate,tuki)

 Dim wk_month
 Dim wk_month2
 dim str_date

 str_date = right(wdate,2) & "/" & mid(wdate,5,2) & "/" & left(wdate,4)
 wk_month = DateAdd("m",tuki,CDate(str_date))
 wk_month2 = year(wk_month) & string(2-len(month(wk_month)),"0") & month(wk_month) & string(2-len(day(wk_month)),"0") & day(wk_month)
 get_month = wk_month2
End Function
posted by べる at 15:24| 沖縄 ☔| Comment(0) | TrackBack(0) | VBScript | このブログの読者になる | 更新情報をチェックする

日付の計算(±日数)

'================================================================================
' 日付計算ルーチン取得
' 引数:wdate>基準日(YYYYMMDD)
'   :nissu>加減したい日数(±日数)
' 戻り:get_date>計算された日付(YYYYMMDD)
'================================================================================
Function get_date(wdate,nissu)

 Dim wk_day
 Dim wk_day2
 dim str_date

 str_date = right(wdate,2) & "/" & mid(wdate,5,2) & "/" & left(wdate,4)
 wk_day = DateAdd("d",nissu,CDate(str_date))
 wk_day2 = year(wk_day) & string(2-len(month(wk_day)),"0") &  month(wk_day) & string(2-len(day(wk_day)),"0") & day(wk_day)
 get_date = wk_day2

End Function
posted by べる at 15:14| 沖縄 ☔| Comment(0) | TrackBack(0) | VBScript | このブログの読者になる | 更新情報をチェックする

広告


この広告は60日以上更新がないブログに表示がされております。

以下のいずれかの方法で非表示にすることが可能です。

・記事の投稿、編集をおこなう
・マイブログの【設定】 > 【広告設定】 より、「60日間更新が無い場合」 の 「広告を表示しない」にチェックを入れて保存する。


×

この広告は1年以上新しい記事の投稿がないブログに表示されております。