2014/08/22

GUID作成･･･ 

･･･のスクリプトを汎用化してみた。





とりまインストーラを･･･　　
getGUID_installer.exe
　　ソースは続きに。





元々はクリップボード取得な動作させてたモノを書き換え、環境依存しない様にした物nanoで かなり雑多になってます(^_^;)



'***** ↓↓↓ScriptTitle↓↓↓ ********************************************************* 
   ' GUID Creator 
   ' - Created by LazwardFox - 

   ' with TypeLib 

   ' Update 20140822 180924 - ユーザーフォルダのDocumentフォルダを使用する形式に。 
   ' Update 20130607 145801 - 出力数指定とテキストファイル保存タイプへ変更。 
   ' Release 20120902 120141 

   ' βRelease 20120902 115320 
   ' DevStart 20120902 112212 


'***** ↓↓↓ ObjectDecralations ↓↓↓ ************************************************* 
    Option Explicit
    Public My, MySh, Fs, objBoard, objTLib
    Public Parameters
    Set My = WScript
    With My
        Set Parameters = .Arguments ' パラメーター取得 
        Set Fs = .CreateObject("Scripting.FileSystemObject") ' ファイル操作 
        Set MySh = .CreateObject("WScript.Shell")
        Set objTLib = .CreateObject("Scriptlet.TypeLib")
        If IsEmpty(objTLib) Then
            exQuit
        End If
       'Set objBoard = .CreateObject("Forms.Form.1") 
       'If IsEmpty(objBoard) Then 
       '    My.Quit 
       'End If 
    End With


'***** ↓↓↓ GlobalDecralations ↓↓↓ ************************************************* 

   '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 
   ' スクリプトの実行環境を取得。 
    
       ' Update 20120914 030508 - Function から DecralationSet へ 移行。 
       ' Release 20120913 051307 
       ' DevStart 20120913 031859 

    Public MyNameFull, MyName, MyDoc, MyRoot 'ThisScript 
    MyNameFull = My.ScriptFullName
    MyName = Fs.GetBaseName(MyNameFull)

    sfSet ' 20140822 175431 
    MyDoc = Fs.BuildPath(UserProf, "Documents")
    MyRoot = "TextFiles\GUID\"
    MyRoot = LocSet(MyDoc, MyRoot)

   '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 

   'If Parameters.Count <= 0 Then ' パラメータなし起動では、このスクリプトが含まれるフォルダ内を一覧化する。 
   '    Parameters = Array(MyRoot) 
   'End If 

    Public vbTc, vbCt, vbWt, vbWq, vbTs, vbCs

    vbWq = """"
    vbTc = vbTab & vbCrlf
    vbCt = vbCrlf & vbTab
    vbWt = vbWq & vbTab
    vbTs = String(2,vbTab)
    vbCs = String(2,vbCrLf)


'***** ↓↓↓ exFunctionDecralations ↓↓↓ ************************************************* 



'***** ↓↓↓ Decralations ↓↓↓ ************************************************* 
    
    Dim sPc, Pc, arGUID(), strGUID
    Dim sDt, tTe, tFolder, eFolders, sLog, arResult, rFile, strFile


'***** ↓↓↓MainRoutine↓↓↓ ********************************************************* 
   'On Error Resume Next 

   'If MySh.Popup(vbCrLf & "　　　" & strGUID & vbCs & vbCt & "[OK]をクリックすると、クリップボードへ格納します。" , 10,"getGUID", 65) = 1 Then 
   '    getClip(strGUID) 
   'End If 

    iDT ,"","_","", 0, sDt ' 開始時刻文字列取得 "日付_時刻" 
    
    If Parameters.Count >= 2 Then
        sPc = Parameters(0) ' 数値がどうかのチェックが別途必要。 
        strFile = Parameters(1) ' フルパスファイル名として有効か(ry 
    Else
        sPc = InputBox("GetCount?", MyName, 1) ' パラメータなし起動では、出力数入力待機へ 
        If sPc = "" Then
            exQuit
        End If
        strFile = Fs.BuildPath(MyRoot,"gettedGUID_[" & sPc & "]_" & sDT & ".txt")
    End If

    TextViewer tTe ' 既定のテキストエディタのファイルパスをレジストリから取得。 

    For Pc = 0 to sPc - 1 ' 指定数のGUIDを配列変数に代入する。 
        Redim Preserve arGUID(Pc)
        arGUID(Pc) = getGUID()
    Next

    Set rFile = Fs.CreateTextFile(strFile,0) ' Resultファイルを追記モードで開く。 
    My.Sleep 300

    For Each strGUID In arGUID
        rFile.WriteLine strGUID
        My.Sleep 200
    Next

    rFile.Close ' Resultファイルを閉じる 

    If tTe = "NotSetting" Then
        MySh.Popup eFolders & vbCr & "リスト出力を完了しました。" , 10, MyName, 64
    Else
        Dim tgtExec
        tgtExec =  tTe & vbWq & strFile & vbWq
        MySh.Run tgtExec, 1 ' 対象ファイルを開く。 
    End If

    exQuit


'***** ↓↓↓Functions↓↓↓ ********************************************************* 


   '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 
   ' sfSet - SysFolderSet 
   ' システム／ユーザーフォルダ情報一括取得。 

   ' Update 
   ' Release 20140822 180817 
   ' βRelease 
   ' αRelease 20140822 180507 
   ' DevStart 20140822 174941 関数化 

    Public Win, System, UserProf, Roamings

    Function sfSet()
        With MySh
            Win = .ExpandEnvironmentStrings("%systemroot%")
            System = Fs.BuildPath(win,"System32")
            UserProf = .ExpandEnvironmentStrings("%UserProfile%")
            Roamings = .ExpandEnvironmentStrings("%AppData%")
        End With
    End Function


   '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 
   ' LocSet - LocationSet 
   ' 使用フォルダの既存確認／新設、フォルダフルパスを文字列で返す。 

   ' Update 
   ' Release 20140822 180817 
   ' βRelease 
   ' αRelease 20140822 180507 
   ' DevStart 20140822 173139 関数化 

    Function LocSet(strRoot, strFolders)
        Dim strFolder, arTgtFolder, tgtFolder
        tgtFolder = strRoot
        With Fs
            arTgtFolder = Split(strFolders, "\")
            For Each strFolder In arTgtFolder
                tgtFolder = .BuildPath(tgtFolder, strFolder)
                If tgtFolder = "" Then
                Else
                    If .FolderExists(tgtFolder) Then
                    Else
                        .CreateFolder tgtFolder
                    End If
                End If
            Next
        End With
        If Right(tgtFolder, 1) = "\" Then
            LocSet = tgtFolder
        Else
            LocSet = tgtFolder & "\"
        End If
    End Function

   '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 
   ' exQuit 
   ' 

   ' Update 
   ' βRelease 
   ' αRelease 20100110 1303 
   '                          
   ' DevStart 20110110 0549 関数化 

    Sub exQuit()
        Set Parameters = Nothing
        Set objTLib = Nothing
       'Set objBoard = Nothing 
        Set Fs = Nothing
        Set MySh = Nothing
        My.Quit
    End Sub

   '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 
   ' TextViwer - テキストファイルを開く既定アプリケーションをフルパスで返します。 
   ' - Created by LazwardFox - 
    
       ' Update 20120913 043122 
       ' Release 20090315 205300 
       ' DevStart 20090315 093800 
        
    Function TextViewer(ResultKey)
        Dim sTV, arRep
        Const RegKey = "HKCR\txtfile\shell\open\command\"
        sTV = MySh.RegRead(RegKey)
        sTV = Replace(sTV, vbWq, "")
        sTV = Replace(sTV, " %1", "")
        sTV = Replace(LCase(sTV), "%systemroot%", "C:\Windows")
        If Fs.FileExists(sTV) Then
            ResultKey = vbWq & sTv & vbWq & " "
        Else
            ResultKey = "NotSetting"
        End If
    End Function

   '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 
   ' getGUID 
   ' - Created by LazwardFox - 

       ' with objTLib 

       ' βRelease 20120902 115320 
       ' DevStart 20120902 112212 

    Function getGUID()
        Dim setGUID, lenGUID
        setGUID = objTLib.GUID
        lenGUID = Len(setGUID) - 4
        getGUID = Mid(setGUID, 2, lenGUID)
        Set objTLib = Nothing
        My.Sleep 200
        Set objTLib = My.CreateObject("Scriptlet.TypeLib")
    End Function

   '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 
   ' getClip - 代入された文字列をクリップボードに格納する。 
   ' - Created by LazwardFox - 

       ' with objBoard 

       ' ReleaseStop 20130607 145542 - UAC起因で機能しない為、getGUIDでは使用停止 
       ' βRelease 20120902 115320 
       ' DevStart 20120902 112212 

       ' getClip - 
       '                ( 
       '                 strTarget - 文字列値 
       '                ) 

    Function getClip(strTarget)
        Dim objClip
        Set objClip = objBoard.Controls.Add("Forms.TextBox.1").Object
        With objClip
            .MultiLine = True
            .Text = strTarget
            .SelStart = 0
            .SelLength = .TextLength
            .Copy
        End With
        Set objClip = Nothing
    End Function

   ' X3FManeger (fCopy) 
   '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 
   ' iDT - 日時文字列 ないし 日/時配列取得 for VBScript 
   ' - Created by LazwardFox - 
    
       ' VarChk 

       ' Update 20091103 1149 パラメータチェックを完全外部化。 
       ' Update 20091010 1736 文字列／シリアル値による日時指定、 
                           '　及び パラメータ省略に対応。 
       ' Update 20090228 0458 変数宣言変更 
       ' Update 20090223 0959 時刻桁処理変更 
       ' Update 20090223 0253 Len記述忘れ修正 
       ' Update 20090223 0135 変数宣言忘れ修正 
       ' Update 20090210 0218 
       ' Update 20090210 0115 
       ' Release 20090209 2035 

       '    iDT ( 
       '     {tDateTime} - Serial / DateTimeStrings (省略可、既定値 - Now) 
       '    ,{dSplitter} - DateSplitString             (省略可、既定値 - "/") 
       '    ,{dtSeparater} - Date/Time SepaleteString (省略可、既定値 - " ") 
       '    ,{tSplitter} - TimeSplitString             (省略可、既定値 - ":") 
       '    ,{Control} - 戻り値 文字列／配列指定  0 or 1    (省略可、既定値 - 1) 
       '    ,Result - 結果日時文字列    (省略不可) 
       '    ) 

       ' Memo - いずれかのSplitterに ~|" を設定すると、全ての要素が、配列として返されます。 
       ' iDT ,"|",,,,arDT ' → arDT = (0) YYYY / (1) MM / (2) DD / (3) HH / (4) NN / (5) SS 

    Public Function iDT(tDateTime, dSplitter, dtSeparater, tSplitter, Control, Result)
        Dim vDateTime, cDateTime, nD, nS, strYMD, strHNS
        Dim dVal, cVar, arVar
        dVal = Array(Now(),"/"," ",":",1) ' 既定値配列 
        cVar = Array(Array(tDateTime,7,False,dVal(0)),Array(dSplitter,10,True,dVal(1)), _
                Array(dtSeparater,10,True,dVal(2)),Array(tSplitter,10,True,dVal(3)), _
                Array(Control,2,False,dVal(4)))
        arVar = VarChk(cVar)
        tDateTime = arVar(0)
        strYMD = FormatDateTime(DateValue(tDateTime),0)            'Update 20091010 1736 
        nS = ":" & Split(CStr(FormatDateTime(tDateTime,3)),":")(2) 'Update 20090223 0951 
        strHNS =  FormatDateTime(tDateTime,4) & nS                 'Update 20090223 0951 
        If arVar(3) = dVal(3) Then
        Else
            strHNS = Replace(strHNS,dVal(3),arVar(3))
        End If
        If arVar(1) = dVal(1) Then
        Else
            strYMD = Cstr(Replace(strYMD,dVal(1),arVar(1)))
        End If
        If arVar(4) = dVal(4) Then
            Result = Split(strYMD & "|" & strHNS,"|")
        Else
            Result = strYMD & arVar(2) & strHNS
        End If
    End Function


   ' X3FManeger (fCopy) 
   '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 
   ' VarChk 
   ' 変数内データの確認と、既定値への置換をサポート。 
   ' 関数への代入パラメータ確認向け 
   ' - Created by LazwardFox - 

       ' Update 
       ' Release 
       ' βRelease 20091103 1152 
       ' DevStart 20091103 1014 

       ' VarChk - 結果を配列で返す。 
       '        ( 
       '           arVar - 調査対象と条件を配列で代入する。 (省略不可) 
       '        ) 

       ' arVar = Array(Array(Value,VarTypes,Boolean,DefaultData),Array(Value,VarTypes,Boolean,DefaultData),・・・) 
        
       ' Value - 確認対象となる値、ないし変数 
       ' VarTypes - VarType定数 (日時値を得る場合は、基が文字列代入であっても 8 を指定) 
       ' Boolean - 条件の可否 
       ' DefaultData - 代替規定値 (データ型自由) 

    Function VarChk(arVar)
        If VarType(arVar) >= 8192 Then
            ReDim iResult(UBound(arVar))
            Dim Pc, iVar, cVar ,vVar, vDT, cDT
            Pc = 0
            For Each iVar In arVar
                cVar = VarType(iVar) >= 8192 And Ubound(iVar) = 3
                If cVar Then
                    cVar = VarType(iVar(1)) = 2 And VarType(iVar(2)) = 11
                    If cVar Then
                        If iVar(1) = 8 Then
                            vDT = VarType(iVar(0))
                            cDT = vDT <> 10 And (vDT = 7 Or (vDT = 8 And IsDate(iVar(0))))
                            If cDT Then ' シリアル値／日時文字列 識別 
                                iResult(Pc) = DateValue(iVar(0)) + TimeValue(iVar(0))
                            Else
                                iResult(Pc) = iVar(3) ' Now() 
                            End If
                        Else
                            vVar = VarType(iVar(0))
                            If iVar(2) = (vVar = iVar(1)) Then
                                iResult(Pc) = iVar(3)
                            Else
                                iResult(Pc) = iVar(0)
                            End If
                        End If
                    End If
                End If
                Pc = Pc + 1
            Next
        End If
        VarChk = iResult
    End Function
: ■
Labels: , ,

0 件のコメント:

コメントを投稿

注: コメントを投稿できるのは、このブログのメンバーだけです。

登録: コメントの投稿 (Atom)