i have the below code:
ddlResultFormat.Items.Add("Text")
dynamicDotNetTwain1.LoadImage("C:\Users\elj\Desktop\3b072e9b-76b4-4776-bd3c-5984074d8ecd.png")
Dim r = dynamicDotNetTwain1.GetImage(dynamicDotNetTwain1.CurrentImageIndexInBuffer).Width.ToString()
Dim l = dynamicDotNetTwain1.GetImage(dynamicDotNetTwain1.CurrentImageIndexInBuffer).Height.ToString()
Dim languageFolder As String
languageFolder = "C:\Program Files (x86)\Dynamsoft\Dynamic .NET TWAIN 5.2 Trial\Samples\Bin\"
Dim languages As New Dictionary(Of String, String)
languages.Add("English", "eng")
Me.dynamicDotNetTwain1.OCRTessDataPath = languageFolder
Me.dynamicDotNetTwain1.OCRLanguage = "English"
Dim ocrResultFormat As Dynamsoft.DotNet.TWAIN.OCR.ResultFormat
ocrResultFormat = CType(System.Enum.Parse(GetType(Dynamsoft.DotNet.TWAIN.OCR.ResultFormat), Val("&H" & 0)), Dynamsoft.DotNet.TWAIN.OCR.ResultFormat)
Me.dynamicDotNetTwain1.OCRResultFormat = ResultFormat.Text
Dim strDllPath As String
strDllPath = "C:\Program Files (x86)\Dynamsoft\Dynamic .NET TWAIN 5.2 Trial\Redistributable\OCRResources\"
dynamicDotNetTwain1.OCRDllPath = strDllPath
If (Me.dynamicDotNetTwain1.CurrentImageIndexInBuffer < 0) Then
Dim jajajja = "Please load an image before doing OCR!"
End If
Dim sbytes As Byte()
sbytes = Me.dynamicDotNetTwain1.OCR(Me.dynamicDotNetTwain1.CurrentSelectedImageIndicesInBuffer)
the problem that i'm facing is that the sbytes byte array is being always set to empty although the indice in the buffer is correct and the paths and the dll are well implemented but the convert to the byte array is not being successful i'm not getting any exception but the length of the byte is 0
any idea how can i fix this?
Please update the following line of code and try again.
Me.dynamicDotNetTwain1.OCRLanguage = "eng" 'not English
Related
I have a file location and I need to check if it exists.
The way I wan't to do it is like this:
Dim route As String = ("C:\testing1\testing2\testing3\testing4\testing5\TEXTBESTAND.txt")
If System.IO.File.Exists(route) Then
MsgBox("BESTAAT HET WERKT!")
Else
Dim subroute() As String = route.Split("\"c)
Dim counting As Integer = route.Split("\"c).Length - 1
For count2 As Integer = 0 To counting - 1
Dim firstbackslash As Integer = route.IndexOf("\")
Dim backslash As Integer = route.IndexOf("\", firstbackslash + 1)
Dim firstPart As String = route.Substring(0, backslash)
MsgBox(firstPart)
Next
What I try to accomplisch is that I fist check if folder "C:" exists then "C:\testing1" then "C:\testing1\testing2" etc.
But I cant find something like this on the internet nor with some messing around...
Here is an algorithm that that will give you all the paths starting from the root and building up to the final path including the filename. You can use this to check for each folder and create them as you go if they don't exist:
Sub Main()
Dim route As String = ("C:\testing1\testing2\testing3\testing4\testing5\TEXTBESTAND.txt")
Dim fi As New System.IO.FileInfo(route)
If Not fi.Exists Then
Dim fileName As String = Path.GetFileName(route)
Dim di As DirectoryInfo = fi.Directory
Dim pathStack As New Stack(Of String)()
pathStack.Push(di.Name)
While Not IsNothing(di.Parent)
di = di.Parent
pathStack.Push(di.Name)
End While
Dim curPath As String = ""
While pathStack.Count > 0
curPath = Path.Combine(curPath, pathStack.Pop)
' ... do something with "curPath" in here ...
' ... like check for existence and create it ...
Console.WriteLine(curPath)
End While
curPath = Path.Combine(curPath, fileName)
' ... do something with "curPath" in here ...
' ... this is the full path including the file on the end ...
Console.WriteLine(curPath)
End If
Console.Write("Press Enter to quit...")
Console.ReadLine()
End Sub
Output:
C:\
C:\testing1
C:\testing1\testing2
C:\testing1\testing2\testing3
C:\testing1\testing2\testing3\testing4
C:\testing1\testing2\testing3\testing4\testing5
C:\testing1\testing2\testing3\testing4\testing5\TEXTBESTAND.txt
Press Enter to quit...
Don't use string mnaipulation to work with file or folder paths. use the Path class.
One option:
Private Function GetExistingSubPath(fullPath As String) As String
If Directory.Exists(fullPath) OrElse File.Exists(fullPath) Then
Return fullPath
End If
Dim subPath = Path.GetDirectoryName(fullPath)
If subPath Is Nothing Then
Return Nothing
End If
Return GetExistingSubPath(subPath)
End Function
Sample usage:
Dim fullPath = "C:\testing1\testing2\testing3\testing4\testing5\TEXTBESTAND.txt"
Dim existingSubPath = GetExistingSubPath(fullPath)
Console.WriteLine(existingSubPath)
What I try to accomplisch is that I fist check if folder "C:" exists then "C:\testing1" then "C:\testing1\testing2" etc.
Noooooooooooo!
That's not how to do it at all! The file system is volatile: things can change between each of those checks. Moreover, file existence is only one of many things that can stop file access.
It's much better practice to try to access the file in question, and then handle the exception if it fails. Remember, because of the prior paragraph you have to be able to handle exceptions here anyway. .Exists() doesn't save you from writing that code. And each check is another round of disk access, which is about the slowest thing it's possible to do in a computer... even slower than unrolling the stack for an exception, which is the usual objection to this idea.
I fixed it, know I can check if multiple text files are at the locations I need, if there not I place the Textfiles at the location I need them. Then I can add something in it. (I need to put a Location of something else in it.)
Dim een As String = "C:\testing1\testing2\testing7\testing1\testing1\text.txt"
Dim twee As String = "C:\testing1\testing2\testing7\testing2\testing1\text.txt"
Dim drie As String = "C:\testing1\testing2\testing7\testing3\testing1\text.txt"
Dim vier As String = "C:\testing1\testing2\testing7\testing4\testing1\text.txt"
Dim Files As String() = {een, twee, drie, vier}
For Each route As String In Files
If System.IO.File.Exists(route) Then
MsgBox("BESTAAT HET WERKT!")
Else
Dim subroute() As String = route.Split("\"c)
Dim counting As Integer = route.Split("\"c).Length - 1
Dim tel As Integer = route.Substring(route.LastIndexOf("\") + 1).Count
Dim bestandnaam As String = route.Substring(route.LastIndexOf("\") + 1)
For count2 As Integer = 0 To route.Length - tel - 1
Dim firstbackslash As Integer = route.IndexOf("\", count2)
Dim backslash As Integer = route.IndexOf("\", count2)
Dim Mapnaam As String = route.Substring(0, backslash)
count2 = firstbackslash
If System.IO.Directory.Exists(Mapnaam) Then
Else
System.IO.Directory.CreateDirectory(Mapnaam)
End If
Next
If System.IO.File.Exists(route) Then
Else
Dim objStreamWriter As System.IO.StreamWriter
objStreamWriter = New System.IO.StreamWriter(route)
Dim label As String
Select Case route
Case een
label = "een"
Case twee
label = "twee"
Case drie
label = "drie"
Case vier
label = "vier"
End Select
Dim value As String = InputBox("Route invullen naar " & label)
'Dim objStreamWriter As New System.IO.StreamWriter(route)
objStreamWriter.Write(value)
objStreamWriter.Close()
'Using sw As System.IO.StreamWriter = System.IO.File.AppendText(route)
' sw.WriteLine(value)
'End Using
End If
End If
Next route
Whenever i am trying to debug or run the program and if it encounters error, the VBE (Autocad) doesn't display the line where the error is, unlike in other IDEs, it used to come at that line and highlight with yellow color. Also, the scroll doesn't work. I know i should install plugins but i am unable to help myself.
Option Explicit
Sub Test()
'Declarations
'Opened Document
Dim acDocu As AcadDocument
Set acDocu = ThisDrawing.Application.ActiveDocument
'Select on screen
Dim acSelectionSet As AcadSelectionSet
Set acSelectionSet = ThisDrawing.SelectionSets.Add("SjjEffffT")
acSelectionSet.SelectOnScreen
'Manipulating in loops for finding group names having objects selected
Dim entity As AcadEntity
Dim entityhandle() As String
Dim Grp As AcadGroup
Dim groupname() As String
Dim i As Integer
i = 0
Dim j As Integer
j = 0
Dim temp As Integer
temp = 0
Dim GrpEnt As AcadEntity
Dim grpenthandle As String
Dim entity_count As Integer
'Dim entity_array As Variant
entity_count = acSelectionSet.Count
ReDim entityhandle(entity_count)
ReDim groupname(entity_count)
For Each entity In acSelectionSet
'entity_array = entity
entityhandle(i) = entity.Handle
For Each Grp In ThisDrawing.groups
For Each GrpEnt In Grp
grpenthandle = GrpEnt.Handle
If entityhandle(i) = grpenthandle Then
If temp = 0 Then
groupname(j) = Grp.Name
Debug.Print "Group in selection:" & groupname(j)
j = j + 1
End If
End If
temp = temp + 1
Next
temp = 0
Next
i = i + 1
Next
'Copying the objects and pasting into new drawing
Dim acDocto As AcadDocument
Dim file_name As String
'file_name = InputBox("Enter the file name along with full path and extension")
file_name = "D:\PI_Tool_files_3223\D00440023new.DWG"
Set acDocto = Documents.Open(file_name)
Dim acObject As AcadObject
Dim retvalue As Variant
retvalue = acDocu.CopyObjects(entityhandle, acDocto.ModelSpace)
acSelectionSet.Delete
End Sub
The code is written above. But i think the problem is with the add-in as i can't debug.
The VBA IDE is pretty old (1998) and it has limited debugging abilities. You should stop using this, it's an obsolete technology, not actively supported by Microsoft/Autodesk anymore.
For some errors, it is not able to locate the line where the error occurred, and you're left with obscure error codes and useless messages.
Have you tried setting a breakpoint at the first possible line? (Set acDocu = ThisDrawing.Application.ActiveDocument)
Then step through to see the offending object/property/method.
It doesn't always work.
Can you load the code into a module, instead of "ThisDrawing", then debug?
I have an API call that returns a value from a foreign listview (Java application) that works just fine on my computer. When I try to run the same call on my colleague's computer, however, it just returns "0". We work in an office and our computers are identical--same model, same version of Windows, same version of MS Office (with Excel). The file with the API call resides on a shared network location, so it is the exact same file, exact same code that I am running on both machines. I am not very well-versed in API, so I'm probably missing something simple, but I haven't been able to solve it. Can anyone clue me in to why the code works on one machine but not the other?
Here's the code with the call--see my NOTE about halfway down that shows where I get a discrepancy:
Public Function GetListviewItem(ByVal hWindow, pRow) As String
Dim result As Long
Dim myItem As LV_ITEM
Dim pHandle As Long
Dim pStrBufferMemory As Long
Dim pMyItemMemory As Long
Dim strBuffer() As Byte
Dim index As Long
Dim tmpstring As String
Dim strLength As Long
Dim pColumn As Long
Dim lProcID As Long
'**********************
'init the string buffer
'**********************
ReDim strBuffer(MAX_LVMSTRING)
pColumn = 2
'***********************************************************
'open a handle to the process and allocate the string buffer
'***********************************************************
GetWindowThreadProcessId hWindow, lProcID ' Get the process ID in which the ListView is running
If lProcID <> 0 Then
pHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, lProcID)
pStrBufferMemory = VirtualAllocEx(pHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE)
'************************************************************************************
'initialize the local LV_ITEM structure
'The myItem.iSubItem member is set to the index of the column that is being retrieved
'************************************************************************************
myItem.mask = LVIF_TEXT
myItem.iItem = pRow
myItem.iSubitem = pColumn
myItem.pszText = pStrBufferMemory
myItem.cchTextMax = MAX_LVMSTRING
'**********************************************************
'write the structure into the remote process's memory space
'**********************************************************
pMyItemMemory = VirtualAllocEx(pHandle, 0, Len(myItem), MEM_COMMIT, PAGE_READWRITE)
result = WriteProcessMemory(pHandle, pMyItemMemory, myItem, Len(myItem), 0)
'*************************************************************
'send the get the item message and write back the memory space
'*************************************************************
'NOTE: THE 'result' VARIABLE IS WHERE I GET VALUES, BUT THE OTHER COMPUTER GETS '0'
result = SendMessage(hWindow, LVM_GETITEMTEXTA, pRow, ByVal pMyItemMemory)
result = ReadProcessMemory(pHandle, pStrBufferMemory, strBuffer(0), MAX_LVMSTRING, 0)
result = ReadProcessMemory(pHandle, pMyItemMemory, myItem, Len(myItem), 0)
'**************************************************
'turn the byte array into a string and send it back
'**************************************************
For index = LBound(strBuffer) To UBound(strBuffer)
If Chr(strBuffer(index)) = vbNullChar Then Exit For
tmpstring = tmpstring & Chr(strBuffer(index))
Next index
tmpstring = Trim(tmpstring)
'***********************************************
'deallocate the memory and close the process handle
'**************************************************
result = VirtualFreeEx(pHandle, pStrBufferMemory, 0, MEM_RELEASE)
result = VirtualFreeEx(pHandle, pMyItemMemory, 0, MEM_RELEASE)
result = CloseHandle(pHandle)
If Len(tmpstring) > 0 Then GetListviewItem = tmpstring
End If
End Function
Thanks to anyone who might have some suggestions.
I'm currently using the following to read the contents of all text files in a directory into an array
Dim allLines() As String = File.ReadAllLines(txtfi.FullName)
Within the text files are only 6 lines that all follow the same format and will read something like
forecolour=black
I'm trying to then search for the word "forecolour" and retrieve the information after the "=" sign (black) so i can then populate the below code
AllDetail(numfiles).uPath = ' this needs to be the above result
I've only posted parts of the code but if it helps i can post the rest. I just need a little guidance if possible
Thanks
This is the full code
Dim numfiles As Integer
ReDim AllDetail(0 To 0)
numfiles = 0
lb1.Items.Clear()
Dim lynxin As New IO.DirectoryInfo(zMailbox)
lb1.Items.Clear()
For Each txtfi In lynxin.GetFiles("*.txt")
Dim allLines() As String = File.ReadAllLines(txtfi.FullName)
ReDim Preserve AllDetail(0 To numfiles)
AllDetail(numfiles).uPath = 'Needs to be populated
AllDetail(numfiles).uName = 'Needs to be populated
AllDetail(numfiles).uCode = 'Needs to be populated
AllDetail(numfiles).uOps = 'Needs to be populated
lb1.Items.Add(IO.Path.GetFileNameWithoutExtension(txtfi.Name))
numfiles = numfiles + 1
Next
End Sub
AllDetail(numfiles).uPath = Would be the actual file path
AllDetail(numfiles).uName = Would be the detail after “unitname=”
AllDetail(numfiles).uCode = Would be the detail after “unitcode=”
AllDetail(numfiles).uOps = Would be the detail after “operation=”
Within the text files that are being read there will be the following lines
Unitname=
Unitcode=
Operation=
Requirements=
Dateplanned=
For the purpose of this array I just need the unitname, unitcode & operation. Going forward I will need the dateplanned as when this is working I want to try and work out how to only display the information if the dateplanned matches the date from a datepicker. Hope that helps and any guidance or tips are gratefully received
If your file is not very big you could simply
Dim allLines() As String = File.ReadAllLines(txtfi.FullName)
For each line in allLines
Dim parts = line.Split("="c)
if parts.Length = 2 andalso parts(0) = "unitname" Then
AllDetails(numFiles).uName = parts(1)
Exit For
End If
Next
If you are absolutely sure of the format of your input file, you could also use Linq to remove the explict for each
Dim line = allLines.Where(Function(x) (x.StartsWith("unitname"))).SingleOrDefault()
if line IsNot Nothing then
AllDetails(numFiles).uName = line.Split("="c)(1)
End If
EDIT
Looking at the last details added to your question I think you could rewrite your code in this way, but still a critical piece of info is missing.
What kind of object is supposed to be stored in the array AllDetails?
I suppose you have a class named FileDetail as this
Public class FileDetail
Public Dim uName As String
Public Dim uCode As String
Public Dim uCode As String
End Class
....
numfiles = 0
lb1.Items.Clear()
Dim lynxin As New IO.DirectoryInfo(zMailbox)
' Get the FileInfo array here and dimension the array for the size required
Dim allfiles = lynxin.GetFiles("*.txt")
' The array should contains elements of a class that have the appropriate properties
Dim AllDetails(allfiles.Count) as FileDetail
lb1.Items.Clear()
For Each txtfi In allfiles)
Dim allLines() As String = File.ReadAllLines(txtfi.FullName)
AllDetails(numFiles) = new FileDetail()
AllDetails(numFiles).uPath = txtfi.FullName
Dim line = allLines.Where(Function(x) (x.StartsWith("unitname="))).SingleOrDefault()
if line IsNot Nothing then
AllDetails(numFiles).uName = line.Split("="c)(1)
End If
line = allLines.Where(Function(x) (x.StartsWith("unitcode="))).SingleOrDefault()
if line IsNot Nothing then
AllDetails(numFiles).uName = line.Split("="c)(1)
End If
line = allLines.Where(Function(x) (x.StartsWith("operation="))).SingleOrDefault()
if line IsNot Nothing then
AllDetails(numFiles).uOps = line.Split("="c)(1)
End If
lb1.Items.Add(IO.Path.GetFileNameWithoutExtension(txtfi.Name))
numfiles = numfiles + 1
Next
Keep in mind that this code could be really simplified if you start using a List(Of FileDetails)
I have a bit of a problem : in an winForm app in VS2010 win 7 compiling to x86, I try to do what Alvas.Audio seems to work. See (c# ex: http://alvas.net/alvas.audio,tips.aspx#tip94) for reference.
Dim data() As Byte = wr.ReadData(second * i, second)
The result give me data.length()=0. I do not have any exception, I can read format from it and whatever reader I use I got this problem.
EDIT : After some tests, it seems like the uncompressed file I create in the first step (in PCM format, with .wav extension) can not be recognized by the Alvas.audio library for the second step. I must miss something around Audio file markups or something alike.
Here is the code that might be the source (basically this is step 1):
Dim functOut As String = String.Empty
Dim wr As Alvas.Audio.IAudioReader = Nothing
Dim fs As IO.FileStream = Nothing
Dim i As Integer = 0
Dim tmpData() As Byte = Nothing
Dim dataPCM() As Byte = Nothing
Dim newFormat As IntPtr = IntPtr.Zero
Try
Select Case IO.Path.GetExtension(filename).ToLower()
Case ".wav"
wr = New Alvas.Audio.WaveReader(IO.File.OpenRead(filename))
filename = IO.Path.GetTempPath & IO.Path.GetFileNameWithoutExtension(filename) & "2" & IO.Path.GetExtension(filename)
Case ".mp3"
wr = New Alvas.Audio.Mp3Reader(IO.File.OpenRead(filename))
Case Else : wr = New Alvas.Audio.DsReader(filename)
End Select
functOut = IO.Path.ChangeExtension(filename, ".wav")
Dim format As IntPtr = wr.ReadFormat()
Dim formatDetail As Alvas.Audio.WaveFormat = Alvas.Audio.AudioCompressionManager.GetWaveFormat(format)
If formatDetail.wFormatTag = Alvas.Audio.AudioCompressionManager.MpegLayer3FormatTag Then
Alvas.Audio.AudioCompressionManager.Mp3ToWav(filename, functOut)
Return True
Else
IO.File.Create(functOut).Close()
While True
tmpData = wr.ReadData(SECONDS * i, SECONDS)
If tmpData Is Nothing Or tmpData.Length = 0 Then Exit While
If formatDetail.wBitsPerSample < 16 Then
Alvas.Audio.AudioCompressionManager.ToPcm16Bit(format, tmpData, newFormat, dataPCM)
Else
newFormat = format
dataPCM = tmpData
End If
formatDetail = Alvas.Audio.AudioCompressionManager.GetWaveFormat(newFormat)
fs = IO.File.Open(filename, IO.FileMode.Append, IO.FileAccess.Write)
Using ww As New Alvas.Audio.WaveWriter(fs, Alvas.Audio.AudioCompressionManager.FormatBytes(newFormat))
ww.Write(dataPCM, 0, dataPCM.Length())
End Using
i += 1
tmpData = Nothing
End While
Return True
End If
wr.Close()
Catch ex As Exception
filename = String.Empty
Throw ex
Finally
fs.Close()
wr.Close()
filename = functOut
GC.Collect()
End Try
How can I write the resulted stream to be sure I can read it again later?
Any ideas will be great appreciated.
I found a solution.
PCM files are headerless. So when saved, even with waveWriter and the line Alvas.Audio.AudioCompressionManager.FormatBytes(newFormat) was ignored.
Two things can be done:
find a reader that recognize headerless files and allows to read from it.
refactor code to decode into PCM file and encode it into the new format (e.g .mp3) without writing the resulted file into File system (much better)