But the one from Pellen-C is very good and creates a COM type library file. Here a big thanks to Pelle.
This can be converted to Purebasic with the tool. I have tested this with the OPC automation interface.
But it must be extended in the tool surely still some things.
Update 1.01.1
- Bugfix ByVal Variant_Bool
ComTypeLibImporter.pb
Code: Select all
;-TOP
; Comment : COM TypeLibrary Importer ('C' -> PB)
; Author : mk-soft
; Version : v1.01.1
; Create : 31.07.2020
EnableExplicit
Global NewList Lines.s()
Global NewList Interfaces.s()
Global NewList Enumerations.s()
Global NewList GUIDs.s()
Macro AddElementValue(_List_, _Value_)
AddElement(_List_) : _List_ = _Value_
EndMacro
; ++++
Procedure SplitParameters(Line.s, Array Args.s(1), Part = 1)
Protected param.s, index, cnt, pos
For index = 1 To Part
pos = FindString(Line, "(", pos)
If pos
pos + 1
EndIf
Next
param = Mid(Line, pos)
pos = FindString(param, ")")
If pos
param = Left(param, pos - 1)
EndIf
cnt = CountString(param, ",")
Dim Args(cnt)
For index = 0 To cnt
Args(index) = Trim(StringField(param, index + 1, ","))
Next
ProcedureReturn cnt + 1
EndProcedure
; ++++
Procedure OpenTypeLibFile(FileName.s, List Result.s())
Protected file, bom
file = ReadFile(#PB_Any, FileName)
If Not file
ProcedureReturn 0
EndIf
ClearList(Result())
bom = ReadStringFormat(file)
While Not Eof(file)
AddElement(Result())
Result() = ReadString(file, bom)
Wend
CloseFile(file)
ProcedureReturn ListSize(Result())
EndProcedure
; ----
Procedure FindEnumerations(List Lines.s(), List Result.s())
Protected line.s, find, cnt
ClearList(Result())
AddElementValue(Result(), "; *** Constants ***")
AddElementValue(Result(), "")
ForEach Lines()
line = Lines()
If Not find And FindString(LCase(Line), "typedef enum ")
find = #True
cnt + 1
line = Trim(line)
line = Trim(line, #TAB$)
line = RTrim(line, "{")
line = RTrim(line)
line = ReplaceString(line, "typedef enum", "Enumeration")
AddElementValue(Result(), line)
Continue
EndIf
If find
If FindString(line, "}")
find = #False
AddElementValue(Result(), "EndEnumeration")
AddElementValue(Result(), "")
Continue
EndIf
line = Trim(line)
line = Trim(line, #TAB$)
line = RTrim(line, ",")
line = Trim(line)
line = " #" + line
AddElementValue(Result(), line)
Continue
EndIf
Next
ProcedureReturn cnt
EndProcedure
; ----
Procedure FindGUIDs(List Lines.s(), List Result.s())
Protected index, line.s, find, cnt, comment.s, temp.s
Dim Args.s(0)
ClearList(Result())
AddElementValue(Result(), "; *** GUIDs ***")
AddElementValue(Result(), "")
AddElementValue(Result(), "DataSection")
ForEach Lines()
line = Lines()
If FindString(UCase(Line), "/*")
comment = "; " + line
Continue
EndIf
If FindString(UCase(Line), "DEFINE_GUID")
line = ReplaceString(line, "0x", "$")
cnt + 1
If SplitParameters(line, Args()) = 12
AddElementValue(Result(), " " + Args(0) + ": " + comment)
AddElementValue(Result(), " Data.l " + Args(1))
AddElementValue(Result(), " Data.w " + Args(2) + ", " + Args(3))
temp = " Data.b " + Args(4)
For index = 5 To 11
temp + ", " + Args(index)
Next
AddElementValue(Result(), temp)
AddElementValue(Result(), "")
EndIf
EndIf
comment = ""
Next
AddElementValue(Result(), "EndDataSection")
AddElementValue(Result(), "")
ProcedureReturn cnt
EndProcedure
; ----
Procedure.s ConvertParam(Line.s, Part = 1)
Protected result.s, param.s, pos, cnt, index, arg.s
For index = 1 To Part
pos = FindString(Line, "(", pos)
If pos
pos + 1
EndIf
Next
param = Mid(Line, pos)
pos = FindString(param, ")")
If pos
param = Left(param, pos - 1)
EndIf
param = LCase(param)
cnt = CountString(param, ",") + 1
For index = 1 To cnt
arg = Trim(StringField(param, index, ","))
If arg = "this"
Continue
ElseIf Right(arg, 2) = "**"
result + "*p_" + Left(arg, Len(arg) - 2)
ElseIf Right(arg, 1) = "*"
result + "*" + Left(arg, Len(arg) - 1)
ElseIf arg = "bstr"
result + arg + ".p-bstr"
ElseIf arg = "variant"
result + arg + ".p-variant"
ElseIf arg = "variant_bool"
result + arg + ".p-variant"
Else
result + arg
EndIf
If index < cnt
result + ", "
EndIf
Next
ProcedureReturn result
EndProcedure
Procedure FindInterfaces(List Lines.s(), List Result.s())
Protected line.s, find, cnt, name.s, ext.s, *element, pos, param.s, info.s
ClearList(Result())
AddElementValue(Result(), "; *** Interfaces ***")
AddElementValue(Result(), "")
ForEach Lines()
line = Lines()
If Not find And FindString(UCase(Line), "DECLARE_INTERFACE")
find = #True
cnt + 1
name = Mid(line, FindString(line, "(") + 1)
name = Left(name, FindString(name, ")") - 1)
*element = @Lines()
While NextElement(Lines())
line = Lines()
If FindString(line, "}")
Break
EndIf
If FindString(UCase(line), "RELEASE)")
*element = @Lines()
ext = " Extends IUnknown"
EndIf
If FindString(UCase(line), "INVOKE)")
*element = @Lines()
ext = " Extends IDispatch"
EndIf
Wend
ChangeCurrentElement(Lines(), *element)
AddElementValue(Result(), "CompilerIf Defined(" + name + ", #PB_Interface) = #False")
AddElementValue(Result(), " Interface " + name + ext)
ext = ""
Continue
EndIf
If find
If FindString(line, "}")
find = #False
AddElementValue(Result(), " EndInterface")
AddElementValue(Result(), "CompilerEndIf")
AddElementValue(Result(), "")
Continue
EndIf
If FindString(UCase(line), "STDMETHOD")
name = Mid(line, FindString(line, "(") + 1)
name = Left(name, FindString(name, ")") - 1)
If FindString(name, ",")
info = " ; " + Trim(StringField(name, 1, ","))
name = Trim(StringField(name, 2, ","))
Else
info = ""
EndIf
param = "(" + ConvertParam(line, 2) + ")"
AddElementValue(Result(), " " + name + param + info)
Continue
EndIf
EndIf
Next
ProcedureReturn cnt
EndProcedure
; ----
Procedure Convert(sourceFile.s, destFile.s)
Protected file
If sourceFile = ""
ProcedureReturn 0
EndIf
If destFile = ""
ProcedureReturn 0
EndIf
If sourceFile = destFile
ProcedureReturn 0
EndIf
If FileSize(destFile) >= 0
If MessageRequester("Questions", "Overwrite file:" + #LF$ + destFile, #PB_MessageRequester_YesNo | #PB_MessageRequester_Warning) = #PB_MessageRequester_No
ProcedureReturn 0
EndIf
EndIf
If OpenTypeLibFile(sourceFile, Lines())
FindEnumerations(Lines(), Enumerations())
FindGUIDs(Lines(), GUIDs())
FindInterfaces(Lines(), Interfaces())
file = CreateFile(#PB_Any, destFile)
If file
WriteStringFormat(file, #PB_UTF8)
WriteStringN(file, "; Created with COM TypeLibrary Importer ('C' -> PB) v1.01", #PB_UTF8)
WriteStringN(file, "; ", #PB_UTF8)
WriteStringN(file, "; Source: " + sourceFile, #PB_UTF8)
WriteStringN(file, "; Create: " + FormatDate("%YYYY/%MM/%DD %HH:%II:%SS", Date()), #PB_UTF8)
WriteStringN(file, "", #PB_UTF8)
ForEach Interfaces()
WriteStringN(file, Interfaces(), #PB_UTF8)
Next
ForEach Enumerations()
WriteStringN(file, Enumerations(), #PB_UTF8)
Next
ForEach GUIDs()
WriteStringN(file, GUIDs(), #PB_UTF8)
Next
CloseFile(file)
ProcedureReturn 1
Else
MessageRequester("Error", "Create File" + #LF$ + destFile, #PB_MessageRequester_Error)
ProcedureReturn 0
EndIf
Else
MessageRequester("Error", "Open File" + #LF$ + sourceFile, #PB_MessageRequester_Error)
ProcedureReturn 0
EndIf
EndProcedure
; ****
;-Main Window
; -----------------------------------------------------------------------------
Enumeration FormWindow
#Main
EndEnumeration
Enumeration FormGadget
#MainTextSource
#MainTextDest
#MainStringSource
#MainStringDest
#MainButtonSource
#MainButtonDest
#MainCheckBox
#MainButtonStart
#MainButtonQuit
EndEnumeration
Enumeration FormStatusBar
#MainStatusBar
EndEnumeration
; -----------------------------------------------------------------------------
Global sourceFile.s, destFile.s
Procedure Main()
Protected event
#MainWidth = 440
#MainHeight = 190
#MainStyle = #PB_Window_SystemMenu | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget
If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, #MainWidth, #MainHeight, "COM TypeLibrary Importer ('C' -> PB)", #MainStyle)
;-- Create StatusBar
CreateStatusBar(#MainStatusBar, WindowID(#Main))
AddStatusBarField(#PB_Ignore)
;-- Create Gadget
TextGadget(#MainTextSource, 10, 10+5, 90, 25, "TypeLib file:")
TextGadget(#MainTextDest, 10, 45+5, 90, 25, "Converted file:")
StringGadget(#MainStringSource, 100, 10, 290, 25, "", #PB_String_ReadOnly)
StringGadget(#MainStringDest, 100, 45, 290, 25, "", #PB_String_ReadOnly)
ButtonGadget(#MainButtonSource, 400, 10, 30, 25, "...")
ButtonGadget(#MainButtonDest, 400, 45, 30, 25, "...")
CheckBoxGadget(#MainCheckBox, 10, 80, 300, 25, "Prozess the whole directory")
ButtonGadget(#MainButtonStart, 10, 120, 200, 30, "Start conversion")
ButtonGadget(#MainButtonQuit, 440-210, 120, 200, 30, "Quit")
;-- EventLoop
Repeat
event = WaitWindowEvent()
Select event
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case #MainButtonSource
sourceFile = OpenFileRequester("TypeLib Files", "", "", 0)
If sourceFile
SetGadgetText(#MainStringSource, sourceFile)
If GetGadgetState(#MainCheckBox)
destFile = GetPathPart(sourceFile) + GetFilePart(sourceFile, #PB_FileSystem_NoExtension) + ".pbi"
SetGadgetText(#MainStringDest, destFile)
EndIf
EndIf
Case #MainButtonDest
If Not GetGadgetState(#MainCheckBox)
destFile = SaveFileRequester("PB Files", "", "", 0)
If destFile
SetGadgetText(#MainStringDest, destFile)
EndIf
EndIf
Case #MainCheckBox
If GetGadgetState(#MainCheckBox)
destFile = GetPathPart(sourceFile) + GetFilePart(sourceFile, #PB_FileSystem_NoExtension) + ".pbi"
SetGadgetText(#MainStringDest, destFile)
EndIf
Case #MainButtonStart
StatusBarText(#MainStatusBar, 0, "Start ...")
If Convert(sourceFile, destFile)
StatusBarText(#MainStatusBar, 0, "Ready.")
Else
StatusBarText(#MainStatusBar, 0, "Error.")
EndIf
Case #MainButtonQuit
Break
EndSelect
EndSelect
ForEver
;-- ExitProgram
EndIf
EndProcedure : Main()