How to read variable length application identifiers in .zpl datamatrix in VB6? - vb6

According to GS1 standards (http://www.databar-barcode.info/application-identifiers/) a variable length field in a barcode should have a break sign to signal when it ends.
Code for the .zpl printer in my test is as follows:
^BY200,200^FT250,860^BXN,12,200,0,0,6,~
^FH\^FD\7E10012345678912345678910123\7E1151606013712\7E1^FS
This was written according to (http://www.servopack.de/support/zebra/ZPLbasics.pdf) and when I scan it into Notepad++ I see that the breaks are applied in the code as shown in the picture below.
But when I try to scan it in my VB6 application it doesn't appear to catch the break sign and writes everything from 10 (batch number) and forward into the batchnumber instead of breaking before 15 (expiration date).
My code looks like this:
ElseIf Left(Data, 2) = AI_BATCH Or Left(Data, 6) = "<GS>10" Or Left(Data, 3) = "~10" Then
If Left(Data, 2) = AI_BATCH Then
Data = Mid(Data, 3)
ElseIf Left(Data, 6) = "<GS>10" Then
Data = Mid(Data, 7)
ElseIf Left(Data, 3) = "~10" Then
Data = Mid(Data, 4)
End If
' Calculate length
While Mid(Data, AI_BATCH_LEN + 1, 1) <> "" And Mid(Data, AI_BATCH_LEN + 1, 1) <> "~" And Mid(Data, AI_BATCH_LEN + 1, 1) <> "<"
AI_BATCH_LEN = AI_BATCH_LEN + 1
Wend
gs1.batch = Trim(Left(Data, AI_BATCH_LEN))
Data = Mid(Data, 1 + AI_BATCH_LEN)
Thanks in advance.

You seem to be looking for the 2 ASCII characters 'G' and 'S' but you should be looking for the single 'GS' character - GS is ASCII control character 29 (Group Separator).
This character is not printable as a letter so Notepad++ (and the font its using) substitute the graphical glyph you see.
Use chrw$(29) to locate this character:
x = "Hello" & chrw$(29) & "World"
?x
HelloWorld
?left$(x, instr(x, chrw$(29)) - 1)
Hello

Related

How to Enable Scroll Bar of QBasic Output Window?

I'm trying to display a statement 1000 times in QBASIC (using for statement). I think the program works properly, but I cannot see the 1000 statements because I cannot scroll up and down in the output window of QBASIC. I can see only the last part of the 1000 statements.
FOR x = 1 TO 1000
PRINT "maydie";
PRINT
NEXT x
That will be very hard. For QBasic you have to know how PRINT works. Than with look you could write an TSR program that does what you want in some other language. Alternative is store everything in array and create you own display routine with scrolling. But with 1000 lines will run into memory restrictions
In short, unless you're using a modern take on QBasic, you can't.
What you can do is print the output to a text file:
OPEN "C:\somefile.txt" FOR OUTPUT AS #1
FOR x = 1 TO 1000
PRINT #1, "maydie":
PRINT
NEXT x
This will write "maydie" to C:\somefile.txt 1000 times. Then use some text editor to view the output. You could even use a program to count the lines of text, something like OPEN "C:|somefile.txt" FOR INPUT AS #1: WHILE NOT EOF(1): INPUT #1, junk$: i = i + 1: WEND: PRINT "There were " + STR$(i) + " lines."
Though the other answerers are correct in saying that it is not inbuilt and hence not possible, I agree that this is very desirable! Consequently, I have time and time again devised scripts based on the following:
DIM text(1 to 1000) AS STRING
'Define text below: Here I've just defined it as every line being
'"maydie" with the value of the line number, but it could be whatever.
FOR i = 1 TO 1000
text(i) = STR$(i) + "maydie"
NEXT i
CLS
position% = 0
FOR i = 1 to 25
LOCATE i, 1: PRINT text(i); SPACE$(80 - LEN(text(i)));
NEXT i
DO
x$=INKEY$
IF x$ <> "" THEN
SELECT CASE x$
CASE CHR$(0) + CHR$(72) 'Up arrow
position% = position% - 1
IF position% < 0 THEN position% = 0
CASE CHR$(0) + CHR$(80) 'Down arrow
position% = position% + 1
IF position% > 975 THEN position% = 975
CASE CHR$(0) + "I" 'Page Up
position% = position% - 24
IF position% < 0 THEN position% = 0
CASE CHR$(0) + "Q" 'Page Down
position% = position% + 24
IF position% > 975 THEN position% = 975
CASE CHR$(27) 'ENDS the Program on ESC key.
END
END SELECT
FOR i = 1 to 25
LOCATE i, 1: PRINT text(i + position%); SPACE$(80 - LEN(text(i + position%)));
NEXT i
END IF
LOOP
Tested and works! If you want to use it multiple times in your program for multiple different text blocks, you can just turn it into a function and pass it the variables you want.

Active Directory vbscript case conversion

I need some help with my script.
The full script can be found here
The portion of the script I need help with is this:
If (Len(strTitle) > 3) Then
arrStr = Split(strTitle," ")
For i=0 To UBound(arrStr)
word = LCase(Trim(arrStr(i)))
word = Replace(word, Mid(word, 1, 1), UCase(Mid(word, 1, 1)), 1, 1)
strTitleCon = strTitleCon & word & " "
Next
End If
In our AD, everything is written in uppercase which is why I need to make it title case. However, this doesn't work if it's for title's like "QC Technician" or "HR Manager".
How can I go about doing that with the current script that I have?
Add another condition inside the loop and change the casing only if the string is longer than 2 characters.
For i=0 To UBound(arrStr)
word = Trim(arrStr(i))
If Len(word) > 2 Then
word = UCase(Left(word, 1)) & LCase(Mid(word, 2))
End If
arrStr(i) = word
Next
strTitleCon = Join(arrStr, " ")

Get number first and second and third from text line

I have the following format in my txt file:
1 1,30705856804525E-7 2,64163961816166E-8
1,12201845645905 1,24157281788939E-7 2,45690063849224E-8
1,25892543792725 1,18248813407718E-7 2,29960868125545E-8
1,41253757476807 1,13006606738963E-7 2,16654658657944E-8
1,58489322662354 1,0842624220686E-7 2,05472137082552E-8
1,77827942371368 1,04479198625995E-7 1,96135836461053E-8
1,99526226520538 1,01119816520168E-7 1,8839035220708E-8
2,23872113227844 9,82917924829962E-8 1,82003176973922E-8
2,51188635826111 9,59338279926669E-8 1,76765304615856E-8
2,81838297843933 9,39840489877497E-8 1,72491425587395E-8
3,16227769851685 9,23831819932275E-8 1,69019571671924E-8
3,54813385009766 9,10766573269939E-8 1,66210121221866E-8
3,98107171058655 9,00157104410937E-8 1,63944182673958E-8
4,46683597564697 8,91577514039454E-8 1,62121711611007E-8
5,01187229156494 8,8466336478632E-8 1,60659361370108E-8
5,6234130859375 8,7910699164695E-8 1,59488209305891E-8
6,30957365036011 8,74651959748007E-8 1,58551749507296E-8
7,07945775985718 8,71086527354237E-8 1,57803938805046E-8
7,94328212738037 8,68237393092386E-8 1,57207402651238E-8
8,91250896453857 8,65963372120859E-8 1,56731942979604E-8
10 8,64150138113473E-8 1,56353241465013E-8
11,2201843261719 8,62705391568852E-8 1,5605175818223E-8
I need to get only value for integers on left and right value so in this example I need to get:
1
2,64163961816166E-8
10
1,56353241465013E-8
This is what I've tried:
' Check Noise Spectral Density.txt exists
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(fso.GetParentFolderName(WScript.ScriptFullName) + "\Projects\Noise Spectral Density.txt")) Then
' Open the file for input.
Set NoiseSpectralDensity = fso.OpenTextFile(fso.GetParentFolderName(WScript.ScriptFullName) + "\Projects\Noise Spectral Density.txt", 1)
' Noise Variables
Dim Noise
' Read from the file and display the results.
Do While NoiseSpectralDensity.AtEndOfStream <> True
' Read Line By Line
TextLine = NoiseSpectralDensity.ReadLine
' Check If Number
'If (IsNumeric(Left(TextLine, 5))) Then
' Get Noise
' Noise # 1kHz
Noise = Right(TextLine, InStr(Mid(TextLine, 2), InStr(TextLine, " ")-1))
x = MsgBox("SNR: " & Split(Left(TextLine, 5), " ")(0) & " NOISE: " & Noise & "",0, "Noise Spectral Density")
'End If
Loop
' Close the file for input.
NoiseSpectralDensity.Close
Else
x = MsgBox("Noise Spectral Density.txt NOT Found!" & vbCrLf & "Wave->Save As Text...", 0, "Noise Spectral Density")
End If
But I could not get left and right numbers in VBScript using Split(TextLine, " ")(0).
Your data seems to be tab-separated, so you could do something like this:
arr = Split(TextLine, vbTab)
If Not (InStr(arr(0), ",") > 0) Then
'first number doesn't have decimals
snr = arr(0)
noise = arr(2)
End If
Though the solution provided by #AnsgarWiechers should work but in case, if it doesn't, you can make use of regular expressions(Replace the whole Do-while loop with the following):
Set objReg = New RegExp
objReg.Pattern = "^(\d+)(?=\s).*\s+([\d,Ee-]+)$" 'See the explanation below
Do While NoiseSpectralDensity.AtEndOfStream <> True
'Read Line By Line
TextLine = NoiseSpectralDensity.ReadLine
' Check If Number
Set objMatches = objReg.Execute(TextLine)
For Each objMatch In objMatches
SNR = objMatch.submatches.item(0)
Noise = objMatch.submatches.item(1)
MsgBox "SNR: "&SNR&"; Noise: "&Noise
Next
Loop
Click for Regex Demo
Regex Explanation:
^ - asserts the start of the string
(\d+) - matches 1+ occurrences of a digit and captures it in Group 1
(?=\s) - positive lookahead to find the position immediately preceded by a white-space. So the digits in the step 2 will be matched until a whitespace(spaces,tabs etc.) is encountered
.* - matches 0+ occurrences of any character except a newline
\s+ - matches 1+ occurrences of a whitespace
([\d,Ee-]+) - matches 1+ occurrences of a digit or , or - or the letter E or e and capture it in group 2
$ - asserts the end of the string

combine pipe delimited lines of text in multiple lines with vbscript?

I've got a text file of output that looks essentially like this:
SMITHERSON, SMITH|00012345|15-Jan-1999|000885340
619649339|29-Sep-2015 00:09:30|Black|JOHNERSON, JOHN
00067890|02-Dec-1996|000490365|620094551
29-Sep-2015 23:06:01|Green|DAVISON, DAVE|00086543|06-Jun-2001|000938585
226438332|28-Sep-2015 00:12:12|Yellow
Seven pieces of data, they are always in the correct order but unfortunately they run together and onto different lines. There are carriage return + line feeds at the end of each line and there aren't pipe delimiters. The individual pieces of data are never split over multiple lines - I'm having a hard time explaining so here's another example:
DATA 1|DATA 2|DATA 3
DATA 4
DATA 5|DATA 6|DATA 7
DATA 1|DATA 2|DATA 3|DATA 4
DATA 5|DATA 6|DATA 7
etc...
They will have spaces between them but each piece of data will always stay on it's own line.
And I'm trying to turn it into this:
SMITHERSON, SMITH|00012345|15-Jan-1999|000885340|619649339|29-Sep-2015 00:09:30|Black
JOHNERSON, JOHN|00067890|02-Dec-1996|000490365|620094551|29-Sep-2015 23:06:01|Green
DAVISON, DAVE|00086543|06-Jun-2001|000938585|226438332|28-Sep-2015 00:12:12|Yellow
DATA 1|DATA 2|DATA 3|DATA 4|DATA 5|DATA 6|DATA 7
DATA 1|DATA 2|DATA 3|DATA 4|DATA 5|DATA 6|DATA 7
etc.
Seven pieces of data each on their own line, but still seperated by the '|' for another piece of software to read correctly.
I am spending about one hour every day correcting the text files by hand, so I've been trying to find an example I can work from to do this for a while but have not had any luck wrapping my head around this.
This code is ok. I only tested your sample text, not big files.
It will replace line feeds with the delimiter, then convert the entire file into one big array:
Set fso = CreateObject("Scripting.FileSystemObject")
Set input = fso.OpenTextFile("input.txt", 1)
Set output = fso.OpenTextFile("output.txt", 2, True)
Dim data: data = input.ReadAll
input.Close()
data = Replace(data, vbCrlf, "|")
data = Split(data, "|")
For i=0 To UBound(data) Step 7
output.WriteLine data(i) & "|" & data(i+1) & "|" & data(i+2) & "|" & data(i+3) & "|" & data(i+4) & "|" & data(i+5) & "|" & data(i+6)
Next
output.Close()
Untested, but something like this might do it. (Essentially it copies input to output as a stream, but newlines in the input are converted to pipe characters and every seventh pipe in the output is converted to a newline)
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("D:\data\thefile.txt", 1)
Set o = fs.OpenTextFile("D:\data\combined.txt", 2, True)
pipecount = 0
Do While f.AtEndOfFile <> True
If f.AtEndOfLine = True Then
c = f.Read(2) ' Skip the CR+LF
c = "|" ' and pretend we got a pipe character
Else
c = f.Read(1)
End If
If c = "|" Then
pipecount = pipecount + 1
If pipecount = 7 Then
pipecount = 0
o.WriteLine()
Else
o.Write("|")
End If
Else
o.Write(c)
End If
End While
o.Close()

Very simple set value of array cell, program very slow when he writes on specify column

I am using a continuous and old professional program. My program builds several simple data arrays and writes the array to an excel cell like this:
Sheets("toto").Cells(4,i) = "blabla"
But for one value of i, the write time is very long and I don't understand why.
Here is my code :
...
For No_Bug = 0 To Indtab - 1
If mesComments(No_Bug) <> "" Then
Sheets(feuille_LBT).Cells(Ligne_Bug, 1) = Ligne_Bug - 5
Sheets(feuille_LBT).Cells(Ligne_Bug, 2) = mesID_Test(No_Bug)
Sheets(feuille_LBT).Cells(Ligne_Bug, 3) = mesResultats(No_Bug)
Sheets(feuille_LBT).Cells(Ligne_Bug, 4) = mesComments(No_Bug)
Sheets(feuille_LBT).Cells(Ligne_Bug, 5).FormulaLocal = mesScreens(No_Bug)
Sheets(feuille_LBT).Cells(Ligne_Bug, 6) = 2 'If I comment only this line, the programm is fast, ifnot the programm is very slow (~1, 2 secondes per loop), What the hell ??? xD
Sheets(feuille_LBT).Cells(Ligne_Bug, 7) = 1
End If
...
Is this cell referenced from other cells? Check if any complicated computations related with this cell.

Resources