I am working on a vb.net application and I am struggling to get this function to run in parallel. This is a legacy application, I was told that it uses an event-based asynchronous pattern, but I do not exactly understand what that means for this problem.
There is a for loop that runs a function serially, but I would like to run it in parallel.
Public Function Execute() As Boolean
Dim ret As Boolean = True
' If output files are not specified, then they will be generated based on the study name
If CancelExecution Then Return CancelCleanUp()
If ValidateInputFiles() Then
If CancelExecution Then Return CancelCleanUp()
Select Case _Name
Case "Main Single"
' This is the for loop I would like to run in parallel
For Each cc As IOFile In _CCards
If ValidateOutputFiles(cc.FileName) Then
ret = RunModel(cc)
If CancelExecution Then Return CancelCleanUp()
Else
ret = False
End If
Next
' The other Cases are irrelevant
End Select
Else
ret = False
End If
Return ret
End Function
Private Function RunModel(cCard As IOFile) As Boolean
Dim uFile As String
Dim ret As Boolean = True
If CancelExecution Then Return CancelCleanUp()
' create the uconfiguration file
If _RunNumber > 0 Then
uFile = MakeUFile(cCard, _InputFiles, _OutputFiles, _RunNumber)
Else
uFile = MakeUFile(cCard, _InputFiles, _OutputFiles)
End If
' Input: was not part of the vb 6 IInputModel class, but added in this version
' Main: delete files mainmodel is about to create (even the optional files) (calls CleanUpSingleRun)
ret = KillIOFiles(_OutputFiles)
' execute the application
If File.Exists(uFile) Then
Dim arg As String = """" & uFile & """"
If _Name = "Main Single Sensitivity" Then
' 7/27/2105 add an argument for either single or production run - this is a single run module
arg = arg & " SINGLE" & " " & "NOVIZ"
End If
ret = RunApplication(arg)
Else
Return False
End If
'execute? did it terminate properly?
' kill the ufile
Try
File.Delete(uFile)
Dim cleanupFiles = Directory.GetFiles(_SensitivityFolder).Where(Function(e) e.Contains(".spw") Or Path.GetFileName(e).StartsWith("SIMU")).ToList()
For Each fileToDelete As String In cleanupFiles
File.Delete(fileToDelete)
Next
' clean up temp combined files
If CombinedFile <> "" Then System.IO.File.Delete(CombinedFile)
Catch ex As Exception
End Try
ret = VerifyOutputFiles(cCard.FileName)
Return ret
End Function
Any help is very much appreciated, thank you for taking the time to read my post.
Related
I have this VB code which is giving the above error in the code below
Try
'Job Ticket Section
StatusText = "Reading Job Ticket Data."
FileName = System.IO.Path.Combine(SoftSavePath, "cfgjt.sys")
If Not System.IO.File.Exists(FileName) Then
CopyDefaultSoftJobTicketItems(FileName, ErrorFlag)
End If
filenumber = FreeFile()
FileOpen(filenumber, FileName, OpenMode.Binary)
.ConvexJobTicketItems = GetConfigConvexJobTicketItems(filenumber)
.ConcaveJobTicketItems = GetConfigConcaveJobTicketItems(filenumber)
FileClose(filenumber)
Catch ex As Exception
ErrorFlag.NumErrors = ErrorFlag.NumErrors + 1
ReDim Preserve ErrorFlag.ErrorDef(ErrorFlag.NumErrors - 1)
With ErrorFlag.ErrorDef(ErrorFlag.NumErrors - 1)
.Number = ErrorFlag.NumErrors - 1
.Description = "Open Config job ticket File Error: " & StatusText + ex.Message
End With
FileClose(filenumber)
End Try
On debugging , I found out that when the cursor hits this statement .ConcaveJobTicketItems , it jumps to the catch block .
The function GetConfigConcaveJobTicketItems(filenumber) where I stepped into has other function calls inside it .
Public Function GetConfigConcaveJobTicketItems(ByRef InFileNumber As Short) As JobTicketConcaveDesignItemsType
With GetConfigConcaveJobTicketItems
.ComfortConic = GetConfigConcaveSphereToricJobTicket(InFileNumber, "ConfortConic")
.Multicurve = GetConfigConcaveSphereToricJobTicket(InFileNumber, "Multicurve")
End With
End Function
When the debug cursor Hits the statement .ComfortConic = GetConfigConcaveSphereToricJobTicket(InFileNumber, "ConfortConic"), I step into the function and see that everything is fine and the cursor moves to the next line.
.Multicurve = GetConfigConcaveSphereToricJobTicket(InFileNumber, "Multicurve")
The GetConfigConcaveSphereToricJobTicket() is defined as
Public Function GetConfigConcaveSphereToricJobTicket(ByRef InFileNumber As Short, ByRef InString As String) As JobTicketSphereToricConcaveItemsType
With GetConfigConcaveSphereToricJobTicket
.Sphere = GetConfigConcaveDesignJobTicket(InFileNumber, InString & "Sphere")
.Toric = GetConfigConcaveDesignJobTicket(InFileNumber, InString & "Toric")
End With
End Function
I am very new with Background worker control. I have an existing project that builds file but throughout my project while building files I get the deadlock error.
I am trying to solve it by creating another project that will only consist out of the background worker. I will then merge them.
My problem is I don't know where it will be more effective for my background worker to be implemented and also the main problem is how can I use the SaveDialog with my background worker? I need to send a parameter to my background worker project telling it when my file is being build en when it is done.
This is where my file is being build:
srOutputFile = New System.IO.StreamWriter(strFile, False) 'Create File
For iSeqNo = 0 To iPrintSeqNo
' Loop through al the record types
For Each oRecord As stFileRecord In pFileFormat
If dsFile.Tables.Contains(oRecord.strRecordName) Then
' Loop through al the records
For Each row As DataRow In dsFile.Tables(oRecord.strRecordName).Rows
' Check record id
If oRecord.strRecordId.Length = 0 Then
bMatched = True
Else
bMatched = (CInt(oRecord.strRecordId) = CInt(row.Item(1)))
End If
' Match records
If iSeqNo = CInt(row.Item(0)) And bMatched Then
strRecord = ""
' Loop through al the fields
For iLoop = 0 To UBound(oRecord.stField)
' Format field
If oRecord.stField(iLoop).iFieldLength = -1 Then
If strRecord.Length = 0 Then
strTmp = row.Item(iLoop + 1).ToString
Else
strTmp = strDelimiter & row.Item(iLoop + 1).ToString
End If
ElseIf oRecord.stField(iLoop).eFieldType = enumFieldType.TYPE_VALUE Or _
oRecord.stField(iLoop).eFieldType = enumFieldType.TYPE_AMOUNT_CENT Then
strTmp = row.Item(iLoop + 1).ToString.Replace(".", "").PadLeft(oRecord.stField(iLoop).iFieldLength, "0")
strTmp = strTmp.Substring(strTmp.Length - oRecord.stField(iLoop).iFieldLength)
Else
strTmp = row.Item(iLoop + 1).ToString.PadRight(oRecord.stField(iLoop).iFieldLength, " ").Substring(0, oRecord.stField(iLoop).iFieldLength)
End If
If oRecord.stField(iLoop).iFieldLength > -1 And (bForceDelimiter) And strRecord.Length > 0 Then
strTmp = strDelimiter & strTmp
End If
strRecord = strRecord & strTmp
Next
' Final delimiter
If (bForceDelimiter) Then
strRecord = strRecord & strDelimiter
End If
srOutputFile.WriteLine(strRecord)
End If
Next
End If
Next
Next
You could try this:
Private locker1 As ManualResetEvent = New System.Threading.ManualResetEvent(False)
Private locker2 As ManualResetEvent = New System.Threading.ManualResetEvent(False)
Dim bOpenFileOK As Boolean
Dim myOpenFile As OpenFileDialog = New OpenFileDialog()
Private Sub FileOpener()
While Not bTerminado
If myOpenFile.ShowDialog() = System.Windows.Forms.DialogResult.OK Then
bOpenFileOK = True
Else
bOpenFileOK = False
End If
locker2.Set()
locker1.WaitOne()
End While
End Sub
' Detonator of the action
Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Button1.Click
Dim tFileOp As Thread = New Thread(AddressOf FileOpener)
tFileOp.SetApartmentState(ApartmentState.STA)
tFileOp.Start()
' Start BackgroundWorker
BW1.RunWorkerAsync()
End Sub
Private Sub AsyncFunctionForBW(ByVal args As ArrayList)
'[...]
'Change options dinamically for the OpenFileDialog
myOpenFile.Filter = ""
myOpenFile.MultiSelect = True
'Calling the FileDialog
locker1.Set()
locker2.WaitOne()
locker1.Reset()
locker2.Reset()
If bOpenFileOK Then
myStream = myOpenFile.OpenFile()
'[...]
End If
End Sub
It's a little bit complicated but it works.
ManualResetEvents interrupt the execution of code (if they are told to stop) when reached until you use .Set(). If you use .WaitOne() you set it in stop mode, so it will stop again when reached.
This code defines two ManualResetEvents. When you click the Button1 starts the function FileOpener() in a new Thread, and then starts the BackgroundWorker. The FileOpener() function shows a FileOpenDialog and waits in the locker1 so when you use locker1.Set() the function shows the file dialog.
As the myOpenFile is a "global" variable (as well as bOpenFileOK), once the user select the file (or not) you could detect the dialog result (bOpenFileOK) and the selected file.
I am working on a project where I need to modify a script used for network documentation. The current script that we use is a modified version of SYDI, found here. What I would like to do is add to this script the ability to execute a netstat -an and have it returned with the rest of the report. I was curious if anyone has used WMI and VBScript to return netstat information and how it might be able to be incorporated into this script.
NOTE: I am not trying to promote a product and I am not affiliated with the SYDI project.
You could run netstat and capture the result like the script here under, but much info is also available from activeX but the i would need to know what information you need exactly.
set sh = CreateObject("Wscript.Shell")
set Connections = CreateObject("Scripting.Dictionary")
call Main()
Function Main()
call GetConnections()
call ProcessConnections()
End Function
Function GetConnections()
i = 0
set shExec = sh.Exec("netstat -f")
Do While Not shExec.StdOut.AtEndOfStream
Line = shExec.StdOut.ReadLine()
If Instr(Line, "TCP") <> 0 Then
Set Connection = New NetworkConnection
Connection.ParseText(Line)
call Connections.Add(i, Connection)
i = i + 1
End If
Loop
End Function
Function ProcessConnections()
For Each ConnectionID in Connections.Keys
wscript.echo ConnectionID & Connections(ConnectionID).RemoteIP
Next
End Function
Class NetworkConnection
Public Protocol
Public LocalIP
Public LocalPort
Public RemoteIP
Public RemotePort
Public Sub ParseText(Line)
dim i
For i = 5 to 2 Step -1
Line = Replace(Line, String(i, " "), " ")
Next
Line = Replace(Line, ":", " ")
Line = Right(Line, Len(Line) - 1)
Line = Split(Line, " ")
Protocol = Line(0)
LocalIP = Line(1)
LocalPort = Line(2)
RemoteIP = Line(3)
RemotePort = Line(4)
End Sub
Private Sub Class_Initialize
'MsgBox "Initialized NetworkConnection object"
End Sub
End Class
EDIT: based on the comment of OP here a simplified version
set sh = CreateObject("Wscript.Shell")
call GetConnections()
Function GetConnections()
i = 0
set shExec = sh.Exec("netstat -an")
Do While Not shExec.StdOut.AtEndOfStream
Wscript.Echo shExec.StdOut.ReadLine()
Loop
End Function
I am trying to save the text file in this path:"C:\Test\test.txt" and when the file is already opened I need to check whether the file is opened and I need to close it before writing it to the file.
Here is the code for saving the file:
Dim myfile As String = "C:\Test\test.txt"
'Check if file exists
If System.IO.File.Exists(myfile) = True Then
'Delete it!
Dim fi As New FileInfo(myfile)
fi.Delete()
End If
Using sfdlg As New Windows.Forms.SaveFileDialog
sfdlg.DefaultExt = "amk"
sfdlg.Filter = "AquaMark Project|*.amk"
If sfdlg.ShowDialog = Windows.Forms.DialogResult.OK Then
Dim SaveData As New gCanvasData
IO.Directory.CreateDirectory("C:\Test")
Dim w As New IO.StreamWriter("C:\Test\test.txt")
Dim i As Integer
For i = 0 To CheckedListBox1.Items.Count - 1
w.WriteLine(CheckedListBox1.Items.Item(i))
Next
w.Close()
With SaveData
frmDisplay.GCanvas1.UnselectCurrentAnotate()
.gAnnotates = frmDisplay.GCanvas1.gAnnotates
.Image = frmDisplay.GCanvas1.Image
End With
Using objStreamWriter As New StreamWriter(sfdlg.FileName)
Dim x As New XmlSerializer(GetType(gCanvasData))
x.Serialize(objStreamWriter, SaveData)
objStreamWriter.Close()
End Using
End If
End Using
If I am doing this way I am able to close the notepad process but I need to close the specific opened text file:
Dim Process() As Process = System.Diagnostics.Process.GetProcessesByName("notepad")
Process() = CType(Interaction.GetObject("C:\Test\test.txt"), Diagnostics.Process())
For Each p As Process In Process
p.Kill()
Next
I do not believe there is a property that will allow for you to check if the streamreader is open or not.
Best practice seems to be to .close the reader when done with it. (All in the method that it was used in.)
You could try a try block to handle the exception if you are still getting one.
May be able to find additional info and some sample code here. Good Luck.
MSDN! StreamReader
EDIT: You may be able to check using this. IO.File
Private Function CheckFile(ByVal filename As String) As Boolean
Try
System.IO.File.Open(filename, IO.FileMode.Open, IO.FileAccess.Read, IO.FileShare.None)
FileClose(1)
Return False
Catch ex As Exception
Return True
End Try
End Function
What about :
If File.Exists("File1.txt") = False Then
File.CreateText("File1.txt").Close()
Else
Exit Sub
End If
If File.Exists("File2.txt") = False Then
File.CreateText("File2.txt").Close()
Else
Exit Sub
End If
End If
Private Sub IsFileOpen(ByVal file As FileInfo)
Dim stream As FileStream = Nothing
Try
stream = file.Open(FileMode.Open, FileAccess.ReadWrite, FileShare.None)
Catch ex As IOException
If IsFileLocked(ex) Then
'do something here, either wait a few seconds, close the file if you have
'a handle, make a copy of it, read it as shared (FileAccess fileAccess = FileAccess.Read, FileShare fileShare = FileShare.ReadWrite).
'I dont recommend terminating the process - which could cause corruption and lose data
End If
Catch ex As Exception
End Try
End Sub
Private Shared Function IsFileLocked(exception As Exception) As Boolean
Dim errorCode As Integer = Marshal.GetHRForException(exception) And ((1 << 16) - 1)
Return errorCode = 32 OrElse errorCode = 33
End Function
The following function can be used to determine is a file is already open (True) or not (False). Action can then be based on the Function result.
Public Function IsFileOpen(ByVal xFileName As String, ByVal xFileChannel As Integer) As Boolean
' ************************************************************
' * Function: IsFileOpen
' * Purpose: To determine if a file is already open.
' * Can be used to determine if a file should be closed.
' * Syntax:
' * Dim bResult as Boolean
' *
' * bResult = IsFileOpen("C:\Test.txt", 1)
' *
' * OR
' *
' * If IsFileOpen("C:\Test.txt", 1) = True Then
' * Microsoft.VisualBasic.FileClose(1)
' * End If
' *
' ************************************************************
Try
Microsoft.VisualBasic.FileOpen(xFileChannel, xFileName, OpenMode.Input, OpenAccess.Read, OpenShare.Default)
Catch
' File Already Open Error Number = 55
If Trim(Err.Number.ToString) = "55" Then
Return True
Else
Return False
End If
End Try
End Function
I was having this problem with a .csv file my program attaches to an email. I added code to clear the Attachments collection in the MailMessage object then disposing the MailMessage and Attachment objects after the mail is sent. That appears to have fixed the problem.
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