Hashing with SHA512 in vba using .net libraries is not correct if input string contains any characters > chr(127). Output is being compared to PHP SHA512. Any ideas?
I have tried different text encodings.
Public Function SHA512(sIn As String) As String
Dim oT As Object, oSHA512 As Object
Dim TextToHash() As Byte, bytes() As Byte
Set oT = CreateObject("System.Text.UTF8Encoding")
Set oSHA512 = CreateObject("System.Security.Cryptography.SHA512Managed")
TextToHash = oT.GetBytes_4(sIn)
bytes = oSHA512.ComputeHash_2((TextToHash))
SHA512 = ConvToHexString(bytes)
Set oT = Nothing
Set oSHA512 = Nothing
End Function
Private Function ConvToHexString(vIn As Variant) As Variant
On Error Resume Next
Dim oD As Object
Set oD = CreateObject("MSXML2.DOMDocument.6.0")
With oD
.loadXML "<root />"
.documentElement.DataType = "bin.Hex"
.documentElement.nodeTypedValue = vIn
End With
ConvToHexString = Replace(oD.documentElement.Text, vbLf, "")
Set oD = Nothing
End Function
Private Sub Command0_Click()
Dim strg As String
strg = "abc" & Chr(148) & "defg"
MsgBox SHA512(strg)
MsgBox strg
End Sub
<?php
$strg = "abc".chr(148)."defg";
echo hash('sha512', $strg);
echo "</br>".$strg;
?>
I have concluded that the SHA512 routines produce identical results. The problem is in how I am sending the data between vba and PHP.
Related
I have been attempting to replace Office OLE in a vb6 application with LibreOffice.
I have had some success, however, I am falling short trying to search for text, then create a cursor based on the text that was found, then insert an image at that cursors point in the document.
I have been able to piece together working code that will allow me to search for text, replace text and insert an image, however, I cannot seem to figure out how to create a cursor that will allow me to insert an image at the pace where the text is that I have found . In the provided example, the [PICTUREPLACEHOLDER] text in the document.
Has anyone ever done this before and do they have any suggestions how I can create a cursor that will allow me to specify where the image will be inserted.
I have included the code for the VB6 test app so you can see the source code to see how its currently working.
Any suggestions would be very much appreciated.
Please Note - this is experimental code - very rough and ready - not final code by a long shot - just trying to figure out how this works with LibreOffice Writer.
To run this, you will need to create an empty vb6 app with a button.
You also need LibreOffice installed.
Many thanks
Rod.
Sub firstOOoProc()
Dim oSM 'Root object for accessing OpenOffice from VB
Dim oDesk, oDoc As Object 'First objects from the API
Dim arg() 'Ignore it for the moment !
'Instanciate OOo : this line is mandatory with VB for OOo API
Set oSM = CreateObject("com.sun.star.ServiceManager")
'Create the first and most important service
Set oDesk = oSM.createInstance("com.sun.star.frame.Desktop")
Dim oProvider As Object
Set oProvider = oSM.createInstance("com.sun.star.graphic.GraphicProvider")
'Open an existing doc (pay attention to the syntax for first argument)
Set oDoc = oDesk.loadComponentFromURL("file:///c:/dev/ooo/testfile.doc", "_blank", 0, arg())
' now - replace some text in the document
Dim Txt
Txt = oDoc.GetText
Dim TextCursor
TextCursor = Txt.CreateTextCursor
' attempt to replace some text
Dim SearchDescriptor
Dim Replace
Replace = oDoc.createReplaceDescriptor
Replace.SearchString = "[TESTDATA1]"
Replace.ReplaceString = "THIS IS A TEST"
oDoc.replaceAll Replace
Dim searchCrtiteria
SearchDescriptor = oDoc.createReplaceDescriptor
' Now - attempt try to replace some text with an image
SearchDescriptor.setSearchString ("[PICTUREPLACEHOLDER]")
SearchDescriptor.SearchRegularExpression = False
Dim Found
Found = oDoc.findFirst(SearchDescriptor)
' create cursor to know where to insert the image
Dim oCurs As Object
Set thing = oDoc.GetCurrentController
Set oCurs = thing.GetViewCursor
' make hte call to insert an image from a file into the document
InsertImage oDoc, oCurs, "file:///c:/dev/ooo/imagefilename.jpg", oProvider
'Save the doc
Call oDoc.storeToURL("file:///c:/dev/ooo/test2.sxw", arg())
'Close the doc
oDoc.Close (True)
Set oDoc = Nothing
oDesk.Terminate
Set oDesk = Nothing
Set oSM = Nothing
End Sub
Function createStruct(strTypeName)
Set classSize = objCoreReflection.forName(strTypeName)
Dim aStruct
classSize.CreateObject aStruct
Set createStruct = aStruct
End Function
Sub InsertImage(ByRef oDoc As Object, ByRef oCurs As Object, sURL As String, ByRef oProvider As Object)
' Init variables and instance object
Dim oShape As Object
Dim oGraph As Object
Set oShape = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
Set oGraph = oDoc.createInstance("com.sun.star.text.GraphicObject")
'Set oProvider = serviceManager.CreateInstance("com.sun.star.graphic.GraphicProvider")
' Add shape to document
oDoc.getDrawPage.Add oShape
' Set property path of picture
Dim oProps(0) As Object
Set oProps(0) = MakePropertyValue("URL", sURL)
' Get size from picture to load
Dim oSize100thMM
Dim lHeight As Long
Dim lWidth As Long
Set oSize100thMM = RecommendGraphSize(oProvider.queryGraphicDescriptor(oProps))
If Not oSize100thMM Is Nothing Then
lHeight = oSize100thMM.Height
lWidth = oSize100thMM.Width
End If
' Set size and path property to shape
oShape.graphic = oProvider.queryGraphic(oProps)
' Copy shape in graphic object and set anchor type
oGraph.graphic = oShape.graphic
oGraph.AnchorType = 1 'com.sun.star.Text.TextContentAnchorType.AS_CHARACTER
' Remove shape and resize graphix
Dim oText As Object
Set oText = oCurs.GetText
oText.insertTextContent oCurs, oGraph, False
oDoc.getDrawPage.Remove oShape
If lHeight > 0 And lWidth > 0 Then
Dim oSize
oSize = oGraph.Size
oSize.Height = lHeight * 500
oSize.Width = lWidth * 500
oGraph.Size = oSize
End If
End Sub
'
'Converts a Ms Windows local pathname in URL (RFC 1738)
'Todo : UNC pathnames, more character conversions
'
Public Function ConvertToUrl(strFile) As String
strFile = Replace(strFile, "\", "/")
strFile = Replace(strFile, ":", "|")
strFile = Replace(strFile, " ", "%20")
strFile = "file:///" + strFile
ConvertToUrl = strFile
End Function
'
'Creates a sequence of com.sun.star.beans.PropertyValue s
'
Public Function MakePropertyValue(cName, uValue) As Object
Dim oStruct, oServiceManager As Object
Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
Set oStruct = oServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
oStruct.Name = cName
oStruct.Value = uValue
Set MakePropertyValue = oStruct
End Function
'
'A simple shortcut to create a service
'
Public Function CreateUnoService(strServiceName) As Object
Dim oServiceManager As Object
Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
Set CreateUnoService = oServiceManager.createInstance(strServiceName)
End Function
Public Function RecommendGraphSize(oGraph)
Dim oSize
Dim lMaxW As Double
Dim lMaxH As Double
lMaxW = 6.75 * 2540
lMaxH = 9.5 & 2540
If IsNull(oGraph) Or IsEmpty(oGraph) Then
Exit Function
End If
oSize = oGraph.Size100thMM
If oSize.Height = 0 Or oSize.Width = 0 Then
oSize.Height = oGraph.SizePixel.Height * 2540# * Screen.TwipsPerPixelY() '/ 1440
oSize.Width = oGraph.SizePixel.Width * 2540# * Screen.TwipsPerPixelX() '/ 1440
End If
If oSize.Height = 0 Or oSize.Width = 0 Then
Exit Function
End If
If oSize.Width > lMaxW Then
oSize.Height = oSizeHeight * lMax / oSize.Width
oSize.Width = lMaxW
End If
If oSize.Height > lMaxH Then
oSize.Width = oSize.Width * lMaxH / oSize.Height
oSize.Height = lMaxH
End If
RecommendGraphSize = oSize
End Function
Private Sub Command1_Click()
firstOOoProc
End Sub
The content of the testFile.Doc file is as shown below:
This is a test File
[TESTDATA1]
[PICTUREPLACEHOLDER]
It looks like you need to move the view cursor to the found location.
Found = oDoc.findFirst(SearchDescriptor)
oVC = oDoc.getCurrentController().getViewCursor()
oVC.gotoRange(Found, False)
oVC.setString("")
I have the following 2 functions which give me the base64 of an image
Option Compare Database
Option Explicit
Function readBytes(strFile As String) As Variant
Const TypeBinary = 1
Dim inStream As Object
' ADODB stream object used
Set inStream = CreateObject("ADODB.Stream")
' open with no arguments makes the stream an empty container
inStream.Open
inStream.Type = TypeBinary
inStream.LoadFromFile strFile
readBytes = inStream.Read()
End Function
Function encodeBase64(arrBytes As Variant) As String
Dim DM As Object, EL As Object
Set DM = CreateObject("Microsoft.XMLDOM")
' Create temporary node with Base64 data type
Set EL = DM.createElement("tmp")
EL.dataType = "bin.base64"
' Set bytes, get encoded String
EL.nodeTypedValue = arrBytes
encodeBase64 = EL.Text
End Function
Sub test()
TestIt CurrentProject.Path & "\pic.jpg"
End Sub
Function TestIt(strFile As String) As String
Dim arrBytes As Variant, strRet As String
arrBytes = readBytes(strFile)
strRet = encodeBase64(arrBytes)
Dim s As String
Open CurrentProject.Path & "\pic_base64.txt" For Binary As #1
Put #1, 1, strRet
Close #1
End Function
I need to convert the following 2 functions to same VBA format as the functions above and add an additional test function which will take the base64 converted image string from the above function and write it back to the image pic.jpg
private function decodeBase64(base64)
dim DM, EL
Set DM = CreateObject("Microsoft.XMLDOM")
' Create temporary node with Base64 data type
Set EL = DM.createElement("tmp")
EL.DataType = "bin.base64"
' Set encoded String, get bytes
EL.Text = base64
decodeBase64 = EL.NodeTypedValue
end function
private Sub writeBytes(file, bytes)
Dim binaryStream
Set binaryStream = CreateObject("ADODB.Stream")
binaryStream.Type = TypeBinary
'Open the stream and write binary data
binaryStream.Open
binaryStream.Write bytes
'Save binary data to disk
binaryStream.SaveToFile file, ForWriting
End Sub
I have a button and I pass String as parameter. If string parameter increase more that 255 characters, it doesn't get any value. If string parameter is less than 255 characters, it is working fine.
Here is my code:
Dim parameterText As String
parameterText = "First Parameter Value | Third Parameter Value | Third Parameter Value"
Dim AdviceItem As CommandBarButton
Set AdviceItem = CategoryItem.Controls.Add(msoControlButton, , , , True)
With AdviceItem
.Caption = adviceText
.Visible = True
.Parameter = strParameter
.OnAction = "myFunction"
End With
Sub myFunction()
Dim parameters() As String
ReDim parameters(3)
Dim parameterText As String
parameterText = Application.CommandBars.ActionControl.Parameter
'parameterText is blank if there are more than 255 characters passed from above function
MsgBox ("parameterText" & parameterText)
parameters() = Split(parameterText, "|")
End Sub
Can anybody suggest me how to achieve it?
Assuming that there is a limitation on the .parameter, you can bypass this by using an array to store the string you want to display.
Option Explicit
Public AllParameters(100) As String
Public AllAdviceTexts(100) as String
Sub defineParameters()
AllParameters(0) = "First Parameter Value"
AllParameters(1) = "Third Parameter Value "
AllParameters(2) = "Third Parameter Value "
'etc
'set advice texts here too
End Sub
Private Sub Workbook_Open()
Dim AdviceItem As CommandBarButton
Dim i As Integer
Call defineParameters
For i = 0 To 100
Set AdviceItem = CategoryItem.Controls.Add(msoControlButton, , , , True)
With AdviceItem
.Caption = AllAdviceTexts(i)
.Visible = True
.Parameter = i
.OnAction = "myFunction"
End With
Next i
End Sub
Sub myFunction()
Dim parameterText As String
Dim index As Integer
index = Application.CommandBars.ActionControl.Parameter
parameterText = AllParameters(index)
MsgBox ("parameterText" & parameterText)
End Sub
No its not. VB string type can hold data more than 255 character.
A variable-length string can contain up to approximately 2 billion (2^31) characters
A fixed-length string can contain 1 to approximately 64K (2^16) characters.
and for SPLIT you can try like below
Dim LString As String
Dim LArray() As String
LString = "foobar.com"
LArray = Split(LString, ".")
MsgBox LArray(0)
MsgBox LArray(1)
Note: https://msdn.microsoft.com/en-us/library/6x627e5f(v=vs.90).aspx
Try to use below code if you get some idea.
Function Over255()
Dim myArray(3) As String '<<<<< not variant
myArray(0) = String(300, "a")
myArray(1) = String(300, "b")
myArray(2) = String(300, "c")
myArray(3) = String(300, "d")
'Over255 = Application.Transpose(myArray())
Over255 = TR(myArray)
End Function
'like Application.Transpose...
Function TR(arrIn) As String()
Dim arrOut() As String, r As Long, ln As Long, i As Long
ln = (UBound(arrIn) - LBound(arrIn)) + 1
ReDim arrOut(1 To ln, 1 To 1)
i = 1
For r = LBound(arrIn) To UBound(arrIn)
arrOut(i, 1) = arrIn(r)
i = i + 1
Next r
TR = arrOut
End Function
I'm trying to use IEdmEnumeratorVariable5::SetVar to update some file card variables based on user input into a windows form. My code executes, there are no error messages, the file is checked out and checked back in and the appropriate comment is added to the history; however the variables on the card are not updated.
I have verified by stepping through code at runtime that all variables are populated with the correct (as expected) data. The SetVar procedures all go off without a hitch, but the variables on the data card do not change value - even manually refreshing the folder view has no effect.
Below is my code.
This is an add-in application, written as a class-library project in VB using VS Community 2015, with target framework .NET 4.0.
In efforts to make this question more concise; immediately below I've included just the snippet of code doing the set variables work, then I've also included more code so you can get the whole picture if needed.
JUST THE TIP :
This is the code doing the set variables work:
Dim UserManager As IEdmUserMgr5 = .SourceVault
Dim User As IEdmUser5 = UserManager.GetLoggedInUser
CardComment = UserComment & CardComment
CardDate = Today().ToString("yyMMdd", Globalization.CultureInfo.InvariantCulture)
CardBy = User.Name
CardDisposition = UserDisposition
CardVariables.SetVar(DispositionVariable, "#", CardDisposition)
CardVariables.SetVar(CommentVariable, "#", CardComment)
CardVariables.SetVar(ByVariable, "#", CardBy)
CardVariables.SetVar(DateVariable, "#", CardDate)
CardVariables.Flush()
THE BROADER STROKES :
Class module level variables:
Private Structure CommandInfo
Dim SourceVault As IEdmVault11
Dim SourceCommand As EdmCmd
Dim SourceSelection As System.Array
Dim TargetTemplate As System.String
Dim VerifiedPaths As List(Of String)
End Structure
Private ReceivedCommand As CommandInfo
OnCmd procedure (caller):
Public Sub OnCmd(ByRef poCmd As EdmCmd,
ByRef ppoData As System.Array) Implements IEdmAddIn5.OnCmd
Dim CommandToRun As MenuCommand
Try
With ReceivedCommand
.SourceVault = poCmd.mpoVault
.SourceCommand = poCmd
.SourceSelection = ppoData
'Get the command structure for the command ID
Select Case poCmd.meCmdType
Case EdmCmdType.EdmCmd_Menu
CommandToRun = AvailableCommands(.SourceCommand.mlCmdID)
Case EdmCmdType.EdmCmd_CardButton
Select Case True
Case poCmd.mbsComment.ToString.ToUpper.Contains("DISPOSITION")
DispositionRequest()
Case Else : Exit Sub
End Select
Case Else : Exit Sub
End Select
'...... (End Try, End Sub, Etc.)
DispositionRequest procedure (callee):
Private Sub DispositionRequest()
Dim UserDisposition As String
Using Disposition As New DispositionForm
With Disposition
If Not .ShowDialog() = System.Windows.Forms.DialogResult.OK Then Exit Sub
Select Case True
Case .Approve.Checked
UserDisposition = "Approved"
Case .Reject.Checked
UserDisposition = "Rejected"
Case Else : Exit Sub
End Select
End With
End Using
Dim UserComment As String
Using Explanation As New DispositionExplanation
With Explanation
If Not .ShowDialog() = System.Windows.Forms.DialogResult.OK Then Exit Sub
If .ListView1.Items.Count > 0 Then
'do some stuff not relevant to this question...
End If
UserComment = .Comments.Text
End With
End Using
'This next procedure just gets a list of paths from ReceivedCommand.SourceSelection - which is just the ppoData argument from the OnCmd procedure - see code block above!
Dim RequestPaths As List(Of String) = GetSelectedFilePaths()
For Each Path As String In RequestPaths
With ReceivedCommand
Dim RequestFile As IEdmFile5 = .SourceVault.GetFileFromPath(Path)
Dim ParentFolder As IEdmFolder6 = .SourceVault.GetFolderFromPath(System.IO.Path.GetDirectoryName(Path))
Dim UnlockLater As Boolean = False
If Not RequestFile.IsLocked Then
UnlockLater = True
RequestFile.LockFile(ParentFolder.ID, .SourceCommand.mlParentWnd, CInt(EdmLockFlag.EdmLock_Simple))
End If
Dim CardVariables As IEdmEnumeratorVariable5 = RequestFile.GetEnumeratorVariable
'We allow users to re-disposition a request so we want to keep any previous disposition information so it is not lost
Dim CardComment As String = String.Empty
Dim CardBy As String = String.Empty
Dim CardDate As String = String.Empty
Dim CardDisposition As String = String.Empty
Dim Success As Boolean
Const CommentVariable As String = "DispComm"
Const ByVariable As String = "DisposedBy"
Const DateVariable As String = "DisposedDate"
Const DispositionVariable As String = "Disposition"
Success = CardVariables.GetVar(DispositionVariable, "#", CardDisposition)
If Success Then
Success = CardVariables.GetVar(CommentVariable, "#", CardComment)
If Success Then Success = CardVariables.GetVar(ByVariable, "#", CardBy)
If Success Then Success = CardVariables.GetVar(DateVariable, "#", CardDate)
If Success Then CardComment = "Previously dispositioned as: """ & CardDisposition & """ by: " & CardBy & " on: " & CardDate & vbNewLine &
"---------Previous disposition explanation---------" & vbNewLine & CardComment
End If
Dim UserManager As IEdmUserMgr5 = .SourceVault
Dim User As IEdmUser5 = UserManager.GetLoggedInUser
CardComment = UserComment & CardComment
CardDate = Today().ToString("yyMMdd", Globalization.CultureInfo.InvariantCulture)
CardBy = User.Name
CardDisposition = UserDisposition
CardVariables.SetVar(DispositionVariable, "#", CardDisposition)
CardVariables.SetVar(CommentVariable, "#", CardComment)
CardVariables.SetVar(ByVariable, "#", CardBy)
CardVariables.SetVar(DateVariable, "#", CardDate)
CardVariables.Flush()
If UnlockLater Then RequestFile.UnlockFile(lParentWnd:= .SourceCommand.mlParentWnd,
bsComment:="Dispositioned as " & CardDisposition,
lEdmUnlockFlags:=0)
.SourceVault.RefreshFolder(ParentFolder.LocalPath)
End With
Next
End Sub
From the documentation:
bsCfgName : Name of configuration or layout to which to store the variable value; empty string for folders and file types that do not support configurations
I was working with a virtual file, which did not support configurations.
I saw a C example working with a virtual file and they were passing null references, so I reread the documentation and saw that excerpt above, so I changed my code from "#" to String.Empty for the mboconfiguration argument and now it is working!
CardVariables.SetVar(DispositionVariable, String.Empty, CardDisposition)
CardVariables.SetVar(CommentVariable, String.Empty, CardComment)
CardVariables.SetVar(ByVariable, String.Empty, CardBy)
CardVariables.SetVar(DateVariable, String.Empty, CardDate)
CardVariables.Flush()
Is there any way, in either VBA or C# code, to get a list of the existing macros defined in a workbook?
Ideally, this list would have a method definition signatures, but just getting a list of the available macros would be great.
Is this possible?
I haven't done vba for Excel in a long time, but if I remember well, the object model for the code was inaccessible through scripting.
When you try to access it, you receive the following error.
Run-time error '1004':
Programmatic access to Visual Basic Project is not trusted
Try:
Tools | Macro | Security |Trusted Publisher Tab
[x] Trust access to Visual Basic Project
Now that you have access to the VB IDE, you could probably export the modules and make a text search in them, using vba / c#, using regular expressions to find sub and function declarations, then delete the exported modules.
I'm not sure if there is an other way to do this, but this should work.
You can take a look the following link, to get started with exporting the modules.
http://www.developersdex.com/vb/message.asp?p=2677&ID=%3C4FCD0AE9-5DCB-4A96-8B3C-F19C63CD3635%40microsoft.com%3E
This is where I got the information about giving thrusted access to the VB IDE.
Building on Martin's answer, after you trust access to the VBP, you can use this set of code to get an array of all the public subroutines in an Excel workbook's VB Project. You can modify it to only include subs, or just funcs, or just private or just public...
Private Sub TryGetArrayOfDecs()
Dim Decs() As String
DumpProcedureDecsToArray Decs
End Sub
Public Function DumpProcedureDecsToArray(ByRef Result() As String, Optional InDoc As Excel.Workbook) As Boolean
Dim VBProj As Object
Dim VBComp As Object
Dim VBMod As Object
If InDoc Is Nothing Then Set InDoc = ThisWorkbook
ReDim Result(1 To 1500, 1 To 4)
DumpProcedureDecsToArray = True
On Error GoTo PROC_ERR
Set VBProj = InDoc.VBProject
Dim FuncNum As Long
Dim FuncDec As String
For Each VBComp In VBProj.vbcomponents
Set VBMod = VBComp.CodeModule
For i = 1 To VBMod.countoflines
If IsSubroutineDeclaration(VBMod.Lines(i, 1)) Then
FuncDec = RemoveBlanksAndDecsFromSubDec(RemoveAsVariant(VBMod.Lines(i, 1)))
If LCase(Left(VBMod.Lines(i, 1), Len("private"))) <> "private" Then
FuncNum = FuncNum + 1
Result(FuncNum, 1) = FindToLeftOfString(InDoc.Name, ".") '
Result(FuncNum, 2) = VBMod.Name
Result(FuncNum, 3) = GetSubName(FuncDec)
Result(FuncNum, 4) = VBProj.Name
End If
End If
Next i
Next VBComp
PROC_END:
Exit Function
PROC_ERR:
GoTo PROC_END
End Function
Private Function RemoveCharFromLeftOfString(TheString As String, RemoveChar As String) As String
Dim Result As String
Result = TheString
While LCase(Left(Result, Len(RemoveChar))) = LCase(RemoveChar)
Result = Right(Result, Len(Result) - Len(RemoveChar))
Wend
RemoveCharFromLeftOfString = Result
End Function
Private Function RemoveBlanksAndDecsFromSubDec(TheLine As String) As String
Dim Result As String
Result = TheLine
Result = RemoveCharFromLeftOfString(Result, " ")
Result = RemoveCharFromLeftOfString(Result, " ")
Result = RemoveCharFromLeftOfString(Result, "Public ")
Result = RemoveCharFromLeftOfString(Result, "Private ")
Result = RemoveCharFromLeftOfString(Result, " ")
RemoveBlanksAndDecsFromSubDec = Result
End Function
Private Function RemoveAsVariant(TheLine As String) As String
Dim Result As String
Result = TheLine
Result = Replace(Result, "As Variant", "")
Result = Replace(Result, "As String", "")
Result = Replace(Result, "Function", "")
If InStr(1, Result, "( ") = 0 Then
Result = Replace(Result, "(", "( ")
End If
RemoveAsVariant = Result
End Function
Private Function IsSubroutineDeclaration(TheLine As String) As Boolean
If LCase(Left(RemoveBlanksAndDecsFromSubDec(TheLine), Len("Function "))) = "function " Or LCase(Left(RemoveBlanksAndDecsFromSubDec(TheLine), Len("sub "))) = "sub " Then
IsSubroutineDeclaration = True
End If
End Function
Private Function GetSubName(DecLine As String) As String
GetSubName = FindToRightOfString(FindToLeftOfString(DecLine, "("), " ")
End Function
Function FindToLeftOfString(FullString As String, ToFind As String) As String
If FullString = "" Then Exit Function
Dim Result As String, ToFindPos As Integer
ToFindPos = InStr(1, FullString, ToFind, vbTextCompare)
If ToFindPos > 0 Then
Result = Left(FullString, ToFindPos - 1)
Else
Result = FullString
End If
FindToLeftOfString = Result
End Function
Function FindToRightOfString(FullString As String, ToFind As String) As String
If FullString = "" Then Exit Function
Dim Result As String, ToFindPos As Integer
ToFindPos = InStr(1, FullString, ToFind, vbTextCompare)
Result = Right(FullString, Len(FullString) - ToFindPos + 1 - Len(ToFind))
If ToFindPos > 0 Then
FindToRightOfString = Result
Else
FindToRightOfString = FullString
End If
End Function