ER Studio从设计模型生成JPA Entity

主要是参考 ER Studio设计模型 代码生成 。脚本如下：

'利用ER/Studio的Macro生成JPA Entity
'目前对于多对多关联和复合主键的支持还没有完成
'By Colin 2009/3/24
Sub Main()
	Dim fso As Object
	Dim entNames As Variant
	Dim entCount As Variant
	Dim entLoop As Integer
	'ER/Studio variables
	Dim mdl As Model
	Dim subMdl As SubModel
	Dim ent As Entity
	Dim classPath As Variant
	
	classPath = "d:\entity\"

	Set mdl = DiagramManager.ActiveDiagram.ActiveModel
	Set subMdl = mdl.ActiveSubModel
	'get the entities list & count
	subMdl.EntityNames(entNames, entCount)
	'sort the entities by name(alphabetic sort)
	Call dhQuickSort(entNames)
	For entLoop = 0 To entCount - 1
		Set ent = mdl.Entities.Item(entNames(entLoop))
		Set fso = CreateObject("Scripting.FileSystemObject")
		'DAO class file
		Set csFile = fso.CreateTextFile(classPath & AttributeName(StrConv(ent.EntityName,vbLowerCase)) & ".java", True)

		Call WriteEntity(csFile, ent, subMdl.Name)
		csFile.Close
	Next
End Sub
Sub WriteEntity(csFile As Object,ent As Entity, subModelName As String)
	Dim content As String
	'DAO class
	Call Write2File(csFile, NamespaceStart(ent.EntityName, subModelName))
	content = content & vbTab & "/// <summary>" & vbCrLf
	content = content & vbTab & "/// Data Access Object for " & ent.EntityName & vbCrLf
	content = content & vbTab & "/// </summary>" & vbCrLf
	content = content & vbTab & "@Entity" & vbCrLf
	content = content & vbTab & "@Table(name = """ & ent.TableName & """, catalog = ""wcs_db"", uniqueConstraints = {})" & vbCrLf
	content = content & vbTab & "public class  " & AttributeName(StrConv(ent.EntityName,vbLowerCase)) & " extends BaseEntity" & vbCrLf
	content = content & vbTab & "{" & vbCrLf
	content = content & EntityPrivateDeclare(ent) & vbCrLf
	content = content & vbTab & vbTab & "/// <summary>" & vbCrLf
	content = content & vbTab & vbTab & "/// default constructor for " & ent.EntityName & vbCrLf
	content = content & vbTab & vbTab & "/// </summary>" & vbCrLf
	content = content & vbTab & vbTab & "public " & AttributeName(StrConv(ent.EntityName,vbLowerCase)) & "()" & vbCrLf
	content = content & vbTab & vbTab & "{" & vbCrLf
	content = content & vbTab & vbTab & "}" & vbCrLf & vbCrLf
	content = content & EntityPublicDeclare(ent)
	content = content & EntityOverrideMethod(ent)
	content = content & vbTab & "}"
	Call Write2File(csFile, content)
End Sub
Function DataType2ClassType(attr As AttributeObj)
	'return the .net data type corresponding to the sql type
	Dim classType As String
	Select Case attr.Datatype
		Case "CHAR"
				classType = "String"
		Case "VARCHAR2"
				classType = "String"
		Case "NVARCHAR"
				classType = "String"
		Case "NVARCHAR2"
				classType = "String"
		Case "VARCHAR"
				classType = "String"
		Case "NTEXT"
				classType = "String"
		Case "DATETIME"
				classType = "Date"
		Case "DATE"
				classType = "Date"
		Case "DECIMAL"
				classType = "java.math.BigDecimal"
		Case "FLOAT"
				classType = "Float"
		Case "NUMERIC"
			If attr.DataScale = 0 Then
				If attr.DataLength > 9 Then
						classType = "java.math.BigDecimal"
				Else
						classType = "Integer"
				End If
			Else
				If attr.DataScale < 29 Then
						classType = "java.math.BigDecimal"
				Else
						classType = "Double"
				End If
			End If
		Case "INTEGER"
				classType = "Integer"
		Case "BIGINT"
				classType = "Long"
		Case "BIT"
				classType = "Boolean"
		Case Else
				classType = "String"
	End Select
	DataType2ClassType = classType
End Function
Function AttributePrivateName(entName As String)
	Dim length As Integer
	Dim result As String
	length = Len(entName)
	If length >0 Then
		result = StrConv(Left$(entName,1),vbLowerCase) & Right$(entName,length-1)
	End If
	AttributePrivateName = result
End Function
Function AttributeName(entName As String)
	Dim result As String
	Dim t As Integer
	Dim tempStr As String
	Dim length  As Integer
	length = Len(entName)
	entName = StrConv(Left$(entName,1),vbUpperCase) & Right$(entName,length-1)
	t=InStr(1,entName,"_")
	If t > 0 Then
		tempStr = Right$(entName,length - t)
		length = Len(tempStr)
		tempStr = StrConv(Left$(tempStr,1),vbUpperCase) & Right$(tempStr,length-1)
		result = result & Left$(entName,t-1) & tempStr
	Else
		result = entName
	End If

	Do While t>0
		length = Len(result)
        t=InStr(1,result,"_")
		tempStr = Right$(result,length-t)
		length = Len(tempStr)
		tempStr = StrConv(Left$(tempStr,1),vbUpperCase) & Right$(tempStr,length-1)
		If t>0 Then
			result = Left$(result,t-1) & tempStr
		End If
    Loop

    AttributeName = result
End Function
Function EntityPrivateDeclare(ent As Entity)
	Dim result As String
	Dim attr As AttributeObj
	Dim Index As Integer
	Dim parent As Entity
	Dim child As Entity
	Dim rl As Relationship
	Dim prl As Relationship

	For Index=1 To ent.Attributes.Count
		Set attr=FindAttribute(ent.Attributes, Index)
		If Not attr Is Nothing Then
			If attr.PrimaryKey Then
				result=result & vbTab & vbTab & "private " & DataType2ClassType(attr) & " id;" & vbCrLf
			Else
				If attr.ForeignKey Then
					'Set parent = attr.GetParent()
					'result=result & vbTab & vbTab & "private " & AttributeName(StrConv((parent.EntityName),vbLowerCase)) & " " & AttributePrivateName(AttributeName(StrConv((parent.EntityName),vbLowerCase))) & ";" & vbCrLf
				Else
					result=result & vbTab & vbTab & "private " & DataType2ClassType(attr) & " " & AttributePrivateName(AttributeName(StrConv(attr.AttributeName,vbLowerCase))) & ";" & vbCrLf
				End If
			End If
		End If
	Next

    For Each rl In ent.ChildRelationships
		Set parent = rl.ParentEntity
		result=result & vbTab & vbTab & "private " & AttributeName(StrConv((parent.EntityName),vbLowerCase)) & " " & AttributePrivateName(AttributeName(StrConv((parent.EntityName),vbLowerCase))) & ";" & vbCrLf
    Next

	For Each prl In ent.ParentRelationships
		Set child = prl.ChildEntity
		result=result & vbTab & vbTab & "private Set<" & AttributeName(StrConv((child.EntityName),vbLowerCase)) & "> " & AttributePrivateName(AttributeName(StrConv((child.EntityName),vbLowerCase))) & "s = new HashSet<" & AttributeName(StrConv((child.EntityName),vbLowerCase)) & ">();" & vbCrLf
    Next




	EntityPrivateDeclare=result
End Function
Function EntityPublicDeclare(ent As Entity)
	Dim result As String
	Dim attr As AttributeObj
	Dim Index As Integer
	Dim parent As Entity
	Dim rl As Relationship
	Dim fk As FKColumnPair
	Dim keyID As String
	Dim child As Entity
	Dim prl As Relationship

	For Index=1 To ent.Attributes.Count
		Set attr = FindAttribute(ent.Attributes, Index)
		If Not attr Is Nothing Then

			'result = result & vbTab & vbTab & "private " & DataType2ClassType(attr) & " " & attr.AttributeName & ";" & vbCrLf

			If attr.PrimaryKey Then
				result = result & vbTab & vbTab & "/// <summary>" & vbCrLf
				result = result & vbTab & vbTab & "/// " & attr.AttributeName & vbCrLf
				result = result & vbTab & vbTab & "/// </summary>" & vbCrLf
				result = result & AnnotationColumn(attr)
				result = result & vbTab & vbTab & "@Override" & vbCrLf
				result = result & vbTab & vbTab & "public " & DataType2ClassType(attr) & " getId(){" & vbCrLf
				result = result & vbTab & vbTab & vbTab & "return this.id;" & vbCrLf
				result = result & vbTab & vbTab & "}" & vbCrLf
				result = result & vbTab & vbTab & vbCrLf
				result = result & vbTab & vbTab & "@Override" & vbCrLf
				result = result & vbTab & vbTab & "public void setId(" & DataType2ClassType(attr) & " id){" & vbCrLf
				result = result & vbTab & vbTab & vbTab & "this.id = id;" & vbCrLf
				result = result & vbTab & vbTab & "}" & vbCrLf
				result = result & vbTab & vbTab & vbCrLf
			Else
				If attr.ForeignKey Then

				Else
					result = result & vbTab & vbTab & "/// <summary>" & vbCrLf
					result = result & vbTab & vbTab & "/// " & attr.AttributeName & vbCrLf
					result = result & vbTab & vbTab & "/// </summary>" & vbCrLf
					result = result & AnnotationColumn(attr)
					result = result & vbTab & vbTab & "public " & DataType2ClassType(attr)  & " " & atrributeGetMethod(attr.ColumnName) & "(){" & vbCrLf
					result = result & vbTab & vbTab & vbTab & "return this." & AttributePrivateName(AttributeName(StrConv(attr.AttributeName,vbLowerCase))) & ";" & vbCrLf
					result = result & vbTab & vbTab & "}" & vbCrLf
					result = result & vbTab & vbTab & vbCrLf
					
					result = result & vbTab & vbTab & "public void " &  atrributeSetMethod(attr.ColumnName) & "(" & DataType2ClassType(attr) & " " & AttributePrivateName(AttributeName(StrConv(attr.AttributeName,vbLowerCase)))  & "){" & vbCrLf
					result = result & vbTab & vbTab & vbTab & "this." & AttributePrivateName(AttributeName(StrConv(attr.AttributeName,vbLowerCase))) & " = " & AttributePrivateName(AttributeName(StrConv(attr.AttributeName,vbLowerCase))) & ";" & vbCrLf
					result = result & vbTab & vbTab & "}" & vbCrLf
					result = result & vbTab & vbTab & vbCrLf
				End If
			End If
		End If
	Next
	For Each rl In ent.ChildRelationships
		Set parent = rl.ParentEntity
		If Not parent Is Nothing Then
			'result = result & vbTab & vbTab & "/// <summary>" & vbCrLf
			'result = result & vbTab & vbTab & "/// " & attr.AttributeName & vbCrLf
			'result = result & vbTab & vbTab & "/// </summary>" & vbCrLf
			'result = result & AnnotationColumn(attr)
			For Each fk In rl.FKColumnPairs
				keyID = fk.ParentAttribute.AttributeName
			Next
			result = result & AnnotationFK(parent,keyID)
			'result=result & vbTab & vbTab & "private " & AttributeName(StrConv((parent.EntityName),vbLowerCase)) & " " & AttributePrivateName(AttributeName(StrConv((parent.EntityName),vbLowerCase))) & ";" & vbCrLf
			result = result & vbTab & vbTab & "public " & AttributeName(StrConv(parent.EntityName,vbLowerCase))  & " " & atrributeGetMethod(parent.EntityName) &  "(){" & vbCrLf
			result = result & vbTab & vbTab & vbTab & "return this." & AttributePrivateName(AttributeName(StrConv((parent.EntityName),vbLowerCase))) & ";" & vbCrLf
			result = result & vbTab & vbTab & "}" & vbCrLf
			result = result & vbTab & vbTab & vbCrLf
			
			result = result & vbTab & vbTab & "public void " &  atrributeSetMethod(parent.EntityName) & "(" & AttributeName(StrConv((parent.EntityName),vbLowerCase)) & " " & AttributePrivateName(AttributeName(StrConv(parent.EntityName,vbLowerCase)))  & "){" & vbCrLf
			result = result & vbTab & vbTab & vbTab & "this." & AttributePrivateName(AttributeName(StrConv(parent.EntityName,vbLowerCase))) & " = " & AttributePrivateName(AttributeName(StrConv(parent.EntityName,vbLowerCase))) & ";" & vbCrLf
			result = result & vbTab & vbTab & "}" & vbCrLf
			result = result & vbTab & vbTab & vbCrLf
		End If
    Next

    For Each prl In ent.ParentRelationships
		Set child = prl.ChildEntity
		If Not child Is Nothing Then
			result = result & AnnotationChild(ent)
			result = result & vbTab & vbTab & "public Set<" & AttributeName(StrConv(child.EntityName,vbLowerCase))  & "> " & atrributeGetMethod(child.EntityName) &  "s(){" & vbCrLf
			result = result & vbTab & vbTab & vbTab & "return this." & AttributePrivateName(AttributeName(StrConv((child.EntityName & "s"),vbLowerCase))) & ";" & vbCrLf
			result = result & vbTab & vbTab & "}" & vbCrLf
			result = result & vbTab & vbTab & vbCrLf
			
			result = result & vbTab & vbTab & "public void " &  atrributeSetMethod(child.EntityName & "s") & "(Set<" & AttributeName(StrConv((child.EntityName),vbLowerCase)) & "> " & AttributePrivateName(AttributeName(StrConv(child.EntityName,vbLowerCase)))  & "s){" & vbCrLf
			result = result & vbTab & vbTab & vbTab & "this." & AttributePrivateName(AttributeName(StrConv(child.EntityName,vbLowerCase))) & "s = " & AttributePrivateName(AttributeName(StrConv(child.EntityName,vbLowerCase))) & "s;" & vbCrLf
			result = result & vbTab & vbTab & "}" & vbCrLf
			result = result & vbTab & vbTab & vbCrLf
		End If
    Next

	EntityPublicDeclare=result
End Function
Function atrributeGetMethod(attr As String)
	atrributeGetMethod = "get" & AttributeName(StrConv(attr,vbLowerCase))
End Function
Function atrributeSetMethod(attr As String)
	atrributeSetMethod = "set" & AttributeName(StrConv(attr,vbLowerCase))
End Function
Function AppendToString(attr As AttributeObj, Val As String)
	Dim result As String
	result=Val
	If Len(Val)>0 Then
		result = result & "id.toString()"
	Else
		result = "id.toString()"
	End If
	AppendToString=result
End Function
Function AppendGetHashCode(attr As AttributeObj, Val As String)
	Dim result As String
	result=Val
	If Len(Val)>0 Then
		result = result & " + " & "id.hashCode()"
	Else
		result ="id.hashCode()"
	End If
	AppendGetHashCode=result
End Function
Function AppendEquals(ent As Entity, attr As AttributeObj, Val As String)
	Dim result As String
	result=Val
	If Len(Val)>0 Then
		result = result & "&& (id) &  == (obj instanceof " & AttributeName(StrConv(ent.EntityName,vbLowerCase)) & ")." & AttributeName(StrConv(attr.AttributeName,vbLowerCase)) & ")"
	Else
		result = "( id  == ((" & AttributeName(StrConv(ent.EntityName,vbLowerCase)) & ")obj).getId() )"
	End If
	AppendEquals=result
End Function
Function EntityOverrideMethod(ent As Entity)
	Dim result As String, toString As String, hashCode As String, equals As String
	Dim attr As AttributeObj
	Dim existsPrimary As Boolean
	For Each attr In ent.Attributes
		If attr.PrimaryKey Then
			toString = AppendToString(attr, toString)
			hashCode = AppendGetHashCode(attr, hashCode)
			equals   = AppendEquals(ent, attr, equals)
			existsPrimary=True
		End If
	Next

	If existsPrimary Then

		result = result & vbTab & vbTab & "/// <summary>" & vbCrLf
		result = result & vbTab & vbTab & "///" & vbCrLf
		result = result & vbTab & vbTab & "/// </summary>" & vbCrLf
		result = result & vbTab & vbTab & "/// <returns></returns>" & vbCrLf
		result = result & vbTab & vbTab & "@Override" & vbCrLf
		result = result & vbTab & vbTab & "public String toString()" & vbCrLf
		result = result & vbTab & vbTab & "{" & vbCrLf
		result = result & vbTab & vbTab & vbTab & "return " & toString & ";" & vbCrLf
		result = result & vbTab & vbTab & "}" & vbCrLf
		result = result & vbTab & vbTab & "/// <summary>" & vbCrLf
		result = result & vbTab & vbTab & "///" & vbCrLf
		result = result & vbTab & vbTab & "/// </summary>" & vbCrLf
		result = result & vbTab & vbTab & "/// <returns></returns>" & vbCrLf
		result = result & vbTab & vbTab & "@Override" & vbCrLf
		result = result & vbTab & vbTab & "public int hashCode()" & vbCrLf
		result = result & vbTab & vbTab & "{" & vbCrLf
		result = result & vbTab & vbTab & vbTab & "return " & hashCode & ";" & vbCrLf
		result = result & vbTab & vbTab & "}" & vbCrLf
		result = result & vbTab & vbTab & "/// <summary>" & vbCrLf
		result = result & vbTab & vbTab & "///" & vbCrLf
		result = result & vbTab & vbTab & "/// </summary>" & vbCrLf
		result = result & vbTab & vbTab & "/// <returns></returns>" & vbCrLf
		result = result & vbTab & vbTab & "@Override" & vbCrLf
		result = result & vbTab & vbTab & "public boolean equals(Object obj)" & vbCrLf
		result = result & vbTab & vbTab & "{" & vbCrLf
		result = result & vbTab & vbTab & vbTab & "boolean result = false;" & vbCrLf
		result = result & vbTab & vbTab & vbTab & "if (obj instanceof " & AttributeName(StrConv(ent.EntityName,vbLowerCase)) & ")" & vbCrLf
		result = result & vbTab & vbTab & vbTab & "{" & vbCrLf
		result = result & vbTab & vbTab & vbTab & vbTab & "result = " & equals & ";" & vbCrLf
		result = result & vbTab & vbTab & vbTab & "}" & vbCrLf
		result = result & vbTab & vbTab & vbTab & "return result;" & vbCrLf
		result = result & vbTab & vbTab & "}" & vbCrLf

	End If
	EntityOverrideMethod=result
End Function
Function AnnotationColumn(attr As AttributeObj)
		Dim result As String
		If Not attr Is Nothing Then
			If attr.PrimaryKey Then
				result = vbTab & vbTab & "@Id" & vbCrLf
				result = result & vbTab & vbTab & "@GeneratedValue(strategy = GenerationType.AUTO)" & vbCrLf
			End If
			If attr.ForeignKey Then
				result = vbTab & vbTab & "@ManyToOne(cascade = {CascadeType.PERSIST,CascadeType.MERGE})" &vbCrLf
				result = result & vbTab & vbTab & "@JoinColumn(name=""" & attr.ColumnName  & """)"  & vbCrLf
			Else
				result = vbTab & vbTab & "@Column(name = """ & attr.ColumnName & """, unique = false, nullable = "
				If attr.NullOption	= "NULL" Then
					result = result & "false"
				Else
				  result = result & "true"
				End If
				result = result & ", insertable = true, updatable = true, length = " & attr.DataLength & ")" &vbCrLf
			End If
		End If
		AnnotationColumn = result
End Function
Function AnnotationFK(parent As Entity,keyID As String)
		Dim result As String
		If Not parent Is Nothing Then
			result = vbTab & vbTab & "@ManyToOne(cascade = {CascadeType.PERSIST,CascadeType.MERGE})" &vbCrLf
			result = result & vbTab & vbTab & "@JoinColumn(name=""" & keyID  & """)"  & vbCrLf
		End If
		AnnotationFK = result
End Function
Function AnnotationChild(ent As Entity)
		Dim result As String
		If Not ent Is Nothing Then
			result = vbTab & vbTab & "@OneToMany(mappedBy=""" & AttributePrivateName(AttributeName(StrConv(ent.EntityName,vbLowerCase ))) & """)" &vbCrLf
		End If
		AnnotationChild = result
End Function
Function NamespaceStart(entName As String, subModelName As String)
	Dim result As String
	result = "//*******************************************" & vbCrLf
	result = result & "// ** Description:  Data Access Object for " & entName & vbCrLf
	result = result & "// ** Author     :  Code generator" & vbCrLf
	result = result & "// ** Created    :   " & Now & vbCrLf
	result = result & "// ** Modified   :" & vbCrLf 
	result = result & "//*******************************************" & vbCrLf & vbCrLf
	result = result & "package apps.demo.entity;" & vbCrLf & vbCrLf
	result = result & "import java.util.*;" & vbCrLf
	result = result & "import javax.persistence.*;" & vbCrLf
	result = result & "import core.hibernate.BaseEntity;" & vbCrLf
	NamespaceStart = result
End Function
Function FindAttribute(attrs As Attributes, Index As Integer)
	Dim result As AttributeObj
	Dim attr As AttributeObj
	Set result = Nothing
	For Each attr In attrs
		If attr.SequenceNumber=Index Then
			Set FindAttribute=attr
			Exit Function
		End If
	Next
	Set FindAttribute=Nothing
End Function

Sub Write2File(fileObj As Object, wordLine As String)
        fileObj.WriteLine (wordLine)
End Sub
Const dhcMissing = -2
'sort the entities by name(alphabetic sort)
Sub dhQuickSort(varArray As Variant, Optional intLeft As Integer = dhcMissing, Optional intRight As Integer = dhcMissing)
    Dim i As Integer
    Dim j As Integer
    Dim varTestVal As Variant
    Dim intMid As Integer

    If intLeft = dhcMissing Then intLeft = LBound(varArray)
    If intRight = dhcMissing Then intRight = UBound(varArray)

    If intLeft < intRight Then
        intMid = (intLeft + intRight) \ 2
        varTestVal = UCase(varArray(intMid))
        i = intLeft
        j = intRight
        Do
            Do While UCase(varArray(i)) < varTestVal
                i = i + 1
            Loop
            Do While UCase(varArray(j)) > varTestVal
                j = j - 1
            Loop
            If i <= j Then
                SwapElements varArray, i, j
                i = i + 1
                j = j - 1
            End If
        Loop Until i > j
        If j <= intMid Then
            Call dhQuickSort(varArray, intLeft, j)
            Call dhQuickSort(varArray, i, intRight)
        Else
            Call dhQuickSort(varArray, i, intRight)
            Call dhQuickSort(varArray, intLeft, j)
        End If
    End If
End Sub
Private Sub SwapElements(varItems As Variant, intItem1 As Integer, intItem2 As Integer)
    Dim varTemp As Variant

    varTemp = varItems(intItem2)
    varItems(intItem2) = varItems(intItem1)
    varItems(intItem1) = varTemp
End Sub