Translate

2017年12月19日火曜日

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

Logger

Option Explicit

Dim data()              As String
Dim DataCellObj         As Object
Dim DataSheetObj        As Object
Dim x                   As Long
Dim y                   As Long
Dim DelColumn           As Long
Dim FlagTransposeError  As Boolean

'Setter/Getter
Public Property Let DeleteColumn(ByVal Num As Long)
DelColumn = Num
End Property

Public Property Get DeleteColumn() As Long
DeleteColumn = DelColumn
End Property


Private Sub Class_Initialize()

'初期化
x = -1
y = -1

End Sub

Public Sub BorderLine(Optional ByVal Sht As Worksheet, Optional ByVal Cell As String, _
Optional ByVal LineStyle As Integer = xlContinuous, _
Optional Weight As Integer = xlThin, _
Optional ColorIndex As Integer = xlAutomatic)

Dim BaseRow     As Long
Dim BaseCol     As Long
Dim RangeObj    As Object

If Not Sht Is Nothing Then Set DataSheetObj = Sht
If DataCellObj Is Nothing Then Call Die("Sheetobjが設定されていません")

If Cell <> "" Then Set DataCellObj = DataSheetObj.Range(Cell)
If DataCellObj Is Nothing Then Call Die("開始のセル情報がありません")

'初期値のままだと出力できないので終了する
If y < 0 Then Exit Sub
    
    BaseRow = DataCellObj.Row
    BaseCol = DataCellObj.Column
    
    Set RangeObj = DataSheetObj.Range(DataSheetObj.Cells(BaseRow, BaseCol), DataSheetObj.Cells(BaseRow + y, BaseCol + x))
    
    RangeObj.Borders(xlEdgeLeft).LineStyle = LineStyle
    RangeObj.Borders(xlEdgeLeft).Weight = Weight
    RangeObj.Borders(xlEdgeLeft).ColorIndex = ColorIndex

    RangeObj.Borders(xlEdgeTop).LineStyle = LineStyle
    RangeObj.Borders(xlEdgeTop).Weight = Weight
    RangeObj.Borders(xlEdgeTop).ColorIndex = ColorIndex
    
    RangeObj.Borders(xlEdgeBottom).LineStyle = LineStyle
    RangeObj.Borders(xlEdgeBottom).Weight = Weight
    RangeObj.Borders(xlEdgeBottom).ColorIndex = ColorIndex
    
    RangeObj.Borders(xlEdgeRight).LineStyle = LineStyle
    RangeObj.Borders(xlEdgeRight).Weight = Weight
    RangeObj.Borders(xlEdgeRight).ColorIndex = ColorIndex
    
    If 0 < x Then
        RangeObj.Borders(xlInsideVertical).LineStyle = LineStyle
        RangeObj.Borders(xlInsideVertical).Weight = Weight
        RangeObj.Borders(xlInsideVertical).ColorIndex = ColorIndex
    End If
    
    If 0 < y Then
        RangeObj.Borders(xlInsideHorizontal).LineStyle = LineStyle
        RangeObj.Borders(xlInsideHorizontal).Weight = Weight
        RangeObj.Borders(xlInsideHorizontal).ColorIndex = ColorIndex
    End If

End Sub

Public Function Count()
    
    If x = -1 And y = -1 Then
    
        Count = 0
    
    Else
    
        '要素数を返す
        Count = UBound(data, 2) + 1

    End If
End Function

Public Function Item(ByVal a As Long, ByVal B As Long, Optional ByVal Str As Variant)

    '引数なし
    If IsMissing(Str) Then
    
        Item = data(a, B)
        
    '引数あり
    Else
    
        data(a, B) = Str
    
    End If

End Function

Public Function Join(ByVal Ele02 As Long, ByVal delimiter As String)
    Dim i    As Long
    Dim temp As String
    
    For i = 0 To UBound(data, 1)
        temp = temp & data(i, Ele02) & IIf(i = UBound(data, 1), "", delimiter)
    Next

    Join = temp
End Function

Public Function Last()

    '最終要素を返す
    Last = UBound(data, 2)

End Function

Private Function TransposeData()
    Dim S        As Long
    Dim t        As Long
    Dim TPData() As String
    ReDim TPData(y, x)
    
    For S = 0 To y
        For t = 0 To x
            TPData(S, t) = data(t, S)
        Next
    Next
    
    TransposeData = TPData
End Function

Public Function Value() As String()

    '2次元配列自体を返す
    Value = data()

End Function

Public Sub Add(ByRef list As Variant)
    Dim i As Long
    
    '1次元の要素数が確定していない時、要素数の調査をおこなう
    If x = -1 Then
        
        If TypeName(list) = "Variant()" Or TypeName(list) = "String()" Then
            
            x = UBound(list)
        
        Else
            
            x = 0
        
        End If
    
    End If
    
    
    '要素数の再定義
    y = y + 1
    ReDim Preserve data(x, y)
    
    If TypeName(list) = "Variant()" Or TypeName(list) = "String()" Then
        
        For i = 0 To x
        
            '要素数が足りないときは、空文字を指定
            On Error Resume Next
            
            data(i, y) = list(i)
            
            'Transpose関数は255文字を越えたデータを受け取るとエラーとなるので判定する
            If 255 < Len(list(i)) Then FlagTransposeError = True
            
            On Error GoTo 0
        
        Next
        
    Else
    
        data(x, y) = list
    
        'Transpose関数は255文字を越えたデータを受け取るとエラーとなるので判定する
        If 255 < Len(list) Then FlagTransposeError = True
    
    End If

End Sub

Public Sub Clear()
    
    '初期化
    Erase data
    
    DelColumn = -1
    
    x = -1
    y = -1
    
    FlagTransposeError = False

End Sub

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

End Sub

Public Function Output(ByVal Sht As Worksheet, ByVal Cell As String, Optional ByVal KeyIndexNumber As Long = -1)
    Dim BaseRow As Long
    Dim BaseCol As Long
    
    'JuuFukuチェック用の引数が指定されていたらチェックする
    If -1 < KeyIndexNumber Then
        
        Call OverLapCheck(KeyIndexNumber)
                     
    End If
    
    BaseRow = Sht.Range(Cell).Row
    BaseCol = Sht.Range(Cell).Column
    
    'DelColumnが1以上でセットされている時該当列をクリアする
    If 0 < DelColumn Then
        Sht.Range(Sht.Cells(BaseRow, BaseCol), Sht.Cells(65536, BaseCol + DelColumn)).ClearContents
    End If
    
    
    '初期値のままだと出力できないので終了する
    If y < 0 Then Exit Function
    
    If FlagTransposeError Then
        
        Sht.Range(Sht.Cells(BaseRow, BaseCol), Sht.Cells(BaseRow + y, BaseCol + x)) = TransposeData()
    
    Else
    
        Sht.Range(Sht.Cells(BaseRow, BaseCol), Sht.Cells(BaseRow + y, BaseCol + x)) = WorksheetFunction.Transpose(data)
    
    End If
    
    Set DataCellObj = Sht.Range(Cell)
    Set DataSheetObj = Sht
    Set Output = Me
    
End Function

Public Sub Sort(Optional ByVal Element As Variant)
    Dim i As Long
    
    '■引数エラーチェック
    
    If VarType(Element) = vbError Then
        '引数が設定されていないと VarTypeでErrorとなるのでチェックする
        '引数が設定されていない時は、最初の要素についてSortする
        Element = Array(0)

    ElseIf IsNumeric(Element) Then
        '数字の時、整数値か確認。0以上か確認。
        If CLng(Element) <> Element Or Element < 0 Then
            Call Die("Sort関数の引数には、0以上の整数を指定してください")
        
        Else
            Element = Array(CLng(Element))
        End If
    
    ElseIf Not IsArray(Element) Then
        Call Die("Sortメソッドの引数は、配列を指定してください")
    
    End If
    
    '引数がセットされていた時、それらはすべて整数で要素数の範囲内かどうかチェックする
    For i = UBound(Element) To 0 Step -1

        Call BubbleSort(Element(i))
            
    Next
    
End Sub

Private Sub BubbleSort(ByVal Element As Long)
    Dim ChangeData As String
    Dim DataA      As String
    Dim DataB      As String
    Dim FlagChange As String
    Dim i          As Long
    Dim ii         As Long
    
    'データがない時ソートができないので終了する
    If Count = 0 Then Exit Sub
    
    Do
        FlagChange = False
        For i = 0 To UBound(data, 2) - 1
            DataA = data(Element, i)
            DataB = data(Element, i + 1)
            
            If DataB < DataA Then
                FlagChange = True
                
                For ii = 0 To UBound(data, 1)
                    ChangeData = data(ii, i)
                    data(ii, i) = data(ii, i + 1)
                    data(ii, i + 1) = ChangeData
                Next
                
            End If
            
        Next
            
        If FlagChange = False Then Exit Do
    Loop
End Sub

Private Sub OverLapCheck(ByVal KeyIndexNumber As Long)

    Dim HashOverLap As Object
    Dim key         As String
    Dim i           As Long
    Dim ii          As Long
    Dim temp()      As String
    
    '** Objectの生成 **
    Set HashOverLap = CreateObject("Scripting.Dictionary")
    
    'そもそも二次元配列が空の時はループを抜ける
    If y = -1 Then Exit Sub
    
    y = -1
    
    'JuuFukuCheckする
    For i = 0 To UBound(data, 2)
    
        key = data(KeyIndexNumber, i)
        
        If Not HashOverLap.Exists(key) Then
        
            HashOverLap.Add key, ""
            
            y = y + 1
            
            ReDim Preserve temp(UBound(data, 1), y)
            
            For ii = 0 To UBound(data, 1)
            
                temp(ii, y) = data(ii, i)
              
            Next
                
        End If
        
    Next
    
    'Temp内は重複がチェックされたもの。
    'Dataの内容を書き換える
    ReDim data(UBound(temp, 1), UBound(temp, 2))
    
    data = temp
    
    Set HashOverLap = Nothing
End Sub

2017年11月4日土曜日

scanf で charを受け取る

char以外の文字を受け取りその後charを受け取る場合
以下のように書くと期待しない動きになる

#include 

int main() {
 int n;
 char a;
 char b;

 scanf("%d", &n);
 scanf("%c", &a);
 scanf("%c", &b);

 return 0;
}

scanfは、3回登場するが、入力は10とaの2回
10
a




最初の変数に10が代入。
改行はストリームに残っているので、char変数にaに代入される。
その後、改めて入力したaがchar変数bに代入される。

一度入力した後にcharに代入する場合、改行を毎回捨てる必要がある
①getchar()で読み捨てる
#include 

int main() {
 int n;
 char a;
 char b;

 scanf("%d", &n);
 (void)getchar();
 scanf("%c", &a);
 (void)getchar();
 scanf("%c", &b);

 return 0;
}


②書式文字列に半角スペースを先頭につけ、最初の改行を読み捨てる
#include 

int main() {
 int n;
 char a;
 char b;

 scanf("%d", &n);
 scanf(" %c", &a);
 scanf(" %c", &b);

 return 0;
}

③書式文字列に代入不可(*)を指定して読み飛ばす
#include 

int main() {
 int n;
 char a;
 char b;

 scanf("%d", &n);
 scanf("%*c%c", &a);
 scanf("%*c%c", &b);

 return 0;
}

2017年10月22日日曜日

NULL

NULLは void型 で値は0

NULLをintに変換すれば0と一緒
#include
int main(){
  if((int)NULL == 0){                                                                                                                                 
    printf("0です\n");
  }else{
    printf("0じゃないです\n");
  }
  return 0;
}


0を(void*)として変換すればNULLと一緒
#include

int main(){
  if(NULL == (void*)0){                                                                                                                               
    printf("0です\n");
  }else{
    printf("0じゃないです\n");
  }
  return 0;
}

2017年8月13日日曜日

typescriptコンパイル結果

案件でTypeScriptが使えなかった時に備え何が何に変換されるかメモ

■class
.ts
class animal { }

.js
var animal = (function () {
    // コンストラクタ
    function animal() {
    }
    return animal;
}());

■コンストラクタ
.ts
class animal {
    constructor() {
        alert("const");
    }
}

.js
var animal = (function () {
    // コンストラクタ
    function animal() {
        alert("const");
    }
    return animal;
}());

■インスタンス変数(public)
.ts
class animal {
    name: string = "default";
}

.js
var animal = (function () {
    function animal() {
        this.name = "default";
    }
    return animal;
}());

■インスタンス変数(private)
コンパイラ時チェックのみ


■Getter/Setter
.ts
class animal {
    _name: string = "default";

    get name() {
        return this._name;
    }

    set name(value: string) {
        this._name = value;
    }
}

.js
var animal = (function () {
    function animal() {
        this._name = "default";
    }
    Object.defineProperty(animal.prototype, "name", {
        get: function () {
            return this._name;
        },
        set: function (value) {
            this._name = value;
        },
        enumerable: true,
        configurable: true
    });
    return animal;
}());

■staticメソッド、変数
.ts
class animal {
    static count: number = 0;

    static Print(): void {
        alert(animal.count);
    }
}

.js
var animal = (function () {
    function animal() {
    }
    animal.Print = function () {
        alert(animal.count);
    };
    animal.count = 0;
    return animal;
}());