Beispiel eines PreCompiler der OOP-PreCompiler von 2010
- Laden der Include-Dateien (Recursive)
- Einbinden ohne Zeilenverschiebung bei Debuggen
- Einbinden neuer Include-Dateien
- Etc
Code: Alles auswählen
;-TOP
; Kommentar : OOP-PreCompiler mit Klassenvererbung
; Author : mk-soft
; Second Author :
; Datei : OOP-PreCompilerX64.pb
; Version : 0.46
; Erstellt : 25.12.2007
; Geändert : 21.04.2010
;
; Compilermode :
;
; ***************************************************************************************
EnableExplicit
;- Konstanten
#File = 0
#Zeichen = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789"
; ***************************************************************************************
#PROGRAM = "OOP-PreCompiler X32/64 Version 0.47"
#REVISION = "Rev. "
#COPYRIGHT = "©2007-2010 by Michael Kastner (mk-soft)"
Global ABOUT.s
ABOUT = #PROGRAM + #LF$ + #REVISION + Str(#PB_Compiler_Date/86400) + #LF$ + #LF$ + #COPYRIGHT
; ***************************************************************************************
;- Strukturen
Structure udtClass
ClassName.s
Extends.s
UIID.s
EndStructure
Structure udtMethod
ClassName.s
MethodName.s
Type.s
Key.s
Param.s
EndStructure
; ***************************************************************************************
;- Globale Variablen und Listen
Global filename.s, pathname.s
Global filetype.l
Global firstline.l
Global NewList IncludeFiles.s()
Global NewList Lines.s()
Global NewList AllLines.s()
Global NewList ListClass.udtClass()
Global NewList ListMethod.s()
Global NewList ListDetailMethod.udtMethod()
Global NewList TopLines.s()
Global NewList BottomLines.s()
Global NewList InterfaceLines.s()
Global NewList DeclareClass.s()
; ***************************************************************************************
Procedure msg(Text.s)
MessageRequester("Debug", text)
EndProcedure
; ***************************************************************************************
Procedure FindStringRight(String.s, StringToFind.s, Startposition.l = 0)
Protected len, len2, index
len = Len(String)
len2 = Len(StringToFind)
If Startposition = 0
Startposition = len
EndIf
For index = Startposition To 1 Step - 1
If Mid(String, index, len2) = StringToFind
ProcedureReturn index
EndIf
Next
ProcedureReturn 0
EndProcedure
; ***************************************************************************************
Procedure.s ParseIncludePath(line.s,pos)
Protected temp.s, part.s, pos2, i
NewList List.s()
pos2 = FindString(line, " ", pos) + 1
temp = Mid(line, pos2, Len(line))
temp = Trim(temp)
Repeat
i + 1
part = Trim(StringField(temp, i, "+"))
If part = ""
Break
EndIf
AddElement(List())
List() = part
ForEver
temp = ""
ForEach List()
Select List()
Case "#PB_Compiler_Home"
temp + #PB_Compiler_Home
Default
If Left(List(),1) = #DQUOTE$
temp + Mid(List(), 2, Len(List()) - 2)
Else
temp + ""
EndIf
EndSelect
Next
ProcedureReturn temp
EndProcedure
; ***************************************************************************************
Procedure.s LoadIncludeFileList(FileName.s)
Static File, Include.s
Protected FF, Path.s, IFile.s, Path2.s, Line.s, Pos, PosB, PosE, temp.s, IsLoad
File + 1
If ReadFile(File, FileName) = 0
File - 1
ProcedureReturn ""
EndIf
While Eof(File) = 0
IFile = ""
Line = ReadString(File)
; check IncludePath
Pos = FindString(Line, "IncludePath", 1)
If FindStringRight(Line, ";", Pos) Or FindStringRight(Line, #DQUOTE$, Pos)
Pos = 0
EndIf
If pos
include = ParseIncludePath(Line, Pos)
If include
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
If Right(include, 1) <> "/" : include + "/": EndIf
CompilerElse
If Right(include, 1) <> "\" : include + "\": EndIf
CompilerEndIf
EndIf
EndIf
Pos = FindString(Line, "IncludeFile", 1)
If FindStringRight(Line, ";", Pos) Or FindStringRight(Line, #DQUOTE$, Pos)
Pos = 0
EndIf
If pos
temp = include + ParseIncludePath(Line, Pos)
IsLoad = #False
ForEach IncludeFiles()
If UCase(IncludeFiles()) = UCase(temp)
IsLoad = #True
Break
EndIf
Next
If Not IsLoad
AddElement(IncludeFiles())
IncludeFiles() = temp
LoadIncludeFileList(temp)
EndIf
EndIf
Wend
CloseFile(File)
File - 1
EndProcedure
; ***************************************************************************************
Procedure LoadFile()
Protected line.s, valid, ft
; Dateiname holen
filename = ProgramParameter()
If filename = ""
MessageRequester("About", about)
ProcedureReturn #False
EndIf
; Path lesen
pathname = GetPathPart(filename)
; Datei öffnen zu lesen
If ReadFile(#File, filename) = 0
ProcedureReturn #False
EndIf
; Type ermitteln
filetype = ReadStringFormat(#File)
; Datei einlesen
While Eof(#File) = 0
line = ReadString(#File, filetype)
AddElement(Lines())
Lines() = line
Wend
CloseFile(#File)
; Alle Include Dateien einlesen
LoadIncludeFileList(FileName)
ForEach IncludeFiles()
; Datei öffnen zu lesen
If ReadFile(#File, IncludeFiles()) = 0
ProcedureReturn #False
EndIf
; Type ermitteln
ft = ReadStringFormat(#File)
; Datei einlesen
While Eof(#File) = 0
line = ReadString(#File, ft)
AddElement(AllLines())
AllLines() = line
Wend
CloseFile(#File)
Next
ProcedureReturn #True
EndProcedure
; ***************************************************************************************
Procedure SaveFile()
Protected path.s, topfile.s, bottomfile.s, interfacefile.s
path = GetPathPart(FileName)
topfile = path + "topfile.oop"
bottomfile = path + "bottomfile.oop"
interfacefile = path + "interfacefile.oop"
; Speicher TopFile
If CreateFile(#File, topfile)
ForEach TopLines()
WriteStringN(#File, TopLines())
Next
CloseFile(#File)
EndIf
; Speicher BottomFile
If CreateFile(#File, bottomfile)
ForEach BottomLines()
WriteStringN(#File, BottomLines())
Next
CloseFile(#File)
EndIf
; Include TopFile
FirstElement(Lines())
Lines() = "Includefile " + #DQUOTE$ + topfile + #DQUOTE$ + " : " + Lines()
; letzte Zeile suchen
LastElement(Lines())
While Left(Lines(), 1) = ";"
PreviousElement(Lines())
Wend
; Include BottomFile
AddElement(Lines())
Lines() = "Includefile " + #DQUOTE$ + bottomfile + #DQUOTE$
If CreateFile(#File, FileName) = 0
ProcedureReturn #False
EndIf
ForEach Lines()
WriteStringN(#File, Lines(), filetype)
Next
CloseFile(#File)
EndProcedure
; ***************************************************************************************
Procedure FindAllClass(List List.s())
Protected line.s, ClassName.s, ExtendsName.s, ch.s, temp.s
Protected pos1, pos2, len, IsClass
ForEach List()
line = UCase(List())
pos1 = FindString(line, "CLASS(", 1)
If pos1
IsClass = #True
len = pos1 - 1
For pos1 = 1 To len
If Mid(Line, pos1, 1) <> " "
IsClass = #False
Break
EndIf
Next
If IsClass
; Parameter filtern
pos1 = FindString(line, "(", pos1) + 1
pos2 = FindString(line, ")", pos1)
temp = Mid(List(), pos1, pos2 - pos1)
; ClassName filtern
ClassName = StringField(temp, 1, ",")
ClassName = Trim(ClassName)
; ExtendsName filtern
ExtendsName = StringField(temp, 2, ",")
ExtendsName = Trim(ExtendsName)
If ExtendsName = ""
ExtendsName = "BaseClass"
EndIf
; Hinzufügen
AddElement(ListClass())
ListClass()\ClassName = Trim(ClassName)
ListClass()\Extends = Trim(ExtendsName)
EndIf
EndIf
Next
ProcedureReturn #True
EndProcedure
; ***************************************************************************************
Procedure FindAllMethod(List List.s())
Protected line.s, Methode.s
Protected pos1, pos2, len, IsMethode
ForEach List()
line = UCase(List())
pos1 = 0
If FindString(line, "ENDMETHOD", 1) = 0
pos1 = FindString(line, "METHOD", 1)
EndIf
If pos1
IsMethode = #True
len = pos1 - 1
For pos1 = 1 To len
If Mid(Line, pos1, 1) <> " "
IsMethode = #False
Break
EndIf
Next
If IsMethode
Methode = Mid(List(), pos1, Len(line))
Methode = Trim(Methode)
If UCase(Left(Methode,1)) >= "A" And UCase(Left(Methode,1)) <= "Z"
AddElement(ListMethod())
ListMethod() = Methode
EndIf
EndIf
EndIf
Next
ProcedureReturn #True
EndProcedure
; ***************************************************************************************
Procedure FindUIID(List List.s())
Protected line.s, UIID.s, find.s
Protected pos1, pos2, len, IsUIID
ForEach ListClass()
find = UCase("UIID_" + ListClass()\ClassName + ":")
ForEach List()
line = UCase(List())
pos1 = FindString(line, find, 1)
If pos1
IsUIID = #True
len = pos1 - 1
For pos2 = 1 To len
If Mid(Line, pos2, 1) <> " "
IsUIID = #False
Break
EndIf
Next
If IsUIID
pos2 = FindString(line, ":", pos1) + 1
len = pos2 - pos1 - 1
UIID = Mid(List(), pos1, len)
UIID = Trim(UIID)
ListClass()\UIID = UIID
EndIf
EndIf
Next
Next
ProcedureReturn #True
EndProcedure
; ***************************************************************************************
; ***************************************************************************************
Procedure SplitListMethod()
Protected line.s, uline.s, Methoden.s, ExtendsName.s, type.s, result.s, len, pos1, pos2, pos3
ForEach ListMethod()
AddElement(ListDetailMethod())
line = ListMethod()
line = ReplaceString(line, "(", " (")
uline = UCase(ListMethod())
uline = ReplaceString(uline, "(", " (")
; Part 1 Type Methode
pos1 = 1
result = StringField(line, pos1, " ")
If Len(result) > 6
type = StringField(result, 2, ".")
ListDetailMethod()\Type = type
EndIf
pos1 + 1
; Part 2 Methode key Overwrite
result = StringField(uline, pos1, " ")
If FindString(result, "OVERWRITE", 1)
ListDetailMethod()\Key = "OVERWRITE"
pos1 + 1
EndIf
result = StringField(line, pos1, " ")
; Part 3 ClassName
ListDetailMethod()\ClassName = Trim(StringField(result, 1, "_"))
; Part 4 MethodName
ListDetailMethod()\MethodName = Trim(StringField(result, 2, "_"))
; Part 4 - ersten Parameter entfernen
pos1 = FindString(line, "(", 1)
pos2 = FindString(line, ",", pos1)
If pos2
pos2 + 1
result = "(" + Mid(line, pos2, Len(line))
result = RemoveString(result, " ")
pos3 = FindString(result, ";", 1)
If pos3
pos3 - 1
result = Left(result, pos3)
EndIf
ListDetailMethod()\Param = result
Else
ListDetailMethod()\Param = "()"
EndIf
Next
EndProcedure
; ***************************************************************************************
Procedure CreateUnknown(*Class.udtClass, List List.s())
Protected line.s, UIID.s, parameters.s
UIID = " Or CompareMemory(*UIID, ?"
; Parameters InitObject finden
parameters = "()"
ForEach ListDetailMethod()
If UCase(ListDetailMethod()\ClassName) = UCase(*Class\ClassName)
If UCase(ListDetailMethod()\MethodName) = "INITOBJECT"
parameters = ListDetailMethod()\param
Break
EndIf
EndIf
Next
Restore IUnknown
Repeat
Read.s line
If line = "EEEE"
Break
EndIf
;line = ReplaceString(line, "<Parent>", *Class\Extends)
line = ReplaceString(line, "(__parameters__)", parameters)
line = ReplaceString(line, "<Class>", *Class\ClassName)
If FindString(line, "__UIID__", 1)
If *Class\UIID
UIID = " Or CompareMemory(*UIID, ?" + *Class\UIID + ", 16)"
line = ReplaceString(line, "__UIID__", UIID)
Else
line = RemoveString(line, "__UIID__")
EndIf
EndIf
AddElement(List())
List() = Line
ForEver
; Create Declare Class
AddElement(DeclareClass())
DeclareClass() = "Declare New" + *Class\ClassName + parameters
EndProcedure
; ***************************************************************************************
Procedure CreateMacros(List List.s())
Protected line.s, path.s
Restore Macros
Repeat
Read.s line
If line = "EEEE"
Break
EndIf
AddElement(List())
List() = line
ForEver
EndProcedure
; ***************************************************************************************
Procedure CreateUIID(List List.s())
Protected line.s
Restore IID_IUnknown
Repeat
Read.s line
If line = "EEEE"
Break
EndIf
AddElement(List())
List() = line
ForEver
EndProcedure
; ***************************************************************************************
Global ParentClass.s
Procedure CreateInterface(*Class.udtClass, List List.s())
Protected line.s, Methoden.s, ExtendsName.s, type.s, result.s, len, pos1, pos2
; Kopfzeile
AddElement(List())
If UCase(*Class\Extends) = "BASECLASS"
List() = "Interface I" + *Class\ClassName + " Extends IUnknown"
Else
List() = "Interface I" + *Class\ClassName + " Extends I" + *Class\Extends
EndIf
; Eigene Classe einbinden
Methoden = UCase(*Class\ClassName)
ForEach ListDetailMethod()
line = UCase(ListDetailMethod()\ClassName)
pos1 = FindString(line, Methoden, 1)
If pos1
If ListDetailMethod()\key = ""
result = " " + ListDetailMethod()\MethodName
If ListDetailMethod()\type
result + "." + ListDetailMethod()\Type
EndIf
result + ListDetailMethod()\Param
AddElement(List())
List() = result
EndIf
EndIf
Next
; Fusszeile
AddElement(List())
List() = "EndInterface; I" + *Class\ClassName
EndProcedure
; ***************************************************************************************
Procedure CreateDataSection(*Class.udtClass, List List.s())
Protected line.s, Methoden.s, ExtendsName.s, len, pos1, pos2, Isfind
Protected temp1.s, temp2.s
Protected NewList ExtMethod.s()
Protected NewList InternMethod.s()
; Kopfzeile
AddElement(List())
List() = "DataSection; I" + *Class\ClassName
; Adress Pointer
AddElement(List())
List() = " __" + *Class\ClassName + "_Method:"
; Vererbte Classen suchen
ExtendsName = UCase(*Class\Extends)
Repeat
If ExtendsName = "BASECLASS"
Break
EndIf
ResetList(ExtMethod())
IsFind = #False
ForEach ListClass()
If UCase(ListClass()\ClassName) = ExtendsName
ExtendsName = UCase(ListClass()\Extends)
IsFind = #True
Break
EndIf
Next
Methoden = UCase(ListClass()\ClassName)
ForEach ListDetailMethod()
pos1 = FindString(UCase(ListDetailMethod()\ClassName), Methoden, 1)
If pos1
AddElement(ExtMethod())
ExtMethod() = " Data.i @" + ListDetailMethod()\ClassName + "_" + ListDetailMethod()\MethodName + "()"
EndIf
Next
Until Not IsFind
; Methoden IUnknown einbinden
ResetList(ExtMethod())
AddElement(ExtMethod())
ExtMethod() = " Data.i @" + *Class\ClassName + "_QueryInterface()"
AddElement(ExtMethod())
ExtMethod() = " Data.i @" + *Class\ClassName + "_AddRef()"
AddElement(ExtMethod())
ExtMethod() = " Data.i @" + *Class\ClassName + "_Release()"
; Eigene Classe suchen
Methoden = UCase(*Class\ClassName)
ForEach ListDetailMethod()
line = UCase(ListDetailMethod()\ClassName)
pos1 = FindString(line, Methoden, 1)
If pos1
If ListDetailMethod()\Key = "OVERWRITE"
IsFind = #False
ForEach ExtMethod()
temp1 = UCase(ExtMethod())
temp2 = UCase(ListDetailMethod()\MethodName)
If FindString(temp1, temp2, 1)
DeleteElement(ExtMethod())
AddElement(ExtMethod())
ExtMethod() = " Data.i @" + ListDetailMethod()\ClassName + "_" + ListDetailMethod()\MethodName + "()"
IsFind = #True
Break
EndIf
Next
If Not Isfind
AddElement(InternMethod())
InternMethod() = " Data.i @" + ListDetailMethod()\ClassName + "_" + ListDetailMethod()\MethodName + "()"
ListDetailMethod()\Key = ""
EndIf
Else
AddElement(InternMethod())
InternMethod() = " Data.i @" + ListDetailMethod()\ClassName + "_" + ListDetailMethod()\MethodName + "()"
EndIf
EndIf
Next
; Vererbete Classen einbinden
ForEach ExtMethod()
AddElement(List())
List() = ExtMethod()
Next
; Eigene Classen einbinden
ForEach InternMethod()
AddElement(List())
List() = InternMethod()
Next
; Fusszeile
AddElement(List())
List() = "EndDataSection; I" + *Class\ClassName
EndProcedure
; ***************************************************************************************
Procedure Main()
Protected count, max, interfacefile.s
; Quell-Datei und Include-Dateien laden
If LoadFile() = 0
ProcedureReturn 0
EndIf
; Quell-Datei vor Include-Dateien setzen
ResetList(AllLines())
ForEach Lines()
AddElement(AllLines())
AllLines() = Lines()
Next
; Classen suchen
If FindAllClass(AllLines()) = 0
ProcedureReturn 0
EndIf
; Irgendwelche Klassen programmiert
If ListSize(ListClass()) <= 0
ProcedureReturn 0
EndIf
; UIID suchen
If FindUIID(AllLines()) = 0
ProcedureReturn 0
EndIf
; Methoden suchen
If FindAllMethod(AllLines()) = 0
ProcedureReturn 0
EndIf
SplitListMethod()
max = ListSize(ListClass()) - 1
;- BottomFile
; Methoden einbinden
AddElement(BottomLines())
BottomLines() = "; --- OOP - Create Control Object and IUnknown "
For count = 0 To max
SelectElement(ListClass(), count)
CreateUnknown(ListClass(), BottomLines())
Next
AddElement(BottomLines())
BottomLines() = "; --- EndOOP - Create Control Object and IUnknown "
; DataSection einbinden
AddElement(BottomLines())
BottomLines() = "; --- OOP - Create DataSection "
For count = 0 To max
SelectElement(ListClass(), count)
CreateDataSection(ListClass(), BottomLines())
Next
AddElement(BottomLines())
BottomLines() = "; --- EndOOP - Create DataSection"
; UIID IUnknown erzeugen
AddElement(BottomLines())
BottomLines() = "; --- OOP - Create UIID IUnknown"
CreateUIID(BottomLines())
AddElement(BottomLines())
BottomLines() = "; --- EndOOP - Create UIID IUnknown"
;- TopFile
; Konstanten erzeugen
AddElement(TopLines())
TopLines() = "; --- OOP - Create Includes"
For count = 0 To max
SelectElement(ListClass(), count)
AddElement(TopLines())
TopLines() = "#__Interface" + ListClass()\ClassName + " = " + #DQUOTE$ + pathname + "Interface" + ListClass()\ClassName + ".oop" + #DQUOTE$
Next
AddElement(TopLines())
TopLines() = "; --- EndOOP - Create Includes"
; Macros erzeugen
AddElement(TopLines())
TopLines() = "; --- OOP - Create Macros"
CreateMacros(TopLines())
AddElement(TopLines())
TopLines() = "; --- EndOOP - Create Macros"
; Declare Methoden Control Object
max = ListSize(ListClass()) - 1
AddElement(TopLines())
TopLines() = "; --- OOP - Declare Control Object"
ForEach DeclareClass()
AddElement(TopLines())
TopLines() = DeclareClass()
Next
AddElement(TopLines())
TopLines() = "; --- EndOOP - Declare Control Object"
; Interface erzeugen
For count = 0 To max
ClearList(InterfaceLines())
AddElement(InterfaceLines())
InterfaceLines() = "; --- OOP - Create Interface"
SelectElement(ListClass(), count)
CreateInterface(ListClass(), InterfaceLines())
AddElement(InterfaceLines())
InterfaceLines() = "; --- EndOOP - Create Interface"
; Speicher InterfaceFile
interfacefile = pathname + "Interface" + ListClass()\ClassName + ".oop"
If CreateFile(#File, interfacefile)
ForEach InterfaceLines()
WriteStringN(#File, InterfaceLines())
Next
CloseFile(#File)
EndIf
Next
; Quell-Datei speichern
SaveFile()
EndProcedure
; ***************************************************************************************
;-Main
Main()
End
; ***************************************************************************************
DataSection
IUnknown:
Data.s "Procedure __Manage<Class>(*this)"
Data.s " Static NewList __List_<Class>.<Class>()"
Data.s " If *this"
Data.s " ChangeCurrentElement(__List_<Class>(), *this)"
Data.s " DeleteElement(__List_<Class>())"
Data.s " ProcedureReturn 0"
Data.s " Else"
Data.s " If AddElement(__List_<Class>()) = 0"
Data.s " ProcedureReturn 0"
Data.s " Else"
Data.s " ProcedureReturn @__List_<Class>()"
Data.s " EndIf"
Data.s " EndIf"
Data.s "EndProcedure"
Data.s "; -----------------------------------------------------------------------------"
Data.s "Procedure New<Class>(__parameters__)"
Data.s " Protected *this.<Class>, *self.I<Class>"
Data.s " *this = __Manage<Class>(0)"
Data.s " If *this = 0"
Data.s " ProcedureReturn 0"
Data.s " Else"
Data.s " With *this"
Data.s " \__VTable = ?__<Class>_Method"
Data.s " \__Ref = 1"
Data.s " EndWith"
Data.s " CompilerIf Defined(<Class>_InitObject, #PB_Procedure) = #True"
Data.s " *self = *this"
Data.s " *self\InitObject(__parameters__)"
Data.s " CompilerEndIf"
Data.s " ProcedureReturn *this"
Data.s " EndIf"
Data.s "EndProcedure"
Data.s "; -----------------------------------------------------------------------------"
Data.s "CompilerIf Defined(<Class>_QueryInterface, #PB_Procedure) = #False"
Data.s " Procedure <Class>_QueryInterface(*this.<Class>, *UIID, *ppv.integer)"
Data.s " "
Data.s " If (*ppv = #Null)"
Data.s " ProcedureReturn #E_INVALIDARG;"
Data.s " EndIf"
Data.s " "
Data.s " *ppv\i = #Null;"
Data.s " "
Data.s " If CompareMemory(*UIID, ?__IID_IUnknown, 16)__UIID__"
Data.s " *ppv\i = *this"
Data.s " Else"
Data.s " ProcedureReturn #E_NOINTERFACE"
Data.s " EndIf"
Data.s " "
Data.s " *this\__Ref + 1"
Data.s " ProcedureReturn #NOERROR"
Data.s " "
Data.s " EndProcedure"
Data.s "CompilerEndIf"
Data.s "; -----------------------------------------------------------------------------"
Data.s "CompilerIf Defined(<Class>_AddRef, #PB_Procedure) = #False"
Data.s " Procedure <Class>_AddRef(*this.<Class>)"
Data.s " *this\__Ref + 1"
Data.s " ProcedureReturn *this\__Ref"
Data.s " EndProcedure"
Data.s "CompilerEndIf"
Data.s "; -----------------------------------------------------------------------------"
Data.s "CompilerIf Defined(<Class>_Release, #PB_Procedure) = #False"
Data.s " Procedure <Class>_Release(*this.<Class>)"
Data.s " Protected *self.I<Class>"
Data.s " If *this = 0"
Data.s " ProcedureReturn 0"
Data.s " ElseIf *this\__Ref = 0"
Data.s " ProcedureReturn 0"
Data.s " ElseIf *this\__Ref = 1"
Data.s " CompilerIf Defined(<Class>_DestroyObject, #PB_Procedure) = #True"
Data.s " *self = *this"
Data.s " *self\DestroyObject()"
Data.s " CompilerEndIf"
Data.s " *this\__Ref = 0"
Data.s " __Manage<Class>(*this)"
Data.s " ProcedureReturn 0"
Data.s " Else"
Data.s " *this\__Ref - 1"
Data.s " ProcedureReturn *this\__Ref"
Data.s " EndIf"
Data.s " EndProcedure"
Data.s "CompilerEndIf"
Data.s "; -----------------------------------------------------------------------------"
Data.s "EEEE"
Macros:
Data.s "Define *this"
Data.s ""
Data.s "Structure __BaseClass"
Data.s " *__VTable.void"
Data.s " __Ref.l"
Data.s "EndStructure"
Data.s ""
Data.s "Macro Class(Name, Exts=__BaseClass)"
Data.s " IncludeFile #__Interface#Name"
Data.s " Structure Name Extends Exts"
Data.s "EndMacro"
Data.s ""
Data.s "Macro EndClass"
Data.s " EndStructure"
Data.s "EndMacro"
Data.s ""
Data.s "Macro Method"
Data.s " Procedure"
Data.s "EndMacro"
Data.s ""
Data.s "Macro MethodReturn"
Data.s " ProcedureReturn"
Data.s "EndMacro"
Data.s ""
Data.s "Macro EndMethod"
Data.s " EndProcedure"
Data.s "EndMacro"
Data.s ""
Data.s "Macro Overwrite"
Data.s "EndMacro"
Data.s ""
Data.s "Macro NewObject(Name)"
Data.s " New#Name()"
Data.s "EndMacro"
Data.s ""
Data.s "Macro DeleteObject(object)"
Data.s " object#\Release()"
Data.s "EndMacro"
Data.s ""
CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
Data.s "; Constance"
Data.s "#E_INVALIDARG = $80070057"
Data.s "#E_NOINTERFACE = $80004002"
Data.s "#NOERROR = $0"
Data.s "; Interfaces"
Data.s "Interface IUnknown"
Data.s " QueryInterface(a, b)"
Data.s " AddRef()"
Data.s " Release()"
Data.s "EndInterface"
Data.s "; ----------"
CompilerEndIf
Data.s "EEEE"
IID_IUnknown: ; {00000000-0000-0000-C000-000000000046}'
Data.s "DataSection"
Data.s " __IID_IUnknown : ; {00000000-0000-0000-C000-000000000046}'"
Data.s " Data.l $00000000"
Data.s " Data.w $0000, $0000"
Data.s " Data.b $C0, $00, $00 , $00 , $00, $00 , $00 , $46"
Data.s "EndDataSection"
Data.s "EEEE"
EndDataSection
; ***************************************************************************************
Für vollständige objektorientierte Programmierung gibt es Visual Studio oder C++.
Werkzeuge 1
-----------
Kommandozeile:
D:\Daten\PureBasic4\OOP\OOP-PreCompiler.exe
Argumente:
"%COMPILEFILE"
Arbeitsverzeichnis:
Name:
OOP-Precompiler Debug
Ereignis:
Vor Kompilieren/Starten
Option:
Warten bis zum beenden des Werkzeugs
Werkzeuge 2
-----------
Kommandozeile:
D:\Daten\PureBasic4\OOP\OOP-PreCompiler.exe
Argumente:
"%COMPILEFILE"
Arbeitsverzeichnis:
Name:
OOP-Precompiler
Ereignis:
Vor Kompilieren/Starten
Option:
Vor dem Erstellen dex Executable