Translate

2018年3月25日日曜日

App Serviceにフォルダ追加

App ServiceでImageディレクトリ配下に作ったディレクトリがデプロイで作られないようなので…
直接作成

azureにログイン
該当のApp Serviceを選択
App Service Editorを選択
(右画面に 移動→ が出るので選択)


下記画面が開くので該当ディレクトリを選択して右クリックで追加できます

2018年3月23日金曜日

スクリプトを用いたデータの出力

Microsoft SQL Server Management Studioで該当データベースを選択して右クリック

スクリプトの生成 を選択

□説明画面
次へ

□オブジェクトの選択
特定のデータベースオブジェクトを選択
出力対象のテーブルを選択
次へ

□スクリプト作成オプションの設定
詳細設定->スクリプトを作成するデータの種類:データのみ->OK
次へ

□概要
次へ

出力される

2018年2月25日日曜日

Visual Studio ブラウザの追加

ASP.NET開発時に開くブラウザの追加。
Google Chromeのシークレットを追加する。

ブラウザの一覧から、ブラウザーの選択を開く
追加から

プログラム:
C:\Users\[User名]\AppData\Local\Google\Chrome\Application\chrome.exe

引数:
--incognito

名前:
適当につける




以上

2017年12月19日火曜日

DebugModule.bas

Option Explicit
Private Indent          As Integer
Private Prefix          As String
Private FH              As Object
Private FlagNotime          As Boolean
Private FlagDebugPrint  As Boolean

Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Sub DebugPrint(ByVal VarName As Variant, Optional ByVal Filename As String = "Debug.txt", _
               Optional ByVal TypeNameFlag As Boolean = False, Optional ByVal IndentCount As Integer = 4, _
               Optional NotimeFlag As Boolean = False, Optional DebugPrintFlag As Boolean = False)
    '必須:
    'VarName: データ構造を知りたい変数名を指定
    
    'オプション:
    'Indentcount: 配列、コレクション、Dictionaryなどネストして表示されるデータの全角スペースの数
    'TypeNameFlag:全ての型を表示したい時にTrue
    '----------------------------------------------------------------------------------------------
    
    '再帰呼出で、トップの時⇒追記状態でファイルオープンしておく
    If Indent = 0 Then
        FlagNotime = NotimeFlag
        FlagDebugPrint = DebugPrintFlag
        If Not FlagDebugPrint Then Call FileOpen(Filename)
    End If
    
    
    Dim i As Long
    Dim key As Variant
    If TypeName(VarName) = "Byte" Or TypeName(VarName) = "Integer" Or _
       TypeName(VarName) = "Long" Or TypeName(VarName) = "String" Or _
       TypeName(VarName) = "Single" Or TypeName(VarName) = "Double" Or _
       TypeName(VarName) = "Currency" Or TypeName(VarName) = "Date" Or _
       TypeName(VarName) = "Boolean" Or TypeName(VarName) = "Boolean" Then
        
        Call Output(TypeName(VarName), IndentCount, TypeNameFlag, VarName)

    ElseIf TypeName(VarName) = "Empty" Or TypeName(VarName) = "Null" Or _
           TypeName(VarName) = "Nothing" Or TypeName(VarName) = "Unknown" Then
        
        Call Output(TypeName(VarName), IndentCount, TypeNameFlag)
        
    ElseIf 0 < InStr(TypeName(VarName), "()") Then
        '2次元配列まで対応!3次元以上はNG!
        Dim temp As Integer, Dimension As Integer
        On Error Resume Next
        temp = UBound(VarName, 3)
        If Err.Number = 0 Then
            MsgBox "配列は3次元配列以上は未対応です"
            End
        End If
        
        Err.Clear
        temp = UBound(VarName, 2)
        Dimension = IIf(Err.Number = 0, 2, 1)
        On Error GoTo 0
        
        
        Call Output(TypeName(VarName), IndentCount, TypeNameFlag)
        
        '1次元配列か2次元配列かで処理を分岐
        Indent = Indent + 1
        If Dimension = 1 Then
        '1次元配列の処理
            For i = 0 To UBound(VarName)
                Prefix = "(" & i & "): "
                Call DebugPrint(VarName(i), IndentCount, TypeNameFlag)
            Next
            
        ElseIf Dimension = 2 Then
        '2次元配列の処理
            Dim ii As Long
            For i = 0 To UBound(VarName, 1)
                For ii = 0 To UBound(VarName, 2)
                    Prefix = "(" & i & "," & ii & "): "
                    Call DebugPrint(VarName(i, ii), IndentCount, TypeNameFlag)
                Next
            Next
        End If
        Indent = Indent - 1
    ElseIf TypeName(VarName) = "Collection" Then

        Call Output(TypeName(VarName), IndentCount, TypeNameFlag)
        
        Indent = Indent + 1
        For i = 1 To VarName.Count
            Prefix = i & ":"
            Call DebugPrint(VarName.Item(i), IndentCount, TypeNameFlag)
        Next
        Indent = Indent - 1
    
    ElseIf TypeName(VarName) = "Dictionary" Then

        Call Output(TypeName(VarName), IndentCount, TypeNameFlag)
        
        Indent = Indent + 1
        For Each key In VarName
            Prefix = "[" & TypeName(key) & "]" & key & " => "
            Call DebugPrint(VarName.Item(key), IndentCount, TypeNameFlag)
        Next
        Indent = Indent - 1
        
    End If
     
    '再帰呼出で、トップの時⇒追記状態でファイルオープンしておく
    If Indent = 0 And Not FlagDebugPrint Then Call FileClose
End Sub

Sub Output(ByVal TypeVarName As String, ByVal IndentCount As Integer, ByVal TypeNameFlag As Boolean, Optional ByVal VarName As Variant = "")
    If IndentCount < 0 Then IndentCount = 0
    
    Dim OutPutData As String
    If TypeNameFlag Then
        OutPutData = String(Indent * IndentCount, " ") & Prefix & "[" & TypeVarName & "]" & VarName & vbCrLf
            
        If FlagDebugPrint Then
            Debug.Print Replace(OutPutData, vbCrLf, "") '改行ははずす
        Else
            FH.Write OutPutData
        End If
    Else
        If 0 < InStrRev(Prefix, "]") Then
            Prefix = Right(Prefix, Len(Prefix) - InStrRev(Prefix, "]"))
        End If
        
        If 0 < InStr(TypeVarName, "()") Or TypeVarName = "Collection" Or TypeVarName = "Dictionary" Then
            OutPutData = String(Indent * IndentCount, " ") & Prefix & "[" & TypeVarName & "]" & VarName & vbCrLf
            
            If FlagDebugPrint Then
                Debug.Print Replace(OutPutData, vbCrLf, "") '改行ははずす
            Else
                FH.Write OutPutData
            End If
        Else
            OutPutData = String(Indent * IndentCount, " ") & Prefix & VarName & vbCrLf
            
            If FlagDebugPrint Then
                Debug.Print Replace(OutPutData, vbCrLf, "") '改行ははずす
            Else
                FH.Write OutPutData
            End If
        End If
    End If
    
    Prefix = ""
End Sub


Private Sub FileOpen(ByVal Filename As String)
    '.txtが省略されていたら追加する
    If 0 = InStr(Filename, ".txt") Then Filename = Filename & ".txt"
    
    Dim FSO As Object, FilePath As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    

    If FlagNotime Then
        FilePath = ThisWorkbook.Path & "\" & Filename
        Set FH = FSO.OPenTextFile(FilePath, 2, True)
    Else
        FilePath = ThisWorkbook.Path & "\(" & Replace(Time, ":", "") & ")" & Filename
        Set FH = FSO.OPenTextFile(FilePath, 8, True)
    End If
    
    Set FSO = Nothing
End Sub

Private Sub FileClose()
    FH.Close
    Set FH = Nothing
    
    Sleep (1000) '同名ファイルに出力されるのを避けるため、1秒時間をおいている
End Sub


'■SampleCode
Private Sub SampleCode1()
    'Dummyデータ
    Dim varString   As String:   varString = "文字列"
    Dim varInteger  As Integer:  varInteger = 3
    Dim varLong     As Long:     varLong = 3
    Dim varDouble   As Double:   varDouble = 3.5
    Dim varBoolean  As Boolean:  varBoolean = True

    '■配列データの出力を行います
    Dim varArray(2) As Variant
        varArray(0) = varString
        varArray(1) = varInteger
        varArray(2) = varBoolean
    
    '※引数にデータ構造を見たい変数名を指定します
    '実行Excelファイルと同階層に (時間)Debug.txt として出力されます
    Call DebugPrint(varArray)
    '-----------------------------
    '[Variant()]
    '  (0): 文字列
    '  (1): 3
    '  (2): True
    '-----------------------------
End Sub

Private Sub SampleCode2()
    'Dummyデータ
    Dim varString   As String:   varString = "文字列"
    Dim varInteger  As Integer:  varInteger = 3
    Dim varLong     As Long:     varLong = 3
    Dim varDouble   As Double:   varDouble = 3.5
    Dim varBoolean  As Boolean:  varBoolean = True

    Dim varArray(2) As Variant
        varArray(0) = varString
        varArray(1) = varInteger
        varArray(2) = varBoolean
    
    '■Dictionaryの出力を行います
    Dim varDic As Object
    Set varDic = CreateObject("Scripting.Dictionary")
    varDic.Add "配列1", varArray
    varDic.Add "配列2", Array("a", "b", "c")
    
    '※引数にデータ構造を見たい変数名を指定します
    '実行Excelファイルと同階層に (時間)Debug.txt として出力されます
    Call DebugPrint(varDic)
    '-----------------------------
    '※ファイルの出力結果
    '[Dictionary]
    '配列1 => [Variant()]
    '  (0): 文字列
    '  (1): 3
    '  (2): True
    '配列2 => [Variant()]
    '  (0): a
    '  (1): b
    '  (2): c
    '-----------------------------
    
    '対応している変数形式は
    'String/Integer/Long/Single/Double/Currency/Date/Boolean/Byte/Variant
    '上記を用いた、Collection/Dictionary/配列(2次元配列まで)
End Sub

Private Sub SampleCode3()
    'Dummyデータ
    Dim varString   As String:   varString = "文字列"
    Dim varInteger  As Integer:  varInteger = 3
    Dim varLong     As Long:     varLong = 3
    Dim varDouble   As Double:   varDouble = 3.5
    Dim varBoolean  As Boolean:  varBoolean = True

    Dim varArray(2) As Variant
        varArray(0) = varString
        varArray(1) = varInteger
        varArray(2) = varBoolean
    
    Dim varDic As Object
    Set varDic = CreateObject("Scripting.Dictionary")
    varDic.Add "配列1", varArray
    varDic.Add "配列2", Array("a", "b", "c")
    
    
    'Q And A
    '■複数出力したとき、何の変数を出力したものか判断がつきにくい!
    ' なんとかしてほしい
    ' ⇒Filenameオプションにファイル名を指定してください
    Call DebugPrint(varArray, Filename:="Array.txt")
    Call DebugPrint(varDic, Filename:="Dictionary") '拡張子は書かなくても自動的.txtになります
End Sub


Private Sub SampleCode4()
    'Dummyデータ
    Dim varString   As String:   varString = "文字列"
    Dim varInteger  As Integer:  varInteger = 3
    Dim varLong     As Long:     varLong = 3
    Dim varDouble   As Double:   varDouble = 3.5
    Dim varBoolean  As Boolean:  varBoolean = True

    Dim varArray(2) As Variant
        varArray(0) = varString
        varArray(1) = varInteger
        varArray(2) = varBoolean
    
    Dim varDic As Object
    Set varDic = CreateObject("Scripting.Dictionary")
    varDic.Add "配列1", varArray
    varDic.Add "配列2", Array("a", "b", "c")
    
    
    'Q And A
    '■複数出力なんてしません!なのでファイル名に時間をつけて複数出力するのはやめてくれますか?
    ' 何度も何度も消すのがめんどくさい。ゴミ箱がひどいことになる・・・
    ' ⇒NotimeFlagオプションをTrueにしてください
    Call DebugPrint(varDic, Filename:="上書きテスト")
    Call DebugPrint(varDic, Filename:="上書きテスト") '通常だと(時間)上書きテスト.txt が時間ごとに作られる
    Call DebugPrint(varDic, Filename:="上書きテスト", NotimeFlag:=True)
    Call DebugPrint(varDic, Filename:="上書きテスト", NotimeFlag:=True)
    Call DebugPrint(varDic, Filename:="上書きテスト", NotimeFlag:=True) '上書きテスト.txt が一つだけ作られる(一番最後に実行したものだけが残る)
End Sub

Private Sub SampleCode5()
    'Dummyデータ
    Dim varString   As String:   varString = "文字列"
    Dim varInteger  As Integer:  varInteger = 3
    Dim varLong     As Long:     varLong = 3
    Dim varDouble   As Double:   varDouble = 3.5
    Dim varBoolean  As Boolean:  varBoolean = True

    Dim varArray(2) As Variant
        varArray(0) = varString
        varArray(1) = varInteger
        varArray(2) = varBoolean
    
    Dim varDic As Object
    Set varDic = CreateObject("Scripting.Dictionary")
    varDic.Add "配列1", varArray
    varDic.Add "配列2", Array("a", "b", "c")
    
    'Q And A
    '■配列/Collection/Dictionaryでインデントされて出力
    ' されますが、あの幅が好みじゃない・・・。
    ' ⇒IndentCountオプションを指定してください
    Call DebugPrint(varDic, IndentCount:=5)
    
    '-----------------------------
    '※ファイルの出力結果
    '[Dictionary]
    '     配列1 => [Variant()]
    '          (0): 文字列
    '          (1): 3
    '          (2): True
    '     配列2 => [Variant()]
    '          (0): a
    '          (1): b
    '          (2): c
    '-----------------------------
End Sub

Private Sub SampleCode6()
    'Dummyデータ
    Dim varString   As String:   varString = "文字列"
    Dim varInteger  As Integer:  varInteger = 3
    Dim varLong     As Long:     varLong = 3
    Dim varDouble   As Double:   varDouble = 3.5
    Dim varBoolean  As Boolean:  varBoolean = True

    Dim varArray(2) As Variant
        varArray(0) = varString
        varArray(1) = varInteger
        varArray(2) = varBoolean
    
    Dim varDic As Object
    Set varDic = CreateObject("Scripting.Dictionary")
    varDic.Add "配列1", varArray
    varDic.Add "配列2", Array("a", "b", "c")
    
    
    'Q And A
    '■データの型式を全てみたいです
    ' ⇒TypeNameFlagオプションをTrueにしてください
    Call DebugPrint(varDic, TypeNameFlag:=True)
    
    '-----------------------------
    '※ファイルの出力結果
    '[Dictionary]
    '[String] 配列1 >= [Variant()]
    '  (0): [String]文字列
    '  (1): [Integer]3
    '  (2): [Boolean]True
    '[String] 配列2 >= [Variant()]
    '  (0): [String]a
    '  (1): [String]b
    '  (2): [String]c
    '-----------------------------
End Sub

Private Sub SampleCode7()
    'Dummyデータ
    Dim varString   As String:   varString = "文字列"
    Dim varInteger  As Integer:  varInteger = 3
    Dim varLong     As Long:     varLong = 3
    Dim varDouble   As Double:   varDouble = 3.5
    Dim varBoolean  As Boolean:  varBoolean = True

    Dim varArray(2) As Variant
        varArray(0) = varString
        varArray(1) = varInteger
        varArray(2) = varBoolean
    
    Dim varDic As Object
    Set varDic = CreateObject("Scripting.Dictionary")
    varDic.Add "配列1", varArray
    varDic.Add "配列2", Array("a", "b", "c")
    
    
    'Q And A
    '■ファイルじゃなくイミディエイトウィンドウにだしてよ
    ' ⇒DebugPrintFlagをTrueにしてください
    Call DebugPrint(varDic, DebugPrintFlag:=True)
    
End Sub

xmlObj.cls

Option Explicit

Dim xmlObj      As Object
Dim xmlAttr     As Object
Dim xmlNode     As Object
Dim xmlString   As String

Private Sub Class_Initialize()

    Set xmlObj = CreateObject("MSXML2.DOMDocument")
    xmlObj.async = False
    xmlObj.setProperty "SelectionLanguage", "XPath"
    
    xmlObj.appendChild xmlObj.createProcessingInstruction("xml", "version='1.0' encoding='UTF-8'")
End Sub

Private Sub Class_Terminate()
    Set xmlObj = Nothing
End Sub

Public Sub XMLin(ByVal data As Variant)
    
    If TypeName(data) = "String" Then
        Call FileLoad(data)
        
    ElseIf TypeName(data) = "Dictionary" Then
        Call judgeTypeName(data)
        
    Else
        Call Die("XMLinメソッドは、String型またはDictionary型のみを取ることができます" & vbCrLf & _
                 "引数の型:" & TypeName(data))
    End If
    
End Sub

Public Sub XMLout(ByVal FilePath As String)
    xmlObj.Save FilePath
End Sub

Public Function XPath(ByVal strXPath As String)
    
    'xmlの文字列をロードする
    xmlObj.loadXML xmlString
    
    Set XPath = xmlObj.documentElement.selectNodes(strXPath)
    
End Function


Private Sub FileLoad(ByVal FilePath As Variant)
    
    Dim FH  As Object
    Dim FSO As Object
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    xmlString = ""
    
    If Not FSO.FileExists(FilePath) Then Call Die("FileLoadメソッド:ファイルは存在しません" & vbCrLf & "FilePath:" & FilePath)
    
    Set FH = FSO.OPenTextFile(FilePath, 1)
    
    Do While Not FH.AtEndOfStream
        xmlString = xmlString & FH.ReadLine
    
    Loop
    
    FH.Close
    
    Set FH = Nothing
    Set FSO = Nothing
    
End Sub

Private Sub judgeTypeName(ByRef data As Variant)
    
    Dim counter As Long
    Dim key     As Variant
    
    'キーに属性を含んでいる場合を高所して先に属性の登録を行う
    Call AddAttributeNode(data)
    
    
    For Each key In data
        counter = counter + 1
        
        If AddXmlNode(key) Then GoTo NextForLoop

        
        If TypeName(key) = "Dictionary" Then
            Call judgeTypeName(key)
            If counter = data.Count Then _
                Set xmlNode = xmlNode.parentNode
            
        ElseIf TypeName(data(key)) = "Collection" Then
            Call judgeTypeName(data(key))
                
        ElseIf TypeName(data(key)) = "Dictionary" Then
            Call judgeTypeName(data(key))
            
            If counter = data.Count Then _
                Set xmlNode = xmlNode.parentNode
            
        ElseIf TypeName(data(key)) = "String" Then
            Call AddChildText(data(key))
        
        Else
            Call Die("judgeTypeNameメソッドエラー:")
            Debug.Print ""
        
        End If
        
NextForLoop:
    Next
    
End Sub

Private Sub AddChildText(ByVal ChildText As String)
    '子要素にテキストを追加
    Set xmlNode = xmlNode.appendChild(xmlObj.createTextNode(ChildText))
    Set xmlNode = xmlNode.parentNode
    Set xmlNode = xmlNode.parentNode
    
End Sub


Private Sub AddAttributeNode(ByRef data As Variant)
    
    Dim key As Variant
    
    '子要素をぶら下げた後に属性処理をすると意図したところと違うところに属性がつくので
    '最初にキーを走査して属性を探しあれば親要素に属性を追加する
    For Each key In data
    
        If TypeName(key) <> "String" Then GoTo NextForEach
        If key = "@" Then
            Call Die("AddAttributeNodeメソッドエラー:属性名がありません")
            
        ElseIf Left(key, 1) = "@" Then
            Set xmlAttr = xmlNode.Attributes.setNamedItem(xmlObj.createAttribute(Mid(key, 2, Len(key))))
            xmlAttr.nodeValue = data(key)
        End If

NextForEach:
    Next
    
End Sub

Private Function AddXmlNode(ByRef key As Variant)
    
    If TypeName(key) <> "String" Then
        Exit Function
    
    ElseIf key = "" Then
        Exit Function
    
    End If
    
    
    'キーを処理する
    If xmlNode Is Nothing Then
    'Nothingの時は初なのでルートとして指定
        Set xmlNode = xmlObj.appendChild(xmlObj.CreateElement(key))
    
    Else
    '親要素以外の処理
        If Left(key, 1) <> "@" Then
        '@で始まらない時は、子要素として登録。 False(0)を返す
            Set xmlNode = xmlNode.appendChild(xmlObj.CreateElement(key))
            AddXmlNode = 0
            
       Else
       '@で始まる時は、True(1)を返す
            AddXmlNode = 1
       
       End If
       
    End If
    
End Function

Private Sub Die(ByVal msg As String)
    MsgBox "下記理由により終了します" & vbCrLf & _
           msg
    End
End Sub