おきつねさまのひまつぶし -Archives-

2009/03/09

VBScriptで日付処理それから･･･


C++で作成してる別アプリが完了次第、
VBScriptでの日付処理最終版にとりかかる予定。

ただ思うに、C++で .NetFrameworkを利用して、
日付関連の文字列返すActiveXオブジェクトを組んだほうが効率良い様な気も･･･

シェアウェアなら似たようなのあるみたいだけど、
   VisualBasic関数のラッパーDLL VBWRAP ver1.00    
日付だけでイイって向きには、コスト掛けてまでってのはチョットね･･･

Excelワークシート関数に･･･


DateSerialがナイことに、さっき気がついた･･･

ナニをイマサラと云われそうだが、ソレもソノ筈、
    '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－         
        'Worksheet向けDateSerial     
        '- Created by LazwardFox -     
         
        'update 200903090716 微修正     
        'Release200511291534     
         
        Public Function iDateSerial(Optional ByVal iYear As Variant = "", _     
                                    Optional ByVal iMonth As Variant = "", _     
                                    Optional ByVal iDay As Variant = "", _     
                                    Optional ByVal iFormat As Variant = "") As Variant     
            On Error Resume Next     
            Application.Volatile     
            Dim Result     
            Result = DateSerial(iYear, iMonth, iDay)     
            If IsError(Result) Then '※     
                Result = Now() '※     
            End If '※     
            If iFormat = "" Then     
            Else     
                Result = Format(Result, iFormat)     
            End If     
            iDateSerial = Result     
        End Function      
こんなのツクってアドインとして組み込んで使っていたので、そのコトを忘れていた(;ﾟдﾟ)ｧ.... 


Worksheet上で
   =iDateSerial(2009,3,0,"yyyy/mm/dd")    
こう使う。

当然、引数はセル参照を指定できるので、当時は それなりに使えたよ。

ちなみに、今日追加したのは、文字列返しの部分と、不正入力対応･･･
デモ、ホントに使うのなら、不正値での動作は、エラーを返すほうがイイのかも知れない･･･
そうしたい場合は、※印の行を消して使ってくださいなっと♪


P.S. コッチのほうが無難かも･･･
    '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－         
        'Worksheet向けDateSerial     
        '- Created by LazwardFox -     
         
        'update 200903090824 再微修正     
        'Release200511291534     
         
        Public Function iDateSerial(Optional ByVal iYear As Variant = "", _     
                                    Optional ByVal iMonth As Variant = "", _     
                                    Optional ByVal iDay As Variant = "", _     
                                    Optional ByVal iFormat As Variant = "") As Variant     
           On Error Resume Next     
           Application.Volatile     
           Dim Result     
           If iYear="" And iMonth="" And iDay="" Then     
               Result = Date()     
           Else     
               Result = DateSerial(iYear, iMonth, iDay)     
           End If     
           If iFormat = "" Then     
           Else     
               Result = Format(Result, iFormat)     
           End If     
           iDateSerial = Result     
       End Function

VBScriptで月末日取得最強処理･･･


つか、VBSで無くとも応用できます、閏とか一切気にしなくてイイです。

今日の月の月末日は ってのは
   n = Now()
   ny = Year(n)
   nm = Month(n)

   ML = DateValue(ny,nm+1,0)    
コレだけ(爆)

優良サイトではないので変数宣言省いてマスΨ(｀∀´)Ψ

単に日付が欲しいだけで、イチイチ閏なんて計算してらんないって、バカらしくてw
ただ、税額処理だの、給与計算だのってぇのでは、意外に使える(実際使ってた)

+1 0 ってトコがツボ。大体殆どの開発環境で使えるし、
Excelワークシート関数なら
   =DATEVALUE(YEAR(NOW())&"/"&MONTH(NOW())+1&"/1")-1    
こうなる。

Excel/AccessなどのVBAでも有効な手段。
   Dim nYear As Integer ,nMonth As Integer
   
   nYear = 2009
   nMonth = 2
  
   '日付値が欲しい場合
   LastDay = DateSerial(nYear, nMonth + 1, 0)

   '日のみ欲しい場合
   LastDay = Day(DateSerial(nYear, nMonth + 1, 0))    


Excelに対し、DateControls.xlaと云うExcelAddinファイルをツクって、
モジュールにFunctionsと銘打って、その中に記述していた関数、
Public宣言とApplication.Volatile記述で、ワークシート関数として使っていたブツ。
    '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－         
        'LastDayGet    - Serial値から日付を取得し同月の末日を返す。     
        '- Created by LazwardFox -     
         
        '閏月対応     
             
        'update 200607031715 エラートラップ修正     
        'Release200511291534     
         
       Public Function LastDay(Optional ByVal Target As Variant = "") As Integer          
           On Error Resume Next     
           Application.Volatile     
           If Target = "" Or Target = 0 Or IsError(Target) Then     
               Target = Now()     
           End If     
           LastDay = Day(DateSerial(Year(Target), Month(Target) + 1, 0))     
       End Function     


しかし、最近はExcelも使わなくなったなぁ･･･

って、職があった頃から、Excelには見切りつけて、
数百MB規模のデカいデータは、VBSで適宜処理して、AccessやSQL鯖にブチ込んで処理してたケドねww

つか、プーしてる今となっては、無用の長物だけどねww＜月末 日付取得 うるう Excel Access VBA＞

云うたトコロで所詮･･･


元々Excel&AccessVBA使いが、以前、仕事の都合でVBScriptに手を出したので、移植モノも多いのデス。

なので、時折間違って、
    Public Function      
って、無意味に宣言記述してしまうコトも、いまだにあったり･･･^_^;

まぁ、日付に関しては、Script系では、VBAの使い良さに勝てないデスね･･･
･･･VBA:VisualBasic for Applicationの略 
MSOffice製品のマクロ機能を司ってるのがｺｲｼ。･･･って既知だろな、どうせ;

当然本家VisualBasicも、同様に処理できるので、
以前紹介したような、複雑なスクリプトなど無用の長物そのものなのデス。
だったらナンで書いたのか･･･ ソコに山があったのデス! (VBSで)ドコまでやれば、
そのヘン近づけられるかってのに興味があっただけなのデスww

VBScript実行が抑制される？･･･


VBScriptの.vbsファイルは、一部のセキュアアプリで実行が許可されないか、
実行確認画面をクリックする必要に迫られることがある。
(KingS●ft製のでヤラれたコトがある、数年前に･･･)
タスクで自動動作させたい向きには非常に厄介だ。

それらを避けたい場合は、.vbsファイルをエンコードして利用するコトで、
セキュアを維持しつつの自動化への解決となることが多い。

エンコード後の拡張子は .vbe

肝心のエンコーダは、 WindowsScriptEncoderと云うのが、
Microsoftサイトで配布(要認証)されているので、利用されたし。

ソースを読まれたくない場合などにも良いかと･･･w

VBScriptで鯖管理そにょ１･･･


Update 20090311 0300
   ココのScriptも、以後のログにアーカイブ用意しました。    

Windowsのタスクに登録して、日毎フォルダを作成するだけのスクリプト。
当然設定は １日１度 00:00 に 動作させる。

なんでそんなモノ要るのかって？
毎日定点で写真を撮ってるので、保存毎にフォルダ作るのが面倒になったからwww
ちなみに、ココで公開したスクリプトは、元々コレ向けだったものが多いですww

今回の分は、以前の仕事で、

 "起動後、特定条件の日だけにデータ取得を動作させるよう、処理を自動化してくれ"

と依頼されて創ったモノをバラし、その断片に、新たな構想を加えて作成したモノです。
(確か、六曜で云う、大安 の日だけって指定だったと思う 当然Windowsのタスクにそんな器用な設定はない。)

iniファイル配置で、複数フォルダを対象に出来るのが、ちょっとだけ凝った点w
つか、コレに関しては、用途的に必須だったってのが事実^_^;

と云うのも、タスクにvbsやvbeを登録する場合、
ソレ自体はスクリプトであって、実行する本体ではないので、パラメータの指定が出来ないと云う罠が･･･
もっとも、ランタイム自体から記述してしまえばイイのだろうが、面倒だ。
どうせなら単純登録だけで使いたい･･･ と云う なんとも手抜きな欲がココまでさせたとも云える･･･
それに、複数のフォルダに同処理を施したかったってものあったので、iniファイルを読み込むカタチにしたと(´ﾍ｀；)

デキルコトはってぇと、指定フォルダ配下に、
   [指定したフォルダ]
              └ yyyy
                  └ mm
                     └ dd   
と云うカタチでフォルダを追加するだけw
指定したターゲットフォルダは、既存していることが必須で、ない場合、処理は実行されません。
自動でターゲットフォルダを作成する処理も検討しましたが、セキュリティ的に疑問を感じた為ヤメました。

書式)
    DateFolderCreate.vbe {対象フォルダ名{,対象フォルダ名}    


パラメータ無指定の場合
   [スクリプトを起動したフォルダ]
                           └ 2009
                               └ 03
                                  └ 09   
と、なり、

コマンドラインやショートカットからの、パラメータ指定起動の場合、
   [指定したフォルダ]
              └ 2009
                  └ 03
                     └ 09   
と なります。

また、スクリプトが配されているフォルダに、スクリプトと同名のiniファイルがあり、
   C:\Target,C:\Target\Target   
ないし、
   C:\Target
   C:\Target\Target   
と記述があれば、

   C:\Target
     ├ 2009
     │  └ 03
     │     └ 09
     └ Target
          └ 2009
              └ 03
                 └ 09   
と、云う結果になります。

指定先に、対象が既存の場合は、スキップするようになっているので、殆ど意識無く使えます。


毎度のコトながら、役割ごとに関数化してあるので、流用もしやすいかと･･･

▼ウチの鯖たん上で、実働してるスクリプトそのもの･･･^_^;
    '***** ↓↓↓ScriptTitle↓↓↓ *********************************************************     
        'PhotoFolderCreate     
        '- Created by LazwardFox -     
        '単独起動で、起動フォルダに日付でフォルダを作成。     
        'パラメータ指定で複数フォルダ上に同一処理を実行。     
             
        '注) 20090223 0300 タスクマネージャ動作時、直接指定の場合、パラメータ指定不可      
         
        ' Update 20090223 1442 必要関数のみに削減     
        ' Update 20090223 1438 関数拡張     
        ' Update 20090223 0253 iniファイルによるフォルダ指定を可能に、スクリプトファイル名を変更して利用。     
        ' Update 20090223 0253 iDT修正     
        ' Update 20090223 0135 iDT修正     
        ' Update 20090222 2141     
        ' Release 20090222 2108     
        ' DevStart 20090222 2014     
          
    '***** ↓↓↓ ObjectDecralations ↓↓↓ *************************************************     
        Set Parameters = WScript.Arguments 'パラメーター取得     
        Set Fs = WScript.CreateObject("Scripting.FileSystemObject") 'ファイル制御     
         
    '***** ↓↓↓ Decralations ↓↓↓ *************************************************     
        Dim arTargets, iRoot, tFolder, sCD, arCD, iChk, sCN     
         
    '***** ↓↓↓MainRoutine↓↓↓ *********************************************************     
        If Parameters.Count > 0 Then     
            arTargets = Split(Parameters(0),",")     
        Else     
            arTargets = TargetFolders()         
        End IF     
        arCD = Split(iDT("\"," ",":",1)(0),"\")     
        For Each iRoot In arTargets     
            If Fs.FolderExists(iRoot) Then     
                tFolder = iRoot     
                For Each iChk In arCD     
                    sCN = Fs.BuildPath(tFolder,iChk)     
                    If Fs.FolderExists(sCN) Then     
                    Else     
                        Fs.CreateFolder sCN     
                    End If     
                    tFolder = sCN     
                Next     
            Else     
            End If     
        Next     
        Set Fs = Nothing     
        Set WSHShell = Nothing     
        Wscript.Quit     
             
    '***** ↓↓↓Functions↓↓↓ *********************************************************     
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'iDT - 日時文字列 ないし 日/時配列取得 for VBScript     
        '- Created by LazwardFox -     
             
                'Update 20090228 0458 変数宣言変更     
                'Update 20090223 0959 時刻桁処理変更     
                'Update 20090223 0253 Len記述忘れ修正     
                'Update 20090223 0135 変数宣言忘れ修正     
                'Update 20090210 0218     
                'Update 20090210 0115     
                'Release 20090209 2035     
         
                '    iDT (     
                '     dSplitter - DateSplitString             (Normal - "/")     
                '    ,dtSeparater - Date/Time SepaleteString (Normal - " ")     
                '    ,tSplitter - TimeSplitString             (Normal - ":")     
                '    ,Control - 配列化 0 or 1                (Default - 1)     
                '    )     
         
        Public Function iDT(dSplitter,dtSeparater,tSplitter,Control)     
            Dim nX, nD, nS, strHMS, sResult 'Update 20090228 0458     
            nX = Now()     
            nD = FormatDateTime(Date(),0)     
            nS = ":" & Split(CStr(FormatDateTime(nX,3)),":")(2)     'Update 20090223 0951     
            strHMS = FormatDateTime(nX,4) & nS                      'Update 20090223 0951     
            If tSplitter = ":" Then     
            Else     
                strHMS = Replace(strHMS,":",tSplitter)     
            End If     
            sResult = Cstr(Replace(nD,"/",dSplitter)) & "*" & strHMS     
            If Control = 1 Then     
                iDT = Split(sResult,"*")     
            Else     
                iDT = Replace(sResult,"*",dtSeparater)                 
            End If     
        End Function     
         
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'TargetFolders     
        '- Created by LazwardFox -     
        'スクリプトと同名のiniファイルがあれば、内容を配列で取得     
        '対象フォルダを取得、iniファイルがあれば優先する。戻り値は配列     
         
            ' Update 20090223 0550 変則的フォルダ名回避のため修正     
            ' Release 20090223 0509     
         
        Public Function TargetFolders()     
            Dim sNFull, rFolder, sN, iniFile      
            sNFull = Wscript.ScriptFullName     
            rFolder = Fs.GetParentFolderName(sNFull)     
            sN = Fs.GetBaseName(sNFull)     
            iniFile = Fs.BuildPath(rFolder,sN & ".ini")     
            If Fs.FileExists(iniFile) Then     
                TargetFolders = iniLoader(iniFile,0)     
            Else     
                TargetFolders = Array(rFolder)     
            End If     
        End Function     
         
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'iniLoader - 対象をiniファイルより取得。     
        '- Created by LazwardFox -     
         
            ' Update 20090223 0550 戻り値可変 [ 0 - 配列 ] [ 1 - カンマ区切り文字列 ]     
            ' Release 20090223 0509     
         
        Public Function iniLoader(iniFile, Control)     
            Dim nS     
            nS = Fs.GetFile(iniFile).size     
            If nS = 0 Then     
                iniLoader = Array(Fs.GetParentFolderName(iniFile))     
            Else     
                Dim  iFile, lResult, strResults     
                Set iFile = Fs.OpenTextFile(iniFile,1) 'iniファイルを読み取りモードで開く     
                WScript.Sleep 150     
                Do Until iFile.AtEndOfStream '読み込み     
                    lResult = lResult & ";" & iFile.ReadLine & ";"     
                Loop     
                WScript.Sleep 150     
                iFile.Close 'Iniファイルを閉じる     
                strResults = Replace(Replace(lResult,";;",","),";","")     
                If Control = 0 Then     
                    iniLoader = Split(strResults, ",")     
                Else     
                    iniLoader = strResults     
                End If     
            End If             
        End Function     


って、以前のログから読んでるヒトには、使用関数周り、ドコかで見覚え感ありありでしょうが、
まぁ、御愛嬌と云うコトでww

･･･つか、こんなのに用がある閲覧者が居るのかってコトのほうが、いささか疑問だが(´ﾍ｀；)＜そのまま使えるVBScript 日付 フォルダ 作成 自動化 複数 ルートフォルダ 指定可能＞

もう･･･


いい加減、StyleSheetの宣言が鬱陶しくなってキタので、外部ファイル化した。

･･･って、単に今までのを集約して、テキストに貼っつけて、cssファイル作っただけなんだけどねw
ただ、自鯖上の各テストサイトの分、管理グダグダになってたのでスッキリした。

2009/03/08

エラい目みた･･･


WMI呼び出しだけで済まそうと手を付けたC#が、１日程度で挙動を把握できたコトにチョーシづき･･･って、
得られた値は、レジストリにあるクロックアップ前のモノで、全く使い物にならなかったのだが･･･(;_;
･･･で、面倒を省みず、RDTSC命令を使うが為に、C++の敷居を跨いでしまったってのはマズかった･･･ 
なんか、ほぼ睡眠も取らずに獲り憑かれたように･･･ま、３日ほどで こいつも大体把握できたのでイイんだけどねw

しかしアレだね、C#やC++が使えると、デキるコトが格段に広がるのはイイんだケド、
後者なんてもうアレは、完全に人間向けでないでしょ、あの記述は･･･ ^_^; 
しかも、同じ処理させるだけで、アレだけ多様な対象の列挙の仕方があるのか と、
ホンキで考え込んでしまったよ･･･

しかし、使ってみて更にMSのWindowsに対する手抜き具合を知った感があるね。
プロセッサのRDTSC命令の扱い１つ取っても そう思えるよ･･･

･･･てっきり、Winは、休止モードから回復した時に、全てのレジスタに元の値がセットされてしまって、
検出方法がないから、休止復帰のRUNレジストリキーがナイのかと思ってたら、サにアらず、
しっかり初期化されてましたよ･･･ Visたんトカもコノへん未拡張のままなのかな？
マシン重いと、休止モードに頼りたくなるよね～ww

つか、プロセッサ多コア時代に、クロックの取得がハードレベルでﾃﾞﾌｫサポートされてないってのはドウなの？
石メーカーも、もう少し考えてツクれよってハナシにならないか？
実際、OSサイドからパワーマネージしようと思ったら、クロックの正確な値を得るのに、
レジスタ上のticksが頼りって ちょっとね･･･ しかもコア毎に可変でしょ、イマドキの石って･･･

ナニが不満ってGeodeNX1750@14Wは、某著名CrystalCPUIDナシでは、フルクロックにならんのよコレが!
ソレを補う監視ツールを創りたかっただけなんだよね～ C#だのC++だのに手を出した理由って･･･

しかも環境が VSExpressEditionなモンだから、肝心の欲しい機能を含むALTが憑いてなくて使えんし･･･
ま 結局、無くても全然困らなかったけどねww

しかし、1000msec取得するだけのインターバルタイマまで自分で書かないとならないとは･･･ 
VBScriptより辛いかしらん(´ﾍ｀；)

Windows.Forms.Timerに逃げる(クロック表示フォームあるし)というのも手段なのだが、
フォーム(を完全に)非表示とか、フォーム無しVer.とかでも動作させたい場合にチト困る･･･ 
マシンがショボいと、イラんトコに神経使うのよコレが･･･
動画再生もｲｯﾊﾟｲ×2なのは仕方ナイとして、Adobe製品やMSOffice製品ですらカナりキツい･･･ 
ソレらを使うには、あの軽いCrystalCPUIDすら常駐させて置けないんだから、ドウにもナラん(-_-;)

まぁ、完成したらココとかに うpする(ソースのほう)と思うケド、機器依存激しいカモねwww
敢えて普及してるんだか してナイんだか判らん .NetFramework3.5を多用しようと目論んでいると云うΨ(｀∀´)Ψ

･･･でも、基本的なモノしか描き込んでいない･･･そう、それは まるで、背景白い手抜き漫画のようなwww
･･･な、カンジだし、以外に大丈夫かな、カナ？ ^_^;

2009/03/04

ソレに比べて･･･


コッチの商品▼って、照明としてもヨさげだけど、

超高輝度ＥＬシート - 株式会社 海光社 

原稿や写真フィルム確認向けのライトテーブルの代わりに向いてるような希ｶﾞｽ
･･･価格と寿命が折り合うかが疑問ではあるが^_^;

諸元情報中に

　※発光色ホワイトは太陽光に当る場所に設置した場合、
　　紫外線の影響で赤色顔料が退色して少しづつ青味を帯びてゆきます。 

とあるが、コレでは一般利用するにはムリがあるなぁ と思いつつ見てたら、
　
　防湿ラミネートによる長寿命化
　空気中の水分をの侵入を防ぐために積層フィルムでラミネートしています。

ともある、だったら、

●曲げられる必要があるなら
　紫外線遮光フィルムを表層に貼る、ないし、同特性のあるラミネート材料を使う

●板状で使うなら
　紫外線遮光透明塗料をコーティングする、ないし、紫外線遮光プラスチック板を表層に充てがう

と云った構造にするだけでも、劣化防止に効果が上がりそうなものだが、検討しなかったのだろうか？
最近の紫外線カット系商品の可視光透過率の高さは、
過去のモノとは比較にならない程 性能が向上しているのだが･･･ 


   －－－－－－－－－－  update 200903080203 
   サイトから問い合わせてたら、先日レスきました。
   で、今は、UV対策済み商品もラインナップしているとのコト。
   ただ、ライトテーブル代わりにするには、もう少し精進が要りそうな御様子^_^;    
   今後に期待!

国内大手企業って･･･


いちいち イマサラ感 炸裂させてくれるトコ多いよな～

「省電力」有機ＥＬ照明に進出　出光、１３年めど　欧米で事業化検討 - FujiSankei Business i [ 20090303 ]

って、ホント今更、しかも検討とか云ってるし･･･ コレだからコッチ出のイナカ企業はよぅ･･･(´ﾍ｀；)

ついに手を付けてしまった･･･


VB6.0やVisualStudio.NET(2k2)に触れていた過去から逃れるかの如く、
つい先頃までは、出来るコトは殆どをVBScriptでカタづけてきたのだが、
JavaScriptに触れたあたりから、創りたいモノに欲が出てしまい、
とうとう、処理可能な範疇を超えてしまったらしい･･･

已む無く、インストールはしてあったVisualBasic2k8に手を出したが、
どうやら更に足りなくて、VC++やVC#にまで食指が伸びてしまった･･･ 
つか、マシンスペックがｱﾚなもんで、デバッグするだけで停まりそうなのだよ(||  ﾟДﾟ)
マトモな機材が揃うまでは関わりたくなかった開発環境だったのだが･･･

しかし作りたいのは、スペックの低さマトモじゃない機器向けなんだけどね(´ﾍ｀；)

2009/02/28

VBScriptで日付処理そにょ３･･･


日付の処理だけ、某Format関数を模してみた。･･･あくまで暫定版。
限られた指定方法で、要素を並べ替えられる程度しか機能しないが、
新たに曜日を要素として取得可能になっている。

書式)
   iDTw({tDate}, {tNow}, {sFormat}, {dSplitter}, {tSplitter}, {dtSeparator}, Control)    

      {tDate}        日付情報(時間を含まない)  Date()ないし等価
      {tNow}         時間情報                  Now()ないし等価
      {sFormat}      OutPutFormat              (Default - "Y/M/D H:N:S")
      {dSplitter}    DateSplitString           (Normal - "/")
      {tSplitter}    TimeSplitString           (Normal - ":")
      {dtSeparater}  Date/Time SepaleteString  (Default - " ")
      Control        0 文字列 / 1 配列化       (Default - 0)
      

{sFormat}に対し、半角英大文字の、"YMD" で 日付部分を 
"W"で曜日を "HN" で 時分を "S" で秒を、それぞれ任意の位置に配置できます。

★オマケ
   "S HNS YMD [W] HN"    
のようなデタラメな呼び出しも可能^_^;


曜日取得処理 GetWeekDay
装飾も含めて好きなように曜日文字列を取得したいが為だけに作成したモノ。
単なる曜日取得と異なり、逆引き検索や対応データへの変換など、
パラメータの適用次第で応用の幅を広げられるようになっている。
また、iDTw を使う場合、変数 strWeekday をPublicで宣言し、
この関数(の結果)を事前に代入しておくコトが必須となる。
なんだか、海外のライブラリ使ってるみたいで使いデ悪くて、お蔵入りさせてたブツではあるがw

書式)
   GetWeekday(YMD, wFormat, WeekdaysString, nDepth)

　　　YMD               － 日付を指定 (Date関数と等価値)
　　　wFormat          － 戻り値に対する装飾を指定  例) " [ W ] "
　　　WeekdaysString   － 曜日のリストを入力 ･･･リストの構成はサンプル参照のことw    
　　　nDepth           － リスト中の次元の深さを指定 (0～)


lArray や inArrays は、これらの為に用意したモノとも云える･･･

    '***** ↓↓↓ScriptTitle↓↓↓ *********************************************************     
        'GetWeekDay & iDTw & lArray & inArrays     
        '- Created by LazwardFox -     
         
        ' スクリプトライブラリの一部     
             
        ' Release 20090228 1639     
         
    '***** ↓↓↓ Decralations ↓↓↓ ******************************************************     
        Const strWeekdays = "1:月:MON:Mon:Monday,2:火:TUE:Tue:Tuesday,3:水:WED:Wed:Wednesday,4:木:THU:Thu:Thursday,5:金:FRI:Fri:Friday,6:土:SAT:Sat:Saturday,7:日:SUN:Sun:Sunday"     
        Const vbWq = """"     
        Public strWeekday     
         
        Dim varNow, VarDate, sDa, sDb, sDc, sDd, sDe, testResult     
         
         
    '***** ↓↓↓Main(Test)Routine↓↓↓ ***************************************************     
        varNow = Now()     
        varDate = Date()     
         
        'Function GetWeekday(YMD,wFormat,WeekdaysString,nDepth)     
        strWeekday = GetWeekday(varDate,,strWeekdays,3)     
         
        sDa = iDTw(varDate,varNow,"YMD [W] HN","/",":",,0) '文字列テスト     
        sDb = iDTw(varDate,varNow,"YMD",,,,0)              '文字列テスト     
        sDc = iDTw(,,"YMD*[W]*HNS",,,"*",1)                '配列テスト     
        sDd = iDTw(,,"YMDWHNS","",""," ",0)                'スプリッタ無しテスト     
        sDe = iDTw(,,"YMD [ W ] HNS","",""," ",0)          'スプリッタ無しテスト     
         
        testResult = "iDTw(" & "varDate,varNow," & vbWq & "YMD [W] HN" & vbWq & "," & vbWq & "/" & vbWq & "," & vbWq & ":" & vbWq & ",,0) - ＜String YMD[W]HN＞ - >>> " & sDa & vbTab & vbCrLf _     
        & "iDTw(" & "varDate,varNow," & vbWq & "YMD" & vbWq & ",,,,0) - ＜String YMD Only＞ - >>> " & sDb & vbTab & vbCrLf _     
        & "iDTw(" & ",," & vbWq & "YMD*[W]*HNS" & vbWq & ",,," & vbWq & "*" & vbWq & ",1) - ＜Array iDTw(1)＞ - >>> " & sDc(1) & vbTab & vbCrLf _     
        & "iDTw(" & ",," & vbWq & "YMDWHNS" & vbWq & "," & vbWq & vbWq & "," & vbWq & vbWq & "," & vbWq & " " & vbWq & ",0) - ＜String NoSplitter＞ - >>> " & sDd & vbTab & vbCrLf _     
        & "iDTw(" & ",," & vbWq & "YMD [ W ] HNS" & vbWq & "," & vbWq & vbWq & "," & vbWq & vbWq & "," & vbWq & " " & vbWq & ",0) - ＜String Full＞ - >>>" & sDe & vbTab     
         
        msgbox testResult,,"Test"     
         
    '***** ↓↓↓Functions↓↓↓ ***********************************************************     
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'GetWeekDay - 曜日文字列配列化及び取得     
        '- Created by LazwardFox -     
             
            ' Update 20090228 1403 inArraysの新版向けに変更     
            ' Update 20090228 0855 配列化関数をinArraysに差し替え     
            ' Update 20090223 1544     
            ' Release 20090223      
            ' Develop 20090223 1018     
         
            ' GetWeekday(     
            '             YMD   － 日付を指定 (Date関数と等価値)     
            '            ,wFormat  － 戻り値に対する装飾を指定  例) " [ W ] "     
            '            ,WeekdaysString   － 曜日のリストを入力     
            '            ,nDepth   － リスト中の次元の深さを指定 (0～)     
            '            )     
         
        Function GetWeekday(YMD,wFormat,WeekdaysString,nDepth)     
            Dim arsWeekdays,arWeekdays     
            If TypeName(WeekdaysString) = "Error" Then     
            ElseIf VarType(arWeekdays) = vbArray Then     
            Else     
                inArrays WeekdaysString,",:",arWeekdays     
            End If     
            If TypeName(wFormat) = "Error" Then     
                GetWeekday = arWeekdays(Weekday(YMD,2) - 1)(nDepth)     
            Else     
                GetWeekday = Replace(wFormat,"W",arWeekdays(Weekday(YMD,2) - 1)(nDepth))     
            End If     
        End Function     
         
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'iDTw - 日時(曜日)文字列 ないし 日/曜日/時 配列取得 for VBScript     
        '- Created by LazwardFox -     
         
            ' Update 20090228 1403 inArraysの新版向けに変更     
            ' Release 20090223 1413 iDTから改良     
         
            ' Control以外のパラメータを省略可     
         
            ' iDTw (     
            '      {tDate}日付情報(時間を含まない)Date()ないし等価     
            '     ,{tNow}時間情報Now()ないし等価     
            '     ,{sFormat}OutPutFormat(Default - "YMD HNS")     
            '     ,{dSplitter}DateSplitString (Normal - "/")     
            '     ,{tSplitter}TimeSplitString (Normal - ":")     
            '     ,{dtSeparater}Date/Time SepaleteString (Default - " ")     
            '     ,Control0 文字列 / 1 配列化  (Default - 0)     
            '     )     
         
            '記述例) iDTw(,,,,,0)－ 現在の年月日／時分秒を配列で取得     
            'iDTw(,,"YMD*W*HNS",,"*",0)－ 現在の年月日／曜日／時分秒を配列で取得     
         
            '曜日を取得する場合、事前に 変数strWeekdayをPublicで宣言し、     
            'GetWeekDay を実行、代入しておく必要があります。     
         
        Function iDTw(tDate,tNow,sFormat,dSplitter,tSplitter,dtSeparator,Control)     
            Dim nS, strHNS, arHNS, iHNS, valHNS'Update 20090223 0135     
         
            If TypeName(tDate) = "Error" Then     
                tDate = Date()     
            End If     
            If TypeName(tNow) = "Error" Then     
                tNow = Now()     
            End If     
            If TypeName(dSplitter) = "Error" Then     
                dSplitter = "/"     
            End If     
            If TypeName(tSplitter) = "Error" Then     
                tSplitter = ":"     
            End If     
            If TypeName(Control) = "Error" Then     
                Control = 0     
            End If     
            If TypeName(dtSeparator) = "Error" Then     
                If Control = 1 Then     
                    dtSeparator = "*"     
                Else     
                    dtSeparator = " "     
                End If     
            End If     
         
            strS = Split(CStr(FormatDateTime(tNow,3)),":")(2)   'Update 20090223 0951     
            strHN = FormatDateTime(tNow,4)                      'Update 20090223 1428     
            strHNS = FormatDateTime(tNow,4) & tSplitter & strS  'Update 20090223 0951     
         
            If TypeName(sFormat) = "Error" Then     
                sFormat = "YMD" & dtSeparator & "HNS"     
            End If     
         
            If dSplitter = "/" Then     
            Else     
                tDate = Replace(tDate,"/",dSplitter)     
            End If     
            If tSplitter = ":" Then     
            Else     
                strHNS = Replace(strHNS,":",tSplitter)     
            End If     
         
            sFormat = Replace(sFormat,"YMD",tDate)     
            sFormat = Replace(sFormat,"HNS",strHNS)     
            sFormat = Replace(sFormat,"HN",strHN)     
            sFormat = Replace(sFormat,"S",strS)     
         
            If TypeName(sFormat) = "Error" Then     
            Else     
                wExist = Instr(1,sFormat,"W",1)     
            If wExist = 0 Then     
            Else     
                sFormat = Replace(sFormat,"W",strWeekday)     
            End If     
            End If     
            If Control = 0 Then     
                iDTw = sFormat     
            Else     
                iDTw = Split(sFormat,dtSeparator)     
            End If     
        End Function     
         
         
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'lArray - 文字列を１文字ずつバラし、配列として返す     
        '- Created by LazwardFox -     
         
            ' Release 20090228 1246     
         
            ' lArray(     
            '         strLetters  － 分解したい文字列     
            '        ,rArray  － 戻り値が代入されます。任意の変数名を指定      
            '        )     
         
        Function lArray(strLetters, rArray)     
            Dim Pc, rLetters()     
            Set objADO = CreateObject("ADODB.Stream")     
            With objADO     
                .Type = 2     
                .Open     
                .WriteText strLetters     
                Pc = 0     
                .Position = 0     
                Do Until .EOS     
                    ReDim Preserve rLetters(Pc)     
                    rLetters(Pc) = .ReadText(1)     
                    Pc = Pc + 1     
                Loop     
            End With     
            rArray = rLetters     
            objADO.Close     
            Set objADO = Nothing     
        End Function     
         
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'inArrays - 多次元配列構築     
        '- Created by LazwardFox -     
             
            '配列 及び 文字列から、区切り文字を指定して多重配列を作成し返す。     
         
            ' inArrays(     
            '           tSources  － 区切り文字を含む文字列 ないし、それらで構成された配列     
            '          ,strLimitters  － 区切り文字を順番に並べた文字列を指定     
            '          ,arReturn  － 戻り値が代入されます。     
            '          )     
         
            ' Update 20090228 1248 strLimitters指定に、区切り文字 ~(チルダ)不要に。     
            ' Update 20090228 0833 配列のほか、文字列もソースに適用可能に。     
            ' Update 20090223 0917     
                 
        Function inArrays(tSources, strLimitters, arReturn)     
            Dim arSources, arLimitters, iLimitter, arInArrays, iSource, Pc     
            arSources = tSources     
            lArray strLimitters, arLimitters '＜ Update 20090228 1248     
            For Each iLimitter In arLimitters     
                If VarType(arSources) = 8 Then     
                    arInArrays = Split(arSources,iLimitter)     
                Else     
                    Pc = 0     
                    ReDim arInArrays(0)     
                    For Each iSource in arSources     
                        ReDim Preserve arInArrays(Pc)     
                        arInArrays(Pc) = Split(iSource,iLimitter)     
                        Pc = Pc + 1     
                    Next     
                End If     
                arSources = arInArrays     
                arInArrays = Null     
            Next     
            arReturn = arSources     
        End Function     


更に自由度の高い書式指定機能付スクリプトを作成するので、この分も要らなくなったりするww

似たようなものばかりでアレなんだケド、色んなデータへのアプローチの仕方があるというコトで、
なにかしら参考になっていればいいなぁ･･･(´ﾍ｀；)＜そのまま使える スクリプト 年月日 曜日 時分秒 文字列 配列変数 取得 Format Text FormatDateTime＞

VBScriptで多次元配列そにょ２･･･


外部関数追加で、スプリット文字列に区切り文字 ~(チルダ)を不要にしてみた。
あと、バラバラに列挙してたスクリプトを、ファイルのままに張ってみたw
ただ、Tabが全部ツブれてしまうんだよね･･･


以下を、空のテキストファイルにコピペして、任意の名前に、拡張子.vbsをつければ動作します。

    '***** ↓↓↓ScriptTitle↓↓↓ *********************************************************     
        'lArray & inArrays     
        '- Created by LazwardFox -     
             
        ' スクリプトライブラリの一部     
             
        ' Release 20090228 1330     
         
    '***** ↓↓↓ Decralations ↓↓↓ ******************************************************     
        Const strWeekdays = "1:月:MON:Mon:Monday,2:火:TUE:Tue:Tuesday,3:水:WED:Wed:Wednesday,4:木:THU:Thu:Thursday,5:金:FRI:Fri:Friday,6:土:SAT:Sat:Saturday,7:日:SUN:Sun:Sunday"     
        Dim arWeekday, sD     
         
    '***** ↓↓↓Main(Test)Routine↓↓↓ ***************************************************     
        arWeekday = Split(strWeekdays,",")     
        inArrays arWeekday, ":", sD     
        msgbox sD(2)(3),,"Test"     
         
        inArrays strWeekdays, ",:", sD     
        msgbox sD(2)(3),,"Test"     
         
    '***** ↓↓↓Functions↓↓↓ ***********************************************************     
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'lArray - 文字列を１文字ずつバラし、配列として返す     
        '- Created by LazwardFox -     
         
            ' Release 20090228 1246     
         
            ' lArray(     
            '        strLetters  － 分解したい文字列     
            '       ,rArray  － 戻り値が代入されます。任意の変数名を指定      
            '       )     
         
        Function lArray(strLetters, rArray)     
            Dim Pc, rLetters()     
            Set objADO = CreateObject("ADODB.Stream")     
            With objADO     
                .Type = 2     
                .Open     
                .WriteText strLetters     
                Pc = 0     
                .Position = 0     
                Do Until .EOS     
                    ReDim Preserve rLetters(Pc)     
                    rLetters(Pc) = .ReadText(1)     
                    Pc = Pc + 1     
                Loop     
            End With     
            rArray = rLetters     
            objADO.Close     
            Set objADO = Nothing     
        End Function     
         
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'inArrays - 多次元配列構築     
        '- Created by LazwardFox -     
         
            '配列 及び 文字列から、区切り文字を指定して多重配列を作成し返す。     
         
            ' Update 20090228 1248 strLimitters指定に、区切り文字 ~(チルダ)不要に。     
            ' Update 20090228 0833 配列のほか、文字列もソースに適用可能に。     
            ' Update 20090223 0917     
         
            'inArrays(     
            '         tSources  － 区切り文字を含む文字列 ないし、それらで構成された配列     
            '        ,strLimitters  － 区切り文字を順番に並べた文字列を指定     
            '        ,arReturn  － 戻り値が代入されます。     
            '        )     
                 
        Function inArrays(tSources, strLimitters, arReturn)     
            Dim arSources, arLimitters, iLimitter, arInArrays, iSource, Pc     
            arSources = tSources     
            lArray strLimitters, arLimitters '＜ Update 20090228 1248     
            For Each iLimitter In arLimitters     
                If VarType(arSources) = 8 Then     
                    arInArrays = Split(arSources,iLimitter)     
                Else     
                    Pc = 0     
                    ReDim arInArrays(0)     
                    For Each iSource in arSources     
                        ReDim Preserve arInArrays(Pc)     
                        arInArrays(Pc) = Split(iSource,iLimitter)     
                        Pc = Pc + 1     
                    Next     
                End If     
                arSources = arInArrays     
                arInArrays = Null     
            Next     
            arReturn = arSources     
        End Function     


lArrayでは、文字列を文字にバラす際、ADODBオブジェクトに文字列を書き込み、
それを先頭から１文字ずつ読み出して、変数へ配列を追加しつつ、値を代入している。

書式)
   lArray (strLetters, rArray)
        
         strLetters   － 分解したい文字列
         rArray       － 戻り値が代入されます。任意の変数名を指定    


書式)
   inArrays(tSources, strLimitters, arReturn)
  
     tSourcess      - 区切り文字を含む文字列 ないし、それらで構成された配列変数を指定    
     strLimitters   - 区切り文字を、次元の浅さ順に並べた文字列を記述
     arReturn       - 戻り値(配列)が代入されます。任意の変数名を指定
しっかし、VBScriptでドコまでやるつもりなのか･･･ 書いた本人がクビ傾げてるワ･･･(´ﾍ｀；)

VBScriptで多次元配列そにょ１･･･


日付処理の続きを記述する前に、必須スクリプトなど１つ･･･


    '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
    'inArrays - 多次元配列構築     
    '- Created by LazwardFox -     
         
        '配列 及び 文字列から、区切り文字を指定して多次元配列を作成し返す。     
         
        ' LastUpdate 20090228 0833     
         
    Function inArrays(tSources, strLimitters, arReturn)     
        Dim arSources, arLimitters, iLimitter, arInArrays, iSource, Pc     
        arSources = tSources     
        arLimitters = Split(strLimitters,"~")     
        For Each iLimitter In arLimitters     
            If VarType(arSources) = 8 Then     
                arInArrays = Split(arSources,iLimitter)     
            Else      
                Pc = 0     
                ReDim arInArrays(0)     
                For Each iSource in arSources     
                    ReDim Preserve arInArrays(Pc)     
                    arInArrays(Pc) = Split(iSource,iLimitter)     
                    Pc = Pc + 1     
                Next     
            End If     
            arSources = arInArrays     
            arInArrays = Null     
        Next     
        arReturn = arSources     
    End Function     

 
書式)
   inArrays(tSources, strLimitters, arReturn)
  
     tSourcess      - 区切り文字を含む文字列 ないし、それらで構成された配列変数を指定        
     strLimitters   - 区切り文字を、~(チルダ) で 区切って順番に並べた文字列を記述
     arReturn       - 戻り値(配列)が代入されます。任意の変数名を指定


説明面倒っちぃので、実例など･･･
  Const strWeekdays = "1:月:MON:Mon:Monday,2:火:TUE:Tue:Tuesday,3:水:WED:Wed:Wednesday,4:木:THU:Thu:Thursday,5:金:FRI:Fri:Friday,6:土:SAT:Sat:Saturday,7:日:SUN:Sun:Sunday"    
  Dim arWeekday, sD

  '配列を代入
  arWeekday = Split(strWeekdays,",")
  inArrays arWeekday, ":", sD
  msgbox sD(2)(3),,"Test"

  '文字列を代入
  inArrays strWeekdays, ",~:", sD
  msgbox sD(2)(3),,"Test"


上記２つは等価処理なので、結果は同じとなります。▼▼▼ p.s. そにょ２で修正された版です。▼▼▼▼▼▼▼▼▼▼▼▼▼

★上記実行サンプルとの差異
  '文字列を代入
   inArrays strWeekdays, ",~:", sD    
            ▼
   inArrays strWeekdays, ",:", sD


書式)
   inArrays(tSources, strLimitters, arReturn)
  
     tSourcess      - 区切り文字を含む文字列 ないし、それらで構成された配列変数を指定        
     strLimitters   - 区切り文字を、次元の浅さ順に並べた文字列を記述
     arReturn       - 戻り値(配列)が代入されます。任意の変数名を指定


        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
    'inArrays － 多次元配列構築     
    '- Created by LazwardFox -     
         
        '配列 及び 文字列から、区切り文字を指定して多重化された配列、多次元配列を作成し返す。     
         
        ' Update 20090228 1248 strLimitters指定に、区切り文字 ~(チルダ)不要に。     
        ' Update 20090228 0833 外部関数 lArray 追加、配列のほか、文字列もソースに適用可能に。     
        ' Update 20090223 0917     
             
        ' inArrays(     
        '         tSources  － 区切り文字を含む文字列 ないし、それらで構成された配列     
        '        ,strLimitters  － 区切り文字を順番に並べた文字列を指定     
        '        ,arReturn  － 戻り値が代入されます。     
        '        )     
             
        Function inArrays(tSources, strLimitters, arReturn)     
            Dim arSources, arLimitters, iLimitter, arInArrays, iSource, Pc     
            arSources = tSources     
            lArray strLimitters, arLimitters '＜ Update 20090228 1248     
            For Each iLimitter In arLimitters     
                If VarType(arSources) = 8 Then     
                    arInArrays = Split(arSources,iLimitter)     
                Else      
                    Pc = 0     
                    ReDim arInArrays(0)     
                For Each iSource in arSources     
                    ReDim Preserve arInArrays(Pc)     
                    arInArrays(Pc) = Split(iSource,iLimitter)     
                    Pc = Pc + 1     
                Next     
                End If     
                arSources = arInArrays     
                arInArrays = Null     
            Next     
            arReturn = arSources     
        End Function     
             
    '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
    '文字列を１文字ずつバラし、配列として返す     
    '- Created by LazwardFox -     
         
        ' Release 20090228 1246     
         
        ' lArray(     
        '        strLetters  － 分解したい文字列     
        '       ,rArray  － 戻り値が代入されます。任意の変数名を指定      
        '       )     
         
        Function lArray(strLetters, rArray)     
            Dim Pc, rLetters()     
            Set objADO = CreateObject("ADODB.Stream")     
            With objADO     
                .Type = 2     
                .Open     
                .WriteText strLetters     
                Pc = 0     
                .Position = 0     
                Do Until .EOS     
                    ReDim Preserve rLetters(Pc)     
                    rLetters(Pc) = .ReadText(1)     
                    Pc = Pc + 1     
                Loop     
            End With     
            rArray = rLetters     
            objADO.Close     
            Set objADO = Nothing     
        End Function

VBScriptで日付処理そにょ２･･･


更に手抜きで使えるように･･･
って、曜日表示機能付きの別スクリプトを縮小したもの。

    '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
    'iDT - 日時文字列 ないし 日/時配列取得 for VBScript     
    '- Created by LazwardFox -     
         
        'LastUpdate 20090228 0514     
         
        Public Function iDT(dSplitter,dtSeparater,tSplitter,Control)     
            Dim nX, nD, nS, strHMS, sResult     
            If TypeName(dSplitter) = "Error" Then     
                dSplitter = "/"     
            End If     
            If TypeName(dtSeparator) = "Empty" Then     
                dtSeparater = " "     
            End If     
            If TypeName(tSplitter) = "Error" Then     
                tSplitter = ":"     
            End If     
            If TypeName(Control) = "Error" Then     
                Control = 0     
            End If     
            nX = Now()     
            nD = FormatDateTime(Date(),0)     
            nS = ":" & Split(CStr(FormatDateTime(nX,3)),":")(2)     
            strHMS = FormatDateTime(nX,4) & nS     
            If tSplitter = ":" Then     
            Else     
                strHMS = Replace(strHMS,":",tSplitter)     
            End If     
            If dSplitter = "/" Then     
            Else     
                nD = Replace(nD,"/",dSplitter)     
            End If     
            sResult = nD & "*" & strHMS     
            If Control = 0 Then     
                iDT = Replace(sResult,"*",dtSeparater)      
            Else     
                iDT = Split(sResult,"*")     
            End If     
        End Function     


書式)
   iDT ({dSplitter}, {dtSeparater}, {tSplitter}, Control)    
  
       {dSplitter}   - DateSplitString           (Default - "/")    
       {dtSeparater} - Date/Time SepaleteString  (Default - " ")
       {tSplitter}   - TimeSplitString           (Default - ":")
       Control       - String or Array (0 or 1)  (Default - 0 )

  
        スクリプト中に On Error Resume Next を宣言してあれば、全パラメータ省略可

   実行a) test = iDT()    


        そうでない場合、カンマとControl指定 必須

   実行a) test = iDT(,,,0)    
   結果a) test = yyyy/mm/dd HH:nn:ss    


   実行b)   test = iDT(,,,1)       
   等価)   test = iDT("/",,":",1)    

   結果b)   test(0) = yyyy/mm/dd 
            test(1) = HH:nn:ss

   実行c)   test = iDT("",,"",1)    
   結果c)   test(0) = yyyymmdd 
            test(1) = HHnnss

   実行d)   test = iDT("",,"",0)    
   結果d)   test = yyyymmdd HHnnss

   実行e)   test = iDT("","","",0)    
   結果e)   test = yyyymmddHHnnss

         オマケw
   実行f)   test = iDT("*",,"*",1)    
   結果f)   test(0) = yyyy
            test(1) = mm
            test(2) = dd
            test(3) = HH
            test(4) = nn
            test(5) = ss

                  
             結果の内容自体は、いずれも文字列参考までに･･･

VBScriptで日付処理そにょ１･･･


Excelのシート上なら Text関数、VBA (VisualBasic for Application) なら Format関数、
VisualBasicシリーズなら･･･って、列挙するまでも無く、既存関数で可能な、全く必要のない処理なのだが、
VBScriptでは、ハナシが違ってくる。

そもそも、VBS(WSH WindowsScriptingHost 現WindowsScriptHost)は、古来w 
日付処理すら内部に持たない動作環境だった･･･
わざわざ、Windowsのプロセスをオブジェクトとして呼び出して、ソコから取得していた時代がww

それが、あれよ×2 と拡張され、簡単に呼び出せるようになったまでは良かったのだが、
完全な書式指定処理は内包せず、システムの設定依存となってしまった･･･
ちょっと処理すれば、桁揃え程度は誰でも出来る記述だったが、イマイチ汎用性に欠いてしまう･･･

いろんなサイトで同様の処理が列挙されているモノの、
中々、関数として そのまま使え(流用でき)るのが みつからない･･･
ソコで、自分で書いてみた。

    '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
    'iDT - 日時文字列 ないし 日/時配列取得 for VBScript     
    '- Created by LazwardFox -     
         
        'LastUpdate 20090228 0458     
         
        Public Function iDT(dSplitter,dtSeparater,tSplitter,Control)     
            Dim nX, nD, nS, strHNS, sResult     
            nX = Now()     
            nD = FormatDateTime(Date(),0)     
            nS = ":" & Split(CStr(FormatDateTime(nX,3)),":")(2)     
            strHNS = FormatDateTime(nX,4) & nS     
            If tSplitter = ":" Then     
            Else     
                strHNS = Replace(strHNS,":",tSplitter)     
            End If     
                sResult = Cstr(Replace(nD,"/",dSplitter)) & "*" & strHNS     
            If Control = 0 Then     
                iDT = Replace(sResult,"*",dtSeparater)      
            Else     
                iDT = Split(sResult,"*")     
            End If     
        End Function     


日時値指定ナシで、今の日時文字列を、欲しいカタチで得たいだけなら、コレで充分

書式)
   iDT (dSplitter,dtSeparater,tSplitter,Control)
  
          dSplitter   - DateSplitString           (Normal - "/")    
          dtSeparater - Date/Time SepaleteString  (Normal - " ")
          tSplitter   - TimeSplitString           (Normal - ":")
          Control     - String or Array           (0 or 1)

   実行a)
           test = iDT("/"," ",":",1)    
                  
   結果a)
           test(0) = yyyy/mm/dd 
           test(1) = HH:nn:ss

   実行b)
           test = iDT(""," ","",0)    
   結果b)
           test = yyyymmdd HHnnss

   結果の内容自体は、いずれも文字列

･･･パラメータ無指定によるエラーを、回避する構造にはしていないので注意が必要。
無意味に複雑に感じる向きも少なくないと思うが、スクリプトの短さと共に、
他のvbsファイル作成の際にも流用し易いコトに重点を置いている。
また、Windowsの日付設定[地域のプロパティ]が、インストール既定値であることを前提としている。

コレがVBなら容易に既定値を設定できて楽なのだが、VBSだと型宣言すら思い通りにならんのがクチ惜しい･･･
でもまぁコレなら、それなりに、そのまま流用できると思う。

日付／時刻を繋がった文字列として取得したり、それぞれ分けて、配列として取り出すことで、
呼び出した主処理上で、使い分けが利くようになっている。
また、日付時刻関数 FormatDateTime の癖を利用しているのも特徴だ。

肝心の処理だが、主たるは、▼コレ。
   FormatDateTime(Date[,NamedFormat])    


まず、コイツに、日付のみ(Date関数)を投入することで、確実に日付文字列を確保する。
   nD = FormatDateTime(Date(),0)    

NamedFormatパラメータ 0 (ないし、省略 vbGeneralDate)で、yyyy/mm/dd形式の文字列を得られる。
うっかりココで Now関数とか入れちゃうと、yyyy/mm/dd H/n/ssが返ってきてしまい、
時/分 の部分だけ、桁が可変で使えない。･･･何故かシステム既定だと H/n になってるのだ。
(このクセさえなければ、そのまま使えて便利なのだが･･･)
しかし、システム設定には触れずに処理させたい!

ってワケで、次に、秒のみを取得する。 FormatDateTime のパラメータに 3 (vbLongTime) を指定すると、
   実行) FormatDateTime(Now(),3)    
   結果) H:n:ss
と、既定で秒だけ桁が揃えられて出力されてくるのを利用している。･･･なんでだろ～？ww
Windowsのシステム既定値って･･･(´ﾍ｀；)

実スクリプトでは、戻り値をコロンで Split(配列化)し、配列番号{(2)}指定で秒の部分のみを取り出している。
ソレをアトでくっつけるので、コロンを事前に付けてあったりする。
   nS = ":" & Split(CStr(FormatDateTime(nX,3)),":")(2)    

更に、時分･･･ FormatDateTime のパラメータを 4 (vbShortTime) を指定、
   実行) FormatDateTime(Now(),4)    
   結果) HH:nn

と、桁の揃った時分が返ってくる、ソレに秒の文字列をくっつけて時分秒文字列は完成。
   strHMS = FormatDateTime(nX,4) & nS    


･･･ぶっちゃけ、こう▼書いても同じなんだけどねwww
   strHMS = FormatDateTime(nX,4) & ":" & Split(CStr(FormatDateTime(nX,3)),":")(2)    

あとは、日付文字列とを、どう返すか等を処理しているだけ。
セパレータの指定は、日付処理を色んなカタチで用いるコトの多い方なら、重要さが判ると思う。

ファイル名構築であったり、フォルダ名だったり、はたまたWebのURLだったり、
テキストファイル内への書き込みだったり、etc etc･･･ セパレータは用途によって随分と異なるようでw
主処理で、Replaceカマせばイイだけなんだけど、どうせなら取得時点で完了していたほうが･･･と
手抜き根性がココまでさせたというオチも付き、オアトがヨロしいようで･･･＜FormatDateTime ヘンなクセ＞

2009/02/17

必要に迫られる・・・


何故かJavaScriptで遊んでいたりw

自鯖のDDNS接続の更新確認をケータイから行えるよう、専用ページを配置しているのだが、
ソコに、ケータイブラウザでも走るデモとして、時計でも置いてやろうか と云うのが始まりだった。

･･･元々VBscript遣いだが、アレがケータイで走るとは、到底思えん(´ﾍ｀；)
似たような処理は結構多用するし、諦めてJSに手を付けることになったワケで･･･

で、２日ほど色々試行して、JSの身の振りようをあらかた把握したところw
ソコは上記の通りVBS遣い、JSなんて必要ない と思っていたのだが、使うと中々どうして、
こりゃ便利 ってカンジw

ただ、一長一短ではあるようで、JSで、繰り返しや複雑すぎる分岐、
量のある文字列処理などを行うものを、不用意にHTMLに組み込むと･･･ 実動で不得手なのは見て取れた(^_^;
一瞬、ウチの骨董端末がヤバいのかと思った(爆)が、参考にしていた数々のサイトでも
同様の評価が出てた･･･ (ひと安心)

また、当方では よく多用する、時間関連処理でも、
同じ結果を1/1000secレベルまで精度を上げて出そうとすると、かなり重くなって、
実用に耐えなくなってしまった･･･ のて端末のloliちゃんだと停まるコトもw 
･･･何故かケータイだと、それなりに走るのだがww
単純分岐処理のモノだと、精度は落ちるが、のて機でも問題なく動く･･･
JSを使うなら、余程必要ない限り、複雑な構造にしないほうが無難なようだ。

VBSなら、文字列処理や 異常なくらい複雑な分岐を構成しても、
速度に不満は感じたコトは無かったが、環境依存度が高いし、
HTMLへの応用だと、出力方法が なんか回りクドいし･･･
まぁ、クライアントの環境に左右されるってだけでも考え物だけどね。

とは云え、便利なのを知ってしまったからにはアトには戻れないのが人情ってﾔｼで、
そうなると、WSHで、VBS/JS混在記述と云うのも、アリなのではと思いはじめてたりw


･･･IEを非標準扱いしてるﾔｼのコメとは思えんな･･･(-_-;)

2009/02/14

プロバイダ乗り換える･･･


ついさっきまでは、USEN GyaO with フレッツ光 (NTT西) を 使っていた。

今は、INTERLINK の ZOOT ･･･ココは随分昔、ADSL時代に利用していたコトがあったのだが、
すっかり存在忘れてたww

直前まで利用していたUSEN GyaOは、基本 鯖立×と云うのも知っていたが、関東在住の折、
旧BroadGate01時代に マンションLANタイプで鯖利用していて、回線品質の高さなどを知っていたのもあり、
盲目的に選択してしまった。しかし、OSの関係で充実を謳うコンテンツも全く閲覧も出来ないし、
直接接続だった関東圏のサービスと違いNTT介在、IPも1つしか割り当てられない上 非固定、
4K円以上の月額も年間では大きいし、その割りに大して利点がないので切るコトにした。

プロバイダのスタンスとして、鯖立×と云う時点でも充分考えモノ。
どローカルのプロバイダ(BBIQとJCOM)も、御同様かソレよりタチが悪かったので却下した経緯がある。
そもそも、用途によって明確だったワケだ、コンシューマ向けプロバイダは、高度運用には全く向かないと･･･

ソレを踏まえ、低価格のプロバイダを探すにあたり、INTERLINKを思い出し、サービスをサイトで確認してみる･･･ 
相変わらずの機能充実･･･ しかも以前より拡張されてるし･･･ しかも月額 GyaOの半額以下･･･ 驚くしかない。
フレッツ同時導入ならキャッシュバックは他のプロバイダと同様で、契約期間の縛りもない。
初期費用もなしで、2ヶ月全機能試用可で、その間の解約違約金もナシ、機能充実で、月額半額･･･
去年、ココを思い出していたら、キャッシュバックがあったとはいえ、USENと云うチョイスはしなかったと思う･･･ 
結局、思い込みと、価格比較サイトに振り回されたと云うコトだろう。

INTERLINKのサービスを一通り確認し終えて、早速、
月額2100円の固定IP１つのサービスに加入し、2ヶ月間の試用に入った。
週明けまでに動作確認を行い、問題が無いようなら、このままココに決めることになるだろう。
･･･固定IPなんだし、DynamicDNSである必要性はない。 折角だから、ドメインも確保しようかな･･･

メイン使用機の SHARP Mebius PC-GP1-C1Mのディスプレイアダプタ(s3 TwistarK)のドライバを更新してみた。

昔からあのメーカーはアテにならなかったので、2001年にs3から発行されたドライバを使い続けていたのだが、
コレがDirectX9cに対応していなかった。

たまたま別件をググるさんで探してたら、昔使っていた便利なアプリケーションを見つけてしまい、
急遽使用することにしたのだが、dX9c必須と云う･･･已む無く対応ドライバがナイかとググるさんで捜す。
当然のようにコトも無げにみつかり、それまで更新を放置していたドライバと差し替えた。

が、更新直後、[画面のプロパティ][設定]タブが困ったコトに･･･

元々同一機器で、SXGAで使っていたのにも関わらず、XGA以上の画面解像度が選択できなくなってしまった･･･
諦めてドライバをロールバックしようと思い、最終確認としてディスプレイアダプタのプロパティを見ていたら、
何故か、[モニタ]タブの [このモニタでは表示できないモードを隠す]のチェックが勝手に入ってるコトに気がついた･･･
コレをハズして、[設定]タブの内容がUXGAまで設定可能に戻り、コト無きを得た。

使いたかったアプリケーションも動作するようになり、なんとも(^_^)

2009/02/13

でっかい･･･


･･･ゴミです。

それは、月を撮った日のコト。


最初のショットはナンとも無くて･･･
012815
撮影日: 2009/02/08 21:51:20
露出モード: M-マニュアル露出
露出補正: 0 (AB 0 of 0)
ISO感度: 50
ホワイトバランス: オート
色モード: 通常
フラッシュ: 非発光
シャッター速度: 1/30秒
絞り値: F11
測光モード: 評価測光
フォーカスモード: M－マニュアル
焦点距離: 0 mm
記録画素数:  HI
ドライブモード: ミラーアップ






そのまま暫く撮ってたら･･･



･･･はひ？
012816
撮影日: 2009/02/08 21:51:27
露出モード: M-マニュアル露出
露出補正: 0 (AB 0 of 0)
ISO感度: 50
ホワイトバランス: オート
色モード: 通常
フラッシュ: 非発光
シャッター速度: 1/30秒
絞り値: F11
測光モード: 評価測光
フォーカスモード: M－マニュアル
焦点距離: 0 mm
記録画素数:  HI
ドライブモード: ミラーアップ





でも、ファインダ覗いても何もないんです;



何度撮ってもこんなカンジで･･･
012817
撮影日: 2009/02/08 21:51:45
露出モード: M-マニュアル露出
露出補正: 0 (AB 0 of 0)
ISO感度: 50
ホワイトバランス: オート
色モード: 通常
フラッシュ: 非発光
シャッター速度: 1/30秒
絞り値: F11
測光モード: 評価測光
フォーカスモード: M－マニュアル
焦点距離: 0 mm
記録画素数:  HI
ドライブモード: ミラーアップ





仕方がないのでピンはずして、街灯をﾊﾟｼｬﾘ･･･ 



あ゛やっぱり･･･
012823
撮影日: 2009/02/08 21:55:52
露出モード: M-マニュアル露出
露出補正: 0 (AB 0 of 0)
ISO感度: 50
ホワイトバランス: オート
色モード: 通常
フラッシュ: 非発光
シャッター速度: 1/160秒
絞り値: F5
測光モード: 評価測光
フォーカスモード: M－マニュアル
焦点距離: 0 mm
記録画素数:  HI
ドライブモード: １コマ撮影





おもいっきり載ってます･･･ FoveonX3の上に(´ﾍ｀；)
取り敢えず簡単なクリーニングで･･･



コト無きを得ました･･･
012844
撮影日: 2009/02/08 22:11:57
露出モード: M-マニュアル露出
露出補正: 0 (AB 0 of 0)
ISO感度: 50
ホワイトバランス: オート
色モード: 通常
フラッシュ: 非発光
シャッター速度: 1/100秒
絞り値: F5
測光モード: 評価測光
フォーカスモード: M－マニュアル
焦点距離: 0 mm
記録画素数:  HI
ドライブモード: １コマ撮影





けど、ちょっと気になったので後日、室内でピンをハズして、確認の撮影を･･･




おお～･･･
012881
撮影日: 2009/02/09 15:51:31
露出モード: M-マニュアル露出
露出補正: 0 (AB 0 of 0)
ISO感度: 50
ホワイトバランス: オート
色モード: 通常
フラッシュ: 非発光
シャッター速度: 1.0秒
絞り値: F5.6
測光モード: 評価測光
フォーカスモード: M－マニュアル
焦点距離: 70 mm (17-70)
記録画素数:  HI
ドライブモード: １コマ撮影

ブロアで吹いただけだったんですケド、ものすごく綺麗になっていたので驚いてしまいました^_^;

2009/02/12

ふるむ～ん・・・


･･･撮り損ねる、当日に天候がスグれなくて･･･
天気予報もあったので、前日にフライング撮影できたのは幸いだったが、大して意味はない(爆)


とりあえず･･･
012802
撮影日: 2009/02/08 19:06:10
露出モード: M-マニュアル露出
露出補正: 0 (AB 0 of 0)
ISO感度: 50
ホワイトバランス: オート
色モード: 通常
フラッシュ: 非発光
シャッター速度: 1/80秒
絞り値: F5.6
測光モード: 評価測光
フォーカスモード: M－マニュアル
焦点距離: 300 mm (70-300)
記録画素数:  HI
ドライブモード: ミラーアップ




別レンズで寄り･･･
012846
撮影日: 2009/02/08 22:12:39
露出モード: M-マニュアル露出
露出補正: 0 (AB 0 of 0)
ISO感度: 50
ホワイトバランス: オート
色モード: 通常
フラッシュ: 非発光
シャッター速度: 1/100秒
絞り値: F5
測光モード: 評価測光
フォーカスモード: M－マニュアル
点距離: 35mm換算 1190mm相当
記録画素数: HI
ドライブモード: １コマ撮影
Lens : TAMRON 70-350mm F4.5-22
(ADAPTALL Series - ManualFocus)
+ KENKO APK.TELEPLUS MC7 改
(350mm×2×1.7)

･･･しかし、またもディレイうpw

登録: 投稿 (Atom)