COM TypeLibrary Importer - 'C' to PB

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
Post Reply
User avatar
mk-soft
Always Here
Always Here
Posts: 5393
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

COM TypeLibrary Importer - 'C' to PB

Post by mk-soft »

Unfortunately the TypeLib importers for Purebasic 'OLE/COM Generator' and 'Interfaces Importer' are very old and still have errors. Also there is no code for them.

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()
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
RSrole
User
User
Posts: 36
Joined: Fri Apr 29, 2022 8:27 pm

Re: COM TypeLibrary Importer - 'C' to PB

Post by RSrole »

Do you have a link to the Pelle TypeLib program?

Thanks
Russ
Top
User avatar
mk-soft
Always Here
Always Here
Posts: 5393
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: COM TypeLibrary Importer - 'C' to PB

Post by mk-soft »

Link: http://www.smorgasbordet.com/pellesc/
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
Post Reply

Return to “Applications - Feedback and Discussion”