home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD112271122000.psc / basTranslateFuncs.bas < prev    next >
Encoding:
BASIC Source File  |  2000-10-24  |  5.1 KB  |  155 lines
  1. Attribute VB_Name = "basTranslateFuncs"
  2. '    C2VB  Converts C style definitions to VB
  3. '    Copyright (C) 2000  Kimon Andreou (kimon@mindless.com)
  4. '
  5. '    This program is free software; you can redistribute it and/or modify
  6. '    it under the terms of the GNU General Public License as published by
  7. '    the Free Software Foundation; either version 2 of the License, or
  8. '    (at your option) any later version.
  9. '
  10. '    This program is distributed in the hope that it will be useful,
  11. '    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. '    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. '    GNU General Public License for more details.
  14. '
  15. '    You should have received a copy of the GNU General Public License
  16. '    along with this program; if not, write to the Free Software
  17. '    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18.  
  19.  
  20. Option Explicit
  21. Option Base 0
  22.  
  23. 'Translate a C function
  24. '
  25. 'This is the only function that has an error handler.
  26. 'This is because, this function handles unknown instructions also.
  27. Function ProcessFunction(CFunction As String) As String
  28. On Error GoTo HandleError
  29.  
  30. Dim Source As String
  31. Dim dummy As String
  32. Dim pos As Integer
  33. Dim Naming As String
  34. Dim paramList As String
  35. Dim NamePart() As String
  36. Dim Params() As String
  37. Dim FuncName As String
  38. Dim FuncType As String
  39. Dim cnt As Integer
  40. Dim TypePart() As String
  41. Dim ArgTypes() As String
  42. Dim ArgNames() As String
  43. Dim strVal1 As String
  44. Dim strVal2 As String
  45. 'Flags
  46. Dim IsProcedure As Boolean
  47. Dim IsByVal As Boolean
  48. Dim IsArray As Boolean
  49.  
  50.  
  51.  
  52. IsProcedure = False
  53. Source = Trim(CFunction)                        'Trim spaces
  54. Source = AddSpaces(Source)                      'Add in-between spaces
  55.  
  56. If Len(Source) <= 1 Then    'If empty, exit
  57.     ProcessFunction = ""
  58.     Exit Function
  59. End If
  60.  
  61. 'Get the function name and type definition
  62. pos = InStr(1, Source, "(")
  63. Naming = Left(Source, pos)
  64. Naming = Trim(Naming)
  65. paramList = Right(Source, Len(Source) - pos)
  66. paramList = Trim(paramList)
  67. NamePart = GetToken(Naming, 1, dummy, "(")
  68. Naming = Join(NamePart, " ")
  69. Naming = Trim(Naming)
  70. NamePart = GetToken(Naming, 1, dummy, vbCr)
  71. Naming = Trim(Join(NamePart, " "))
  72. NamePart = GetToken(Naming, 1, dummy, vbLf)
  73. Naming = Trim(Join(NamePart, " "))
  74. NamePart = GetToken(Naming, 1, dummy)
  75.  
  76. 'Get the argument list
  77. Params = GetToken(paramList, 1, dummy, "(")
  78. paramList = Trim(Join(Params, " "))
  79. Params = GetToken(paramList, 1, dummy, ";")
  80. paramList = Trim(Join(Params, " "))
  81. Params = GetToken(paramList, 1, dummy, ")")
  82. paramList = Trim(Join(Params, " "))
  83. Params = GetToken(paramList, 1, dummy, vbCr)
  84. paramList = Trim(Join(Params, " "))
  85. Params = GetToken(paramList, 1, dummy, vbLf)
  86. paramList = Trim(Join(Params, " "))
  87. Params = GetToken(paramList, 1, dummy, ",")
  88.  
  89. 'Set the function's name
  90. FuncName = NamePart(UBound(NamePart))
  91.  
  92. ReDim TypePart(UBound(NamePart) - 1)
  93. For cnt = 0 To UBound(TypePart)
  94.     TypePart(cnt) = NamePart(cnt)
  95. Next cnt
  96.  
  97. 'Determine if we are dealing with a function that returns a pointer/array
  98. If InStr(FuncName, "*") <> 0 Then IsByVal = False
  99. If InStr(FuncName, "**") <> 0 Then IsArray = True
  100. If InStr(FuncName, "[") <> 0 Then
  101.     IsByVal = False
  102.     IsArray = True
  103. End If
  104.  
  105. 'Get rid of the special characters and replace them with spaces
  106. NamePart = GetToken(FuncName, 1, dummy, "*")
  107. FuncName = Trim(Join(NamePart, " "))
  108. NamePart = GetToken(FuncName, 1, dummy, "[")
  109. FuncName = Trim(Join(NamePart, " "))
  110. NamePart = GetToken(FuncName, 1, dummy, "]")
  111. FuncName = Trim(Join(NamePart, " "))
  112.  
  113. 'Determine if the function is really a procedure
  114. FuncType = GetType(TypePart, IsProcedure)
  115.  
  116. 'Set the data type of the function (if any)
  117. FuncType = IIf(((Not IsByVal) Or IsArray) And (FuncType = "Byte"), "String", _
  118.     IIf(IsByVal Or IsArray, "Any", FuncType))
  119.  
  120. 'Resize the arrays that hold the argument names and types
  121. ReDim ArgNames(UBound(Params))
  122. ReDim ArgTypes(UBound(Params))
  123.  
  124. 'Loop through the parameter list
  125. For cnt = 0 To UBound(Params)
  126.     'Get the datatypes and names
  127.     ProcessArg Trim(Params(cnt)), strVal1, strVal2, , Trim(Str(cnt))
  128.     ArgNames(cnt) = strVal1
  129.     ArgTypes(cnt) = strVal2
  130. Next cnt
  131.  
  132. 'Set the declaration of the function
  133. ProcessFunction = IIf(IsPublic, "Public ", "Private ") & "Declare " & _
  134.     IIf(IsProcedure, "Sub ", "Function ") & FuncName & " Lib """ & LibraryName & """" & " ( "
  135.  
  136. 'Add the arguments
  137. ProcessFunction = ProcessFunction & ArgNames(0) & ArgTypes(0)
  138. If UBound(ArgNames) > 0 Then
  139.     For cnt = 1 To UBound(ArgNames)
  140.         ProcessFunction = ProcessFunction & ", " & ArgNames(cnt) & ArgTypes(cnt)
  141.     Next cnt
  142. End If
  143.  
  144. 'Finish the declaration of the function
  145. ProcessFunction = ProcessFunction & " ) " & IIf(IsProcedure, "", " As " & FuncType)
  146. Exit Function
  147.  
  148. 'If we have an error
  149. HandleError:
  150.     ProcessFunction = vbCrLf & "#If False Then" & vbCrLf
  151.     ProcessFunction = ProcessFunction & "'I couldn't handle the following:" & vbCrLf
  152.     ProcessFunction = ProcessFunction & CFunction & vbCrLf
  153.     ProcessFunction = ProcessFunction & "#End If" & vbCrLf
  154. End Function
  155.