Skip to content

Commit c8f5522

Browse files
antonigantonig
committed
Merge branch 'master' of https://github.com/antonig/VBScript 
2 parents 8cf4073 + fd186c6 commit c8f5522

File tree

12 files changed

+963
-62
lines changed

12 files changed

+963
-62
lines changed

‎Compression/README.md‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
# Compression
2+
File compression in VBS
3+
4+
## lzw.vbs
5+
An implemantation of the LZW algorithm. It uses 2 bytes per code, variable length codes are out of question in VBS, as those would require lots of integer division and modulus operations. Not so fast, compresion requires 5 to 10 segs per MB. Decompression is much faster.
6+
7+
## ascii-art-rle.vbs
8+
Uses a homebrew variant of the RLE line algorithm to compress ASCII art images with a lot of spaces. Not so good with images with shade gradients. It encodes pure ascii unique chars as 128+asc and lengths with the same char as 128+asc & 32+length.
9+
10+

‎Compression/ascii_art_rle.vbs‎

Lines changed: 125 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,125 @@
1+
'ascii art compressor. Lines should not be longer then 127 bytes!!!
2+
3+
Option Explicit
4+
Dim a,b,o,fso,fn,aa,bb,cc
5+
If WScript.Arguments.Count >0 Then
6+
aa=WScript.Arguments(0)
7+
else
8+
aa="snoopy.txt" ' The file To test with, should be in the script folder
9+
aa=Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\"))&aa
10+
End If
11+
bb=aa & ".rle"
12+
cc=aa & ".unc"
13+
14+
if not fileexists(aa) then print "File " & aa & " not found":wscript.quit
15+
16+
Set fso=createobject("Scripting.Filesystemobject")
17+
a=readfile(aa)
18+
o= compress (a)
19+
writefile bb,o
20+
print "Size reduction: "& FormatNumber((100-(100*filesize(bb) / filesize(aa))),2) &"%"
21+
b=decompress (o)
22+
writefile cc,b
23+
WScript.quit(1)
24+
25+
26+
function filesize(ff) filesize= CreateObject("Scripting.FileSystemObject").GetFile(ff).Size : end Function
27+
function fileexists(fn) fileexists= CreateObject("Scripting.FileSystemObject").FileExists(fn): end function
28+
29+
sub print(s):
30+
On Error Resume Next
31+
WScript.stdout.WriteLine (s) :
32+
if err= &h80070006& then WScript.Echo " Please run the script with CScript":WScript.quit
33+
End sub
34+
35+
Function makepath(file)
36+
Dim sfn: sfn=WScript.ScriptFullName
37+
sfn= Left(sfn, InStrRev(sfn, "\"))
38+
makepath= sfn & file
39+
End Function
40+
41+
Function readfile(file)
42+
Dim a
43+
With WScript.CreateObject("ADODB.Stream")
44+
.Open
45+
.type=2 'texto
46+
.Charset = "x-ansi"
47+
.LoadFromFile file
48+
a=.readtext
49+
.Close
50+
End With
51+
'print "read "& Len(a)
52+
readfile=Split(a,vbCrLf)
53+
If UBound(readfile)=0 Then readfile=Split(a,vbCr)
54+
End Function
55+
56+
57+
Sub Writefile(File, Sdata) 'sin BOM!!
58+
Dim a
59+
If IsArray(sdata) Then a=Join(sdata,vbCr) Else a=sdata
60+
print "writing "& Len(a)
61+
With WScript.CreateObject("ADODB.Stream")
62+
.Open
63+
.type=2 'texto
64+
.Charset = "x-ansi"
65+
.writetext a
66+
.SaveToFile file ,2 'adSaveCreateOverWrite
67+
.Close
68+
End With
69+
End Sub
70+
71+
72+
73+
'codificamos caracter +128, repeticion+32
74+
Function compress (a)
75+
ReDim b(UBound(a))
76+
77+
Dim i,j,ch,lch,cnt,s
78+
For j=0 To UBound(a)
79+
s=RTrim(a(j))
80+
If Len(s)>0 then
81+
cnt=1
82+
ch=Asc(mid(s,1,1))
83+
For i=2 To len(s)
84+
lch=ch
85+
ch=Asc(mid(s,i,1))
86+
If ch=lch Then
87+
cnt=cnt+1
88+
If i= Len(s) Then B(j)=b(j) & chr(128+ch) & Chr(32+cnt)
89+
ElseIf ch<>lch Then
90+
B(j)=b(j) & chr(128+lch)
91+
If cnt>1 Then B(j)=b(j) & chr(32+cnt):cnt=1 'solo cnt si mas de 1
92+
If i= Len(s) Then B(j)=b(j) & chr(128+ch)
93+
End If
94+
Next
95+
End if
96+
97+
Next
98+
compress=b
99+
End Function
100+
101+
Function decompress(a)
102+
Dim i,j,c,lc,w
103+
ReDim b(UBound(a))
104+
For i=0 To UBound(a)
105+
'cada linea
106+
lc=0
107+
If Len(a(i))>0 then
108+
c=Asc(Mid(a(i),1,1))
109+
For j=2To Len(a(i))
110+
lc=c:w=0
111+
c=Asc(Mid(a(i),j,1))
112+
If c<128 Then
113+
B(i)=b(i) & string(c-32,Chr(lc-128))
114+
w=1
115+
ElseIf c>128 And lc>128 Then
116+
B(i)=b(i) & Chr(lc-128)
117+
If j= Len(a(i)) Then B(i)=b(i) & Chr(c-128)
118+
w=1
119+
End if
120+
Next
121+
If c>128 And w=0 Then B(i)=b(i) & Chr(c-128)
122+
End if
123+
Next
124+
decompress=b
125+
End Function

‎Compression/lzw2.vbs‎

Lines changed: 156 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,156 @@
1+
'LZW compress - uncompress functions in plain VBScript By Antoni gual 2022
2+
'----------------------------------------------------------------------------
3+
'I just made several times faster an idea by Rabbit found here
4+
'https://bytes.com/topic/access/insights/962727-lzw-compression-algorithm-vbscript
5+
'------------------------------------------------------------------------------
6+
'Notes:
7+
'It's slow, compresses at a rate of 5 secs/Mb it uses only the usual VBScript resources, fileObject,
8+
' Dictionary and ADODB.Stream
9+
'No auxiliar dll to register
10+
'
11+
'The compress code use an UTF-16 stream so it adds a BOM at the start of the file
12+
'making the compressed file longer by 2 bytes. I' did'nt care to remove it..
13+
'
14+
'The decompression is much faster than the compression. This is because
15+
'compression requires a dictionnary while decompression works with a simple array of strings
16+
'
17+
'All the work is made with both files in memory: input file is read with a readall
18+
' while output file is written to a memory stream.
19+
'
20+
'Do not test with an already compressed file .jpg .gif .png .docx .xlsx ....
21+
'
22+
' Tested in WinXP SP3, Windows 7 Professional 32 and Windows10. Run it with cscript
23+
'------------------------------------------------------------------------------
24+
25+
Option Explicit
26+
Const numchars=255 'good for binary files
27+
Const maxcod=32767 'maximum 32767 or chrw will complain!
28+
Const ForReading = 1, ForWriting = 2, ForAppending = 8
29+
30+
Function LZWCompress(strPath,wpath)
31+
Dim oDict, strNext, strCurrent, intMaxCode, i,z,si,ii,ofs,ofread
32+
Set oDict = CreateObject("Scripting.Dictionary")
33+
With WScript.CreateObject("ADODB.Stream")
34+
.type= 2
35+
.charset= "x-ansi"
36+
.open
37+
.loadfromfile strpath
38+
si=.readtext
39+
.close
40+
End with
41+
With WScript.CreateObject("ADODB.Stream")
42+
.type=2 '2text 1binary
43+
.charset= "utf-16le"
44+
.open
45+
46+
intMaxCode = numchars
47+
For i = 0 To numchars
48+
oDict.Add Chr(i), i
49+
Next
50+
51+
strCurrent = Left(si,1)
52+
For ii=2 To Len(si)
53+
strNext = Mid(si,ii,1)
54+
55+
If oDict.Exists(strCurrent & strNext) Then
56+
strCurrent = strCurrent & strNext
57+
Else
58+
.writetext ChrW(oDict.Item(strCurrent))
59+
intMaxCode = intMaxCode + 1
60+
oDict.Add strCurrent & strNext, intMaxCode
61+
strCurrent = strNext
62+
63+
If intMaxCode >= maxcod Then
64+
oDict.RemoveAll
65+
intMaxCode = numchars
66+
For i = 0 To numchars
67+
oDict.Add Chr(i), i
68+
Next
69+
End If
70+
End If
71+
next
72+
.writetext ChrW(oDict.Item(strCurrent))
73+
.savetofile wpath,2 'adsavecreateoverwrite
74+
.Close
75+
76+
End with
77+
78+
Set oDict = Nothing
79+
End Function
80+
81+
Function lzwUncompress(strpath, wpath)
82+
Dim intNext, intCurrent, intMaxCode, i,ss,istr
83+
Set istr= WScript.CreateObject("ADODB.Stream")
84+
istr.type=2
85+
istr.charset="UTF-16LE"
86+
istr.Open
87+
istr.loadfromfile strpath
88+
istr.Position=2
89+
With WScript.CreateObject("ADODB.Stream")
90+
.type=2 '2text 1binary
91+
.charset= "x-ansi"
92+
.open
93+
reDim dict(maxcod)
94+
intMaxCode = numchars
95+
For i = 0 To numchars : dict(i)= Chr(i) : Next
96+
'strNext = Left(si,1)
97+
intCurrent=ascw(istr.readtext(1))
98+
99+
While Not istr.EOS
100+
ss=dict(intCurrent)
101+
.Writetext ss
102+
intMaxCode = intMaxCode + 1
103+
Dim x:x=istr.ReadText(1)
104+
intNext=ascw(x)
105+
If intNext<intMaxCode Then
106+
dict(intMaxCode)=ss & Left(dict(intNext), 1)
107+
Else
108+
dict(intMaxCode)=ss & Left(ss, 1)
109+
End If
110+
If intMaxCode = maxcod Then intMaxCode = numchars
111+
intCurrent = intNext
112+
wend
113+
.Writetext Dict(intCurrent)
114+
.savetofile wpath,2 'adsavecreateoverwrite
115+
.Close
116+
End With
117+
istr.close
118+
Set istr=nothing
119+
End function
120+
121+
sub print(s):
122+
On Error Resume Next
123+
WScript.stdout.WriteLine (s) :
124+
if err= &h80070006& then WScript.Echo " Please run the script with CScript ":WScript.quit
125+
End sub
126+
127+
function filesize(fn) filesize= CreateObject("Scripting.FileSystemObject").GetFile(fn).Size: end function
128+
function fileexists(fn) fileexists= CreateObject("Scripting.FileSystemObject").FileExists(fn): end function
129+
'-----------------------------------------------
130+
Dim t,t1,x,a,b,c
131+
132+
If WScript.Arguments.Count >0 Then
133+
a=WScript.Arguments(0)
134+
else
135+
a="unixdict.txt" ' The file To test with, shoudl be in the script folder
136+
a=Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\"))&a
137+
End If
138+
b=a & ".lzw"
139+
c=a & ".unc"
140+
If Not fileexists(a) Then print "File " &a & " not found":WScript.quit
141+
142+
t1=Timer
143+
print "Compressing " &a
144+
LZWCompress a,b
145+
print Timer-t1 & " Seconds"
146+
print "Size reduction: "& FormatNumber(100-(100*filesize(b) / filesize(a)),2) &"%"
147+
148+
print "decompressing " &b
149+
t=timer
150+
LZWUncompress b,c
151+
print Timer-t & " seconds"
152+
print Timer-t1 & " seconds Total"
153+
154+
x= "cmd /k fc """ & a & """ """ & c & """ /N &pause & exit "
155+
CreateObject("WScript.Shell").run x,,true
156+
wscript.quit 1

‎Documents/What_is_vbs.htm‎

Lines changed: 30 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ <h2>What is VBScript</h2>
1515
<li>As as server side script language in IIS' Active Server Pages</li>
1616
<li>As an alternate client side script language in html files intended to be viewed in Internet Explorer (deprecated! Use ECMAScript!)</li>
1717
<li>As one of the script languages available in the HTML Applications (HTA);Standalone apps based in web interface running in mshta.exe.</li>
18+
1819
<li>As the main script language embedded in third party applications as </li>
1920
<ul>
2021
<li> HP QuickTest Professional (QTP), now Unified Functional Terting (UFT) software tester </li>
@@ -32,7 +33,7 @@ <h2>What is VBScript</h2>
3233
</ul>
3334

3435
<p> </p>
35-
<h2> As a desktop aplication running in Windows Scripting Host:</h2>
36+
<h2> Pros and cons as a desktop scripting language running in Windows Scripting Host:</h2>
3637
<p></p>
3738
<p> </p>
3839
<h3> Features: </h3>
@@ -47,57 +48,69 @@ <h3> Features: </h3>
4748
<li>Has a built in object dictionary (an associative array)</li>
4849
<li>Can interact with software as ActiveX controls, and COM automation servers and components using late binding.</li>
4950
<ul>
51+
5052
<li>Has built in access to SQL queries to any database having an ODBC driver installed. </li>
5153
<li>Built in SQL can search Windows internals as WMI, Windows Search,ASDI </li>
5254
<li>Access to Microsoft XML parser</li>
5355
<li>Access to ADODB.streams allowing to read and save text in different codepages, convert between them </li>
5456
<li>If .NET is present it can access some handy containers as ArrayList, Stack or Queue </li>
5557
<li>Can acces the object model of applications having VBA as their scripting interface, allowing to control them from outside</li>
58+
5659
</ul>
5760
<li>Good date-time functions. But no UTC support</li>
5861
<li>Support to Locale change (decimal separator, first day of week..)</li>
59-
<li>supports named command line arguments</li>
62+
<li>Supports named command line arguments allowing easy parsing.</li>
6063
<li>Error reporting including the line number.</li>
61-
<li>for each, with.
64+
65+
<li>for each, with.</li>
6266
<li>Can run other non-COM apps, sending input to their sdin capturing their stdout live and getting their exit code at the end</li>
67+
6368
</ul>
6469

6570
<p> </p>
6671
<h3> Cons:</h3>
6772
<ul>
6873
<li>The acces to files is only sequential (text or binary), with no random access. </li>
74+
6975
<li>false is 0, not false is -1</li>
7076
<li>no shift operations on bits. * and \ (integer division) must be used. </li>
7177
<li>Numbers are converted from Double to SIGNED 32 bit integers for bitwise logic,integer division\ and modulus. Bit twiddling is complicated as the sign gets in the way. </li>
72-
78+
<li>Variants use a minimum of 16 bytes. A boolean value is 16 bytes </li>
79+
<li>In boolean variables false is 0, not false is -1.</li>
80+
<li>There are no shift operations on bits. * and \ (integer division) must be used. </li>
81+
<li> Before performing \ MOD AND OR XOR NOT operators the double precision numbers are converted to a 32 bit SIGNED integer, so the sign bit must be dealed separately in bit twiddling to avoid funny results </li>
82+
<li>No shift left - shift right, integer division and product must be used </li>
7383
<li>No preprocessor support, no include, conditional compiling</li>
7484
<li>No json support. </li>
75-
<li>Arrays are static, REDIM PRESERVE must be used to change its size, no push-pop</li>
76-
<li>No wilcards accepted in the filenames passed to folder/file handling functions</li>
85+
<li>Arrays are static, REDIM PRESERVE must be used to change its size, no push-pop.</li>
86+
87+
<li>No wilcards are accepted in the filenames passed to folder/file handling functions.</li>
7788
<li>It has not been given new features since Windows XP </li>
78-
<li>Spotty Unicode support ascw and chrw. only UTF32</li>
89+
<li>Spotty Unicode support ascw and chrw. Only UTF32. ODBC Streams allow conversion of text fies to UTF8</li>
7990
<li>Strings don't allow indexing on write on them, to modify a string :
80-
<ul> <li> placeholders+ Replace,</li><li> regex must be used.</li><li> Or the string has to be built by concatenation</li></ul></li>
91+
<ul> <li> placeholders + Replace,</li><li> regex must be used.</li><li> Or the string has to be built by concatenation</li></ul></li>
8192
<li>Clumsy string indexing for reading asc(mid(s,i,1)) at the place of s[i]</li>
8293
<li>No way to build a windows form, the official way is to write some html to a file and call Internet Explorer to display it and get user selections from it. </li>
8394
<li>Windows from XP to W8.1 did'nt support ANSI escape codes so console apps using them will display garbage on these OS versions.</li>
8495
<li>It can't get single characters from the keyboard, any user input must be terminated by enter. No shooting games!</li>
8596
<li>It can't get mouse input, except clicks in buttons in the the two built-in forms MessageBox and (text)InputBox</li>
8697
<li>Windows can default to two different runtimes Wscript and Cscript. In Wscript not all scripts will run. The main difference:</li>
8798
<ul>
88-
<li>Wscript can't open a console, </li>
89-
<li>Wscript do not have access to the standard streams stdin,stdout and stderr, </li>
90-
<li>Wscript can't be aborted with Ctrl-C.</li>
91-
<li>Wscript.echo writes to console in CScript but in WScript it opens a generic MessageBox that must be acknowledged for the program to continue </li>
99+
100+
<li>Wscript does'nt open a console, </li>
101+
<li>Wscript do not have access to the standard streams stdin,stdout and stderr, </li>
102+
<li>Wscript can't be stopped with Ctrl-C.</li>
103+
<li>Wscript.echo writes to console in CScript but in WScript it opens a generic MessageBox that must be acknowledged for the program to continue </li>
92104
<li>The Wscript forms (Messagebox, InputBox and Popup) are available just the same in Cscript</li>
93105
</ul>
94-
<li>No access to a graphics screen, a file must be created and viewed in an external viewer ( BMP or HTML including SVG), or ASCII (ANSI) art must be used. </li>
95-
<li>no named or optional arguments in functions</li>
96-
<li>No register or user defined variables. Arrays of variants may substitute them. There is no way of having a packed register for file I/O unless it's built byte to byte as a string.</li>
106+
<li>No access to a graphics screen, a file must be created and viewed in an external viewer (BMP or HTML including SVG), or ASCII (ANSI) art must be used. </li>
107+
<li>No named or optional arguments in functions</li>
108+
<li>No register or user defined variables. Methodless classes are a workaround. There is no way of having a packed register for file I/O unless its built byte to byte as a string.</li>
97109
<li>No continue or goto keywords. It has exit do/for/sub/function</li>
110+
111+
<li>Sketchy error handling: only On Error Resume Next and the err object</li>
112+
<li>No formatted output equivalent to printf. Poor format functions, no align right</li>
98113

99-
<li>Sketchy error handling: only On Error Resume Next and the err object</li>
100-
<li>No formatted output equivalent to printf. Format functions only for time/date and floating point values, no align right</li>
101114
<li>Can't redimension or change console size or change charset.</li>
102115
<li>The requirement to type <i>set fso=CreateObject("Scripting.FileSystemObject")</i> before using any file handling method should be punished by law.</li>
103116
<li>Array base can't be changed fom 0</li>

0 commit comments

Comments
 (0)