ab.com コミュニティ

' StrStackクラス：文字列を格納するスタック
'
' Push(String)			要素の挿入
' Get() As String		最も新しく挿入された要素の取得
' Pop()					最も新しく挿入された要素の破棄
' LastError() As Long	最後に実行したメンバ関数が失敗している時は1，それ以外は0を返す

Type _StrStack_Sub
	lpBuf As BytePtr
	lpNext As *_StrStack_Sub
End Type

Class StrStack
Private
	first As *_StrStack_Sub ' スタックの先頭
	Error As Long ' エラーの有無
	
	' スタックの各要素を破棄（再帰呼出使用）
	Sub FreeStrStack(lpStackElem As *_StrStack_Sub)
		' NULLの場合
		If lpStackElem=NULL Then Exit Sub
		
		' 文字列領域を破棄
		If lpStackElem->lpBuf<>NULL Then
			free(lpStackElem->lpBuf)
		End If
		
		' １つ先の要素にFreeStrStackをかける
		FreeStrStack(lpStackElem->lpNext)
		
		' 要素本体を破棄
		free(lpStackElem)
	End Sub
	
Public
	' コンストラクタ
	Sub StrStack()
		'first=NULL
		'Error=0
	End Sub
	
	' デストラクタ
	Sub ~StrStack()
		FreeStrStack(first)
	End Sub
	
	' 要素の挿入
	Sub Push(buf As String)
		Dim lpNewElem As *_StrStack_Sub
		lpNewElem=malloc(SizeOf(_StrStack_Sub))
		If lpNewElem=NULL Then
			Error=1
			Exit Sub
		End If
		' 挿入された要素に文字列を書き込む
		lpNewElem->lpNext=first
		lpNewElem->lpBuf=malloc(Len(buf)+1)
		lstrcpy(lpNewElem->lpBuf, StrPtr(buf))
		
		first=lpNewElem
		Error=0
	End Sub
	
	' 末尾の要素の取得
	Function Get() As String
		' 要素が１つもない場合
		If first=NULL Then
			Error=1
			Get=""
			Exit Sub
		End If
		
		Get=MakeStr(first->lpBuf)
		Error=0
	End Function
	
	' 末尾の要素の破棄
	Sub Pop()
		Dim lpSQTmp As *_StrStack_Sub
		' 要素が１つもない場合
		If first=NULL Then
			Error=1
			Exit Sub
		End If
		
		lpSQTmp=first
		first=first->lpNext
		
		' 文字列領域を破棄
		If lpSQTmp->lpBuf<>NULL Then
			free(lpSQTmp->lpBuf)
		End If
		
		' 要素本体を破棄
		free(lpSQTmp)
		
		Error=0
	End Sub
	
	Function LastError() As Long
		LastError=Error
	End Function
End Class