I need to count the number of #define lines in C files (3 of them) using VBS. Please suggest the best way to accomplish this.
The script below uses a regular expression to count the #define statements that appear at the beginning of the lines. Whitespace is allowed before the statement as well as between # and define. The list of files to search in should be passed in as arguments, e.g.:
cscript.exe script_name.vbs c:\myfile1.c c:\myfile2.c
Here's the script code:
Const ForReading = 1
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set re = New RegExp
re.Pattern = "^\s*#\s*define\b"
re.IgnoreCase = False
re.Global = True
re.Multiline = True
strReport = ""
For Each strFileName in WScript.Arguments.Unnamed
Set oFile = oFSO.OpenTextFile(strFileName, ForReading)
strText = oFile.ReadAll
oFile.Close
intCount = re.Execute(strText).Count
strReport = strReport & "There are " & intCount & " #define statement(s) in " & strFileName & vbNewLine
Next
WScript.Echo strReport
The script output is like:
There are 7 #define statement(s) in c:\myfile1.c
There are 0 #define statement(s) in c:\myfile2.c
How about something like this? just pass the files in as arguments
Const token = "#define"
Set objArgs = WScript.Arguments
tokenCount = 0
Set fso = CreateObject("Scripting.FileSystemObject")
For i = 0 To objArgs.Count - 1
Set objFile = fso.OpenTextFile(objArgs(i), 1)
Do Until objFile.AtEndofStream
lineCount = lineCount + 1
If InStr(1, objFile.ReadLine, token, 1) 0 Then
tokenCount = tokenCount + 1
End If
Loop
Next
WScript.echo tokenCount
This will ignore blank spaces between # and define
Const token = "#define"
Set objArgs = WScript.Arguments
tokenCount = 0
Set fso = CreateObject("Scripting.FileSystemObject")
For i = 0 To objArgs.Count - 1
Set objFile = fso.OpenTextFile(objArgs(i), 1)
Do Until objFile.AtEndofStream
lineCount = lineCount + 1
If InStr(1, Replace(objFile.ReadLine, " ", "", 1, -1, 1), token, 1) 0 Then
tokenCount = tokenCount + 1
End If
Loop
Next
WScript.echo tokenCount
This code should count all #define statements in any number of input files. Provisions have been made for whitespace in the statements, such as "# define" or "# define" both of which are valid statements.
NOTE: I do not count for the # on one line and the "define" on the next, I'm assuming the # and "define" are at least on the same line, though you could do so by reading the entire file and removing all whitespace, then save to a variable or temp file or something like that and use that as your input.
You can shorten the code a bunch by ditching the file access constants and what not, otherwise it will give you output like this:
There are: 9 define statements in the source: c:\define.txt
There are: 11 define statements in the source: c:\define2.txt
There are: 10 define statements in the source: c:\define3.txt
The command line would be: cscript scriptname.vbs c:\define.txt c:\define3.txt etc...
' Define constants for file access
Const TristateFalse = 0
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objArgs = WScript.Arguments
If objArgs.Count > 0 then
For i = 0 To objArgs.Count - 1
Set objFileInputStream = objFSO.OpenTextFile(objArgs(i), ForReading, False, TristateFalse)
intTempCount = 0
tokenCount = 0
Do while not objFileInputStream.AtEndOfStream
strLine = replace(ucase(objFileInputStream.ReadLine), " ", "")
intLineLength = len(strLine)
Do
If instr(strLine, "#DEFINE") <> 0 then
tokenCount = tokenCount + 1
strLine = replace(strLine, "#DEFINE","", 1, 1)
intTempCount = intTempCount + 1
else
exit do
End If
Loop until intTempCount = intLineLength
Loop
objFileInputStream.Close
wscript.echo "There are: " & tokenCount & " define statements in the source: " & objArgs(i)
Next
Else
wscript.echo "You must enter at least one filename."
End If
I'm not that good at VB script, but something like ...
Dim re as New RegExp
re.IgnoreCase = True
re.Global = True
re.Pattern = "#define"
Set mc = re.Execute(yourFileText)
ans = mc.Count
Related
I'm allowing a user to select multiple files and find the file with the most lines in it. When I run the code below, I get a "run-time error '438' on the line with Opentextfile. -> txsInput = objFSO.OpenTextFile(FileName, ForReading)
Dim objFSO, txsInput, strTemp, arrLines
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
'set and determine file picker behaviour
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = True
'Launch file picker, exit if no files selected. Hold Ctrl to select multiple files.
If Not fd.Show = -1 Then Exit Sub
'find longest file
For i = 1 To fd.SelectedItems.Count
FileName = fd.SelectedItems(i)
txsInput = objFSO.OpenTextFile(FileName, ForReading)
'Skip lines one by one
Do While txsInput.AtEndOfStream <> True
txsInput.SkipLine ' or strTemp = txsInput.ReadLine
Loop
If longestFileLength < txsInput.Line - 1 Then
longestFileLength = txsInput.Line - 1
longestFileIndex = i
End If
'cleanup
Set objFSO = Nothing
Next i
Cells(headerOffset, 20) = "Length" & longestFileLength
Cells(headerOffset, 21) = "index" & longestFileIndex
Quick fix (just to avoid the error):
Dim objFSO, txsInput As Object, strTemp, arrLines
and
Set txsInput = objFSO.OpenTextFile(Filename, ForReading)
Normal fix - declare the variables correctly, use Option Explicit on the top, then declare the following variables:
fd
i
Filename
longestFileLength
longestFileIndex
headerOffset
If you are lucky, your next error would be here:
Cells(headerOffset, 20) = "Length" & longestFileLength
because headerOffset is with value 0. If you write headerOffset = 1 on the line before you would avoid it.
I would like to programmatically rename a Windows folder containing one or more illegal Windows characters using VBA. (The folder tree comes from a Mac/Linux environment).
The illegal character shows as a . in Windows/File Explorer, which can manipulate the folder OK.
Methods I have tried unsuccessfully include using the FileSystem Object and the VBA Name command.
Getting the actual name of the folder with the illegal char is the problem.
Doing dir /X shows the short (8.3 format) name of the folder but the full name appears in the command window with ? replacing the illegal char.
Supplying this name with the ? to various routines for folder operations (e.g. FileSystemObject GetFolder, VB Name function, GetShortName) results in the operation not finding the file to operate on.
Running Dir /X > Foldernames.txt produces an ASCII file which shows a ? replacing the illegal char, but examining the file in a binary editor (Frhed) shows 3 bytes for the illegal character in the full folder name. These are Chr(239), Chr(128) and Chr(162). Using this string to replace the illegal char the folder name still results in folder not found behaviour.
Using the actual illegal value (Chr (149))in the folder name also results in folder not found behaviour.
A short file name (8.3 format ) is shown in the Dir /X output and the folder can be accessed via this name. However, I can't see how to distinguish between short names for folders with different illegal chars in the same position, and shortname generation only occurs when the folder exists, so unless I can access the foldername with the illegal char directly it's not much help.
There is a unicode symbol for a placeholder (UxFFFD) which shows as a question mark in a black diamond which I have seen occasionally but not in in any Dir /X listings.
I suggest doing this via a batch-job.
Get the actual name of the file via a list.
You could use a batch like this:
dir "F:\batchs" > "F:\batchs\list.txt"
exit
If you found out the name copy it and replace "'inserthere'" in this code:
ren '_inserthere_' newname.txt
exit
and then run this as a batch job again. This might do the job.
I have found a very laborious way of accessing files and folders with illegal characters in them via their short (8.3) format names. Generating a short name from a path which does not exist is not possible - as the algorithm for generating short names is apparently subject to change and I could not find a reverse-engineer of it.
The only way to get the short name is to do a Dir /X listing for the folder with illegal char or containing a file name with an illegal char and send it to file, which can then be parsed. The long name of the file or folder in the file sometimes includes the illegal character (if it is a ?, which is commonest) so that can be searched for. VBA code for dealing with folders is below. Once the short name of the folder with the illegal char is found it can be easily renamed and returned as a ByRef parameter.
' Procedure : LegalPath
' Author : Simon
' Date : 11/12/2017
' Purpose : returns true if all path chars are legal and changes illegals to _ in sLegalPath if not
Public Function LegalPath(ByVal sPath As String, ByRef sLegalPath As String) As Boolean
Dim iColon As Long
Dim J As Long
Dim sIllegalChars As String
Dim sOutPath As String
On Error GoTo LegalPath_Error
LegalPath = False
sIllegalChars = ""
'If InStr(sPath, "\") <> 0 Then Exit Function
If InStr(sPath, "/") <> 0 Then sIllegalChars = sIllegalChars + "/"
iColon = InStr(sPath, ":") ' allow colon at loc 2
If iColon <> 0 And iColon <> 2 Then sIllegalChars = sIllegalChars + ":"
If InStr(sPath, "*") <> 0 Then sIllegalChars = sIllegalChars + "*"
If InStr(sPath, "?") <> 0 Then sIllegalChars = sIllegalChars + "?"
If InStr(sPath, "<") <> 0 Then sIllegalChars = sIllegalChars + "<"
If InStr(sPath, ">") <> 0 Then sIllegalChars = sIllegalChars + ">"
If InStr(sPath, "|") <> 0 Then sIllegalChars = sIllegalChars + "|"
' check for bullet code (149)
For J = 1 To Len(sPath)
If (asc(Mid(sPath, J, 1)) = 149) Then
sIllegalChars = sIllegalChars & Mid(sPath, J, 1)
End If
Next J
If (sIllegalChars <> "") Then
LegalPath = False
' replace with illegals with underscore
sOutPath = sLegalPath
For J = 1 To Len(sIllegalChars)
sOutPath = Replace(sOutPath, Mid(sIllegalChars, J, 1), "_")
Next J
sLegalPath = sOutPath
Dim sParentFolder As String
sParentFolder = GetFolderFromPath(TruncateR(sPath))
Call shell(GetDAFolder & "\ListDir.bat """ & sParentFolder & """ """ & GetDAFolder & "\ListDir.txt""")
Dim a As TextStream
Dim fs As New Scripting.FileSystemObject
Set a = fs.OpenTextFile(GetDAFolder & "\ListDir.txt", ForReading, False)
Dim sWindowsFolderName As String
Dim sWindowsShortName As String
Dim sLine As String
sWindowsFolderName = GetFileFromPath(TruncateR(sPath))
Do While a.AtEndOfStream <> True
sLine = a.ReadLine
If (Len(sLine) > 50) Then
If (Mid(sLine, 50) = sWindowsFolderName) Then
sWindowsShortName = Mid(sLine, 37, 8)
Name sParentFolder & "\" & sWindowsShortName As sLegalPath
Exit Function
End If
End If
Loop
Else
LegalPath = True
End If
End Function
For files with illegal names, the approach is very similar. Illegal chars are replaced by _. Note that Unicode characters are not flagged as illegal.
Public Function IsIllegalFileCharIN(ByRef sFileName As String, ByVal sFolder As String) As Boolean
Dim sRegex As String
Dim objRegExp As New RegExp
Dim sOut As String
sRegex = "[<>:""/\\|?*„]+"
With objRegExp
.Pattern = sRegex
.IgnoreCase = True
.Global = True
IsIllegalFileCharIN = .test(sFileName)
End With
If (IsIllegalFileCharIN) Then
Dim sLegalFileName As String
With objRegExp
.Pattern = sRegex
.IgnoreCase = True
.Global = True
sLegalFileName = .Replace(sFileName, "_")
End With
' find file short name
Call shell(GetDAFolder & "\ListDir.bat """ & sFolder & """ """ & GetDAFolder & "\ListDir.txt""")
Dim a As TextStream
Dim fs As New Scripting.FileSystemObject
Set a = fs.OpenTextFile(GetDAFolder & "\ListDir.txt", ForReading, False)
Dim sWindowsFolderName As String
Dim sWindowsShortName As String
Dim sLine As String
sWindowsFolderName = sFileName
Do While a.AtEndOfStream <> True
sLine = a.ReadLine
If (Len(sLine) > 50) Then
If (Mid(sLine, 50) = sWindowsFolderName) Then
sWindowsShortName = Mid(sLine, 37, 12)
Name sFolder & "\" & sWindowsShortName As sFolder & "\" & sLegalFileName
sFileName = sLegalFileName
Exit Function
End If
End If
Loop
End If
On Error GoTo 0
End Function
GetDAFolder is a dedicated folder. The batch file ListDir.Bat contains
dir /X %1 >%2
I have a loop which run about 300,000 times at every iteration I stored:
time_elps = stwt.Elapsed.TotalMilliseconds
read.Add(time_elps, OFV_best)
Finally I just want to take the values of read (a dictionary of course) to draw a graph on excel.
I tried to export this data to excel:
oxl = CreateObject("Excel.application")
oxl.Visible = True
owb = oxl.Workbooks.Add
osheet = owb.ActiveSheet
For i = 0 To 100
osheet.Cells(i + 1, 1).Value = read.Item(read.Keys.ElementAt(i))
osheet.Cells(i + 1, 2).value = read.Keys.ElementAt(i)
Next
and to a text file:
objStreamWriter = New StreamWriter("C:\Users\Dr. Mohamed ElWakil\Desktop\data.txt")
For i = 0 To read.Count - 1
objStreamWriter.WriteLine(CStr(read.Item(read.Keys.ElementAt(i)) & "," & (read.Keys.ElementAt(i))))
Next
objStreamWriter.Close()
In two cases it takes too too much time, it's longer than the time of running the code itself.
What do you suggest to get my data easily and fast?
Writing each value seperately to Excel is just really slow, have a go with this:
Dim arr2D(100, 1) As String
For i = 0 To 100
arr2D(i, 0) = read.Item(read.Keys.ElementAt(i))
arr2D(i, 1) = read.Keys.ElementAt(i)
Next
Dim oExcel As Object = CreateObject("Excel.Application")
Dim oWorkbook As Object = oExcel.Workbooks.Add
Dim oWorksheet As Object = oWorkbook.Worksheets(1)
Dim vRange As Object = oWorksheet.Range("A1")
vRange = vRange.Resize(UBound(arr2D, 1) + 1, UBound(arr2D, 2) + 1)
vRange.Formula = arr2D
vRange.Columns.autofit()
oExcel.Visible = True
every time I creat a new txt file with name "data" tailed with time.hour and time.minute
as #NicoSchertler, using for each var in read to get var.value and var.key
this is the fastest way
Dim file As System.IO.StreamWriter
Dim path As String
path = "C:\Users\Dr. Mohamed ElWakil\Desktop\data" & Now.Hour & Now.Minute & ".txt"
file = My.Computer.FileSystem.OpenTextFileWriter(path, True)
For Each var In read
file.WriteLine(var.Key & "," & var.Value)
Next
file.Close()
I am trying to compare files by objects to find dublicate. I have 2900 files in folder and i need to check them all. In other words I have to run compare methods 2900*2900 times and every time when comparing two file I need to open and close 1 of those. If there is a way to work with Corel files not to open them? or is it posible to get metadata\metadata.xml from Corel VBA files to check and compare some parametrs from it such as Objects(shapes) count?
I am in despered...
I am using this logic system
Private Sub CommandButton1_Click()
Dim Folder As String
MousePointer = fmMousePointerHourGlass
Folder = BrowseForFolderDlg("o:\", "Select Source Folder", GetWindowHandle("ThunderDFrame", Me.Caption))
tb_inputFolder.text = Folder
End Sub
Private Sub CommandButton2_Click()
Dim fso As Object
Dim objFolder As Object
Dim objFileList As Object
Dim vFile, vFile1 As Variant
Dim inputFolder As String, outputFolder As String
inputFolder = tb_inputFolder.text 'input folder
If (inputFolder = "") Then
Exit Sub
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = fso.GetFolder(inputFolder)
Set objFileList = objFolder.Files
Dim currentFile As String
Dim dunFiles() As String
Dim arrLength As Integer
ReDim Preserve dunFiles(1)
arrLength = 1
dunFiles(0) = ""
For Each vFile In objFileList
Dim doc As Document, doc1 As Document, buf As String
Dim fName As String
fName = (Left(vFile.name, Len(vFile.name) - 4))
buf = Right(vFile.path, 3)
If (buf = "cdr" And findArrayElement(dunFiles, arrLength, vFile.name) = -1) Then
Set doc = OpenDocument(vFile.path) 'document opend
dunFiles(arrLength - 1) = vFile.name
ReDim Preserve dunFiles((arrLength + 1))
arrLength = arrLength + 1
For Each vFile1 In objFileList
buf = Right(vFile1.path, 3)
If (vFile1.name = currentFile Or findArrayElement(dunFiles, arrLength, vFile1.name) <> -1 Or buf <> "cdr") Then
GoTo nextElement
End If
'Set doc1 = OpenDocument(vFile1.path) 'document opend
Dim res As Variant
res = writeFile(doc.FileName + " VS " + vFile1.name + " " + Str(Now), doc.FilePath + "compare.log")
If (compareDocs(doc, vFile1.path)) Then
dunFiles(arrLength - 1) = fName + "_" + vFile1.name
ReDim Preserve dunFiles((arrLength + 1))
arrLength = arrLength + 1
Dim name As String
name = vFile.ParentFolder.path + "\" + fName + "_" + vFile1.name
Name vFile1.path As name
res = writeFile(vFile.ParentFolder.path + "\" + fName + " the same as " + name, doc.FilePath + "rename.log")
End If
'doc1.Close
nextElement:
Next vFile1
doc.Close
End If
' doc.Close 'close document
Next vFile
lb_info.Caption = "Finished! Press exit"
End Sub
Private Function findArrayElement(inputArray() As String, inputLen As Integer, element As String)
Dim e As String
Dim i As Integer
findArrayElement = -1
For i = 0 To inputLen - 1
If (inputArray(i) = element) Then
findArrayElement = i
Exit Function
End If
Next i
End Function
Private Function compareDocs(doc As Document, path2 As String)
Dim doc1 As Document
Dim e1 As Shape, e2 As Shape, elements() As String
Dim sameShapesCount As Integer
sameShapesCount = 0
ReDim elements(1) As String
elements(0) = ""
Set doc1 = OpenDocument(path2) 'document opend
compareDocs = False
lb_info.Caption = "Comapre " + doc.FullFileName + " with " + path2
For Each e1 In doc.SelectableShapes
e1.UngroupAll
Next e1
For Each e2 In doc1.SelectableShapes
e2.UngroupAll
Next e2
If (doc.SelectableShapes.Count <> doc1.SelectableShapes.Count) Then
doc1.Close
Exit Function
End If
For Each e1 In doc.SelectableShapes
'If (findArrayElement(elements, (UBound(elements) + 1), Str(e1.StaticID)) = -1) Then
'ReDim Preserve elements(UBound(elements) + 1) As String
'elements(UBound(elements)) = e1.StaticID
For Each e2 In doc1.SelectableShapes
If (findArrayElement(elements, (UBound(elements) + 1), "2_" + Str(e2.StaticID)) = -1) Then
If (e1.CompareTo(e2, cdrCompareShapeType, cdrCompareEquals)) Then
If (e1.CompareTo(e2, cdrCompareFillType, cdrCompareEquals)) Then
If (e1.CompareTo(e2, cdrCompareOutline, cdrCompareEquals)) Then
If (e1.CompareTo(e2, cdrCompareOutlineColor, cdrCompareEquals)) Then
If (e1.CompareTo(e2, cdrCompareOutlineWidth, cdrCompareEquals)) Then
'If (e1.CompareTo(e2, cdrCompareShapeHeight, cdrCompareEquals)) Then
If (e1.CompareTo(e2, cdrCompareFil, cdrCompareEquals)) Then
'If (e1.CompareTo(e2, cdrCompareShapeWidth, cdrCompareEquals)) Then
ReDim Preserve elements(UBound(elements) + 1) As String
elements(UBound(elements)) = "2_" + Str(e2.StaticID)
sameShapesCount = sameShapesCount + 1
GoTo nextElement1
'End If
End If
'End If
End If
End If
End If
End If
End If
End If
Next e2
'End If
nextElement1:
Next e1
If (doc.SelectableShapes.Count = sameShapesCount) Then
compareDocs = True
End If
doc1.Close
End Function
Private Function writeFile(text As String, path As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object
If Not Dir(path, vbDirectory) = vbNullString Then
Set oFile = fso.OpenTextFile(path, 8)
Else
Set oFile = fso.CreateTextFile(path, 0)
End If
oFile.WriteLine text
oFile.Close
Set fso = Nothing
Set oFile = Nothing
End Function
The main problem is that the "open process" can last up to few minutes and to check 2k corel fiels I need a YEAR
In a first pass, open each file once.
Go over the data you care about -- object count or whatever -- that must be equal.
From this data, build a hash -- a pseudo-random value that combines information from each of them.
Build a table that maps from the hash to a set of draw files that match the hash.
Now you only have to compare files which have a the same hash value, not every pair of files. A well designed hash and data to feed it should reduce your collision rate to nearly zero.
This should speed up your program by a factor of 1000 to 3000 or so.
To ensure that the hash/collision works well, your first pass should just hash and print out the lists of collisions.
Sort the list by filesize. Only compare files that are similar in size. You can use dir to generate a sorted list by size.
You only need to open each file once. Hash each file (maybe an alphabetically list of object names). Store and sort and dupes are the same objects.
You can use excel if it's a one off, or a recordset if you need to do it in code.
I am new at vbs and am getting a error at the line set arr = readfile( FileName )
I am trying to read an file into an array
and can not figure out what i am doing wrong
Thanks in advance for your assistance
Dim FileName ' File Name to Process
Call MainProcedure
WScript.Quit
Sub MainProcedure
filename = "c:\print\check.bat"
WScript.Echo( "Printing document in progress..." )
WScript.Echo( "Filename ====> " & FileName )
Dim arr, i
i = 0
set arr = readfile( FileName )
For Each present In arr
' user = split(present,",")
' WScript.Echo user(0) & user(1) & user(2) & user(3) & user(4) & "|"
i = i + 1
WScript.Echo present & "|"
Next
End Sub
Sub readfile(strFile)
dim fs,objTextFile
set fs=CreateObject("Scripting.FileSystemObject")
If (fs.FileExists( strFile)) Then
dim userArrayList
set objTextFile = fs.OpenTextFile(strFile)
Set userArrayList = CreateObject( "System.Collections.ArrayList" )
Do Until objTextFile.AtEndOfStream
strNextLine = objTextFile.Readline
userArrayList.add strNextLine
Loop
objTextFile.Close
set objTextFile = Nothing
set fs = Nothing
set readfile = userArrayList
Else
'Alert User
WScript.Echo("File does not exist!")
WScript.Quit()
End If
end Sub
Your
set arr = readfile( FileName )
implies that readfile() is a Function (returning an ArrayList). But you define
Sub readfile(strFile)
...
set readfile = userArrayList
...
end Sub
You may try to change this to
Function readfile(strFile)
...
set readfile = userArrayList
...
End Function
ADDED:
The task "Read a files' lines into an array" can be done in a much more simple way:
cscript fitoar.vbs
0 Option Explicit
1 Dim a : a = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile("fitoar.vbs").ReadAll(), vbCrLf)
2 Dim l
3 For l = 0 To UBound(a)
4 WScript.Echo l, a(l)
5 Next
6