| |
ehvbs
Posts: 2012
Score: 48
Joined: 6/22/2005
From: Germany
Status: offline
|
I hope the Admins won't chide me for violating the rules for this forum,
because I have to admit that the most useful parts of this script will
be written by you. But at least the posted code was written by me.
Mator.hta is an HTA application that transforms a source string to a
target/destination string by using one suitably selected function from
a set of functions defined (mostly by you) in the file mator-fncs.vbs.
Thus it gives you an extensible framework to do string processing tasks
automagically.
I choose this sample as my first contribution to this forum, because
it is an easy example of code reuse in VBScript.
The application consits of 4 files:
mator.hta - the HTA application itself
mator-fncs.vbs - the functions to transform strings
VBSlib.vbs - some functions useful for VBScript code in general
HTXLib.vbs - some functions useful for HTML/HTA code
cns-mator.vbs - command line script using mator-fncs.vbs
These files should reside in one directory; to start the application,
doubleclick on mator.hta.
mator.hta is a fairly standard HTA application. You'll find the
<hta:application> tag and some <meta> tags to remove all doubts concerning
the used languages. The css section is an efficient way to centralize
all specifications needed for a resizable dialog style window. (I prefer this
approach to designing for (different) screen size(s) or forcing the user
to work in a full screen window.)
Including common code in HTA/HTML files via the <script ... src = "..."> tag
is an established technology. mator.hta includes three files from the application's
directory. If you use code libraries already or let this example motivate you
to do that, you will want to put your libraries in one common directory. Then
you must change the source pathes from relative to absolute.
The following infile script block is executed after the main code (if any) of
the included .vbs files, but before the rendering of the page (and event code
like "Sub onloadBody()").
Global variables are nothing to be proud of, but I think they are allowed and
useful in script languages. mator.hta code gets its global variables from
the included files:
Each VBS library (xxxLib.vbs) Dims and Sets an Object goXXXLIB of Class
cXXXLIB
mator-fncs.vbs Dims and initializes a string gsDefSrc used to fill the
input field of the HTA (handy if you test your new mator func) and a
dictionary gdicFuncs containing
Key: name of function (format: <group>/<func>)
Value: array of VBScript "pointer to function" (obtained by GetRef())
short description of function (alas, not used by the HTA)
After that it's standard HTA code:
Sub onloadBody
sets title and fills cbxGroups and (via onChangeCbxGroups) cbxChilds from
gdicFuncs.Keys, fills mleInput with gsDefSrc, displays help
Sub onChangeCbxGroups()
(re)fills cbxChilds according to current selection of cbxGroups
(if you select the group x, all functions with key "x/<func>" will be
used to fill cbxChilds with the <func> part)
Sub doTranslate()
translates content of mleInput via selected (cbxGroups, cbxChilds)
function from gdicFuncs and writes the result to mleDisp
After getting the sKey from cbxChilds value and the sTxt from
mleInput, the selected mator func ist called via the GetRef'ed
'function pointer':
sTxt = gdicFuncs( sKey )( 0 )( sTxt )
Sub showHelp
displays 'documentation' in mleDisp
I don't think that there are pecularities hidden the HTML code for the
page. I tried to layout the code in a way that makes copy & paste editing
easy and I tested the page with html tidy
http://tidy.sourceforge.net/
so I hope you won't catch me not closing my <td>s.
mator-fncs.vbs contains my sample functions and I hope you will add some
useful functions of your own:
This simple test function just returns sSrc unchanged:
Function trivialCopy( sSrc )
trivialCopy = sSrc
End Function
and that's the was to add it into gdicFuncs
gdicFuncs.Add "trivial/Copy" _ <= Key: <group>/<func>
, Array( GetRef( "trivialCopy" ) _ <= 'function pointer'
, "returns sSrc unchanged" _ <= description
)
VBSLib.vbs and HTALib.vbs contain code that is to be (re)used by many
scripts. For this sample project I took my libraries and deleted everything
not needed by mator.hta.
getShortVBSInfo()
is a function useful in scripts called from w/cscript or IE/mshta
getShortIEInfo()
is a function useful only in scripts called from IE/mshta
reloadHTA
is a sub useful (necessary ?) in scripts called from mshta
They illustrate the problems/compromises you face when you try to
distribute your code to different libraries.
sortLinesAdo( aLines )
sorts (array of) lines via ADO Recordset
All my libraries contain a Class (name derived from the file name
(or vice versa)) and a global object/instance of this class. In this
project these classes are trivial/empty and the objects are not used.
I could have deleted the code - to keep it simple - but in 'real
life' these objects (the "Dim goHTMLLIB") prevent loading libraries
more than once and are useful for simulating 'class/static variables'
which aren't possible in VBScript (more of that in my next project).
The last part of VBSLib.vbs:
''# Dev: change "False" to "True" to test your code with "cscript VBSLib.vbs"
If False Then
Dev00
End If
Sub Dev00
WScript.Echo "getVBSInfo(): |" + getVBSInfo() + "|"
End Sub
shows my way of dealing with a nasty problem of using VBScript
libraries. If you load/execute a xxxLib.vbs containing syntax errors,
the line number will point to the ExecuteGlobal statement. That's
definitely not nice, Mr. Gates! Therefore I develop/test my libraries
as indicated in the comment.
Because all this talk about libraries is boring without at least one
second script that uses a file used by mator.hta, I include cns-lator.vbs.
Obviously it needs a Mator func tranlate/German2English but I think
you will understand the code, especially the lines
ExecuteGlobal goFS.OpenTextFile( csFncFSpec ).ReadAll
which loads/executes mator-fncs.vbs, and
Set fMthd = gdicFuncs( sMthd )( 0 )
sTmp = goFS.OpenTextFile( csInFSpec, ForReading, False ).ReadAll
sTmp = fMthd( sTmp )
goFS.OpenTextFile( csOutFSpec, ForWriting, True ).Write sTmp
which get the source from a file (mator.in), transform it via the
selected mator func und write the result to mator.out. These files
should be loaded in a decent editor and saved/(re)loaded before/after
you call "cscript cns-mator.vbs nice/DbgDump" from the command
line.
I hope that you will
find mator.hta useful
write some mator funcs
think about/play with the idea to reuse code by using libraries
mator.hta
<html>
<!-- HEAD ############################################################## -->
<head>
<!-- Title ============================================================ -->
<title>Mator 1.0</title>
<!-- HTA ============================================================== -->
<hta:application id = "Mator"
version = "1.0"
applicationname = "Mator"
singleinstance = "yes"
windowstate = "normal"
caption = "yes"
showintaskbar = "yes"
sysmenu = "yes"
scroll = "no"
/>
<!-- META/LINK ======================================================== -->
<meta http-equiv = "Content-Type"
content = "text/html; charset=iso-8859-1"
/>
<meta http-equiv = "content-script-type"
content = "text/vbscript"
/>
<meta http-equiv = "Content-Style-Type"
content = "text/css"
/>
<!-- STYLE ============================================================ -->
<style type ="text/css">
/*<![CDATA[*/
body { margin: 0px;
}
#tblBody { height: 100%;
width: 100%;
}
#mleInput { height: 100%;
width: 100%;
}
#mleDisp { height: 100%;
width: 100%;
}
table.maxH { width: 100%;
}
tr.minV { height: 1px;
}
#trInput { height: 50%;
}
#trDisp { height: 50%;
}
#tdTitle { text-align: left;
font-weight: bold;
}
#tdInfo { text-align: right;
font-weight: bold;
}
td.rightA { text-align: right;
}
.stdBtt { width: 80px;
}
/*]]>*/
</style>
<!-- SCRIPT (Libs) ==================================================== -->
<script language = "VBScript"
type = "text/vbscript"
src = ".\VBSLib.vbs"
>
</script>
<script language = "VBScript"
type = "text/vbscript"
src = ".\HTXLib.vbs"
>
</script>
<script language = "VBScript"
type = "text/vbscript"
src = ".\mator-fncs.vbs"
>
</script>
<!-- SCRIPT (Inline) ================================================== -->
<script language = "VBScript"
type = "text/vbscript"
>
'<![CDATA[
Option Explicit
' ############################################################################
''# global data
' ############################################################################
' go*LIB - library object provided by *Lib.vbs
' gdicFuncs - provided by mator-fncs.vbs
' gsDefSrc - provided by mator-fncs.vbs
' ############################################################################
''# application specific funcs
' ############################################################################
' ============================================================================
''= sets title and fills cbxGroups and (via onChangeCbxGroups) cbxChilds from
''= gdicFuncs.Keys, fills mleInput with gsDefSrc, displays help
' ============================================================================
Sub onloadBody
document.getElementById( "tdTitle" ).innerText = mator.applicationname + " " + _
mator.version
document.getElementById( "tdInfo" ).innerText = getShortVBSInfo() + " * " _
+ getShortIEInfo() + " * " _
+ CStr( Now )
document.getElementById( "mleInput" ).value = gsDefSrc
Dim cbxGroups : Set cbxGroups = document.getElementById( "cbxGroups" )
Dim oDoc : Set oDoc = cbxGroups.document
Dim dicUniq : Set dicUniq = CreateObject( "Scripting.Dictionary" )
Dim sKey
Dim aParts
Dim oOpt
cbxGroups.Length = 0
For Each sKey In gdicFuncs.Keys
aParts = Split( sKey, "/" )
If Not dicUniq.Exists( aParts( 0 ) ) Then
Set oOpt = oDoc.createElement( "OPTION" )
oOpt.Text = aParts( 0 )
oOpt.Value = aParts( 0 )
cbxGroups.Options.Add oOpt
dicUniq.Add aParts( 0 ), 0
End If
Next
cbxGroups.selectedIndex = 0
onChangeCbxGroups()
showHelp()
End Sub
' ============================================================================
''= (re)fills cbxChilds according to current selection of cbxGroups
' ============================================================================
Sub onChangeCbxGroups()
Dim cbxGroups : Set cbxGroups = document.getElementById( "cbxGroups" )
Dim oDoc : Set oDoc = cbxGroups.document
Dim cbxChilds : Set cbxChilds = document.getElementById( "cbxChilds" )
Dim sPfx
Dim sKey
Dim aParts
Dim oOpt
sPfx = cbxGroups.Options( cbxGroups.selectedIndex ).text
cbxChilds.Length = 0
For Each sKey In gdicFuncs.Keys
aParts = Split( sKey, "/" )
If sPfx = aParts( 0 ) Then
Set oOpt = oDoc.createElement( "OPTION" )
oOpt.Text = aParts( 1 )
oOpt.Value = sKey
cbxChilds.Options.Add oOpt
End If
Next
End Sub
' ============================================================================
''= translates content of mleInput via selected (cbxGroups, cbxChilds)
''= function from gdicFuncs and writes the result to mleDisp
' ============================================================================
Sub doTranslate()
Dim cbxChilds : Set cbxChilds = document.getElementById( "cbxChilds" )
Dim sKey
Dim sTxt
sKey = cbxChilds.Options( cbxChilds.selectedIndex ).value
sTxt = document.getElementById( "mleInput" ).value
sTxt = gdicFuncs( sKey )( 0 )( sTxt )
document.getElementById( "mleDisp" ).value = sTxt
End Sub
' ============================================================================
''= displays 'documentation' in mleDisp
' ============================================================================
Sub showHelp
Dim aHelp
aHelp = Array( _
"Mator transforms the content of the upper input field by using" _
, "a function selected by the Groups and Funcs comboboxes and writes" _
, "the result to this display field." _
, "" _
, "Use the Paste button to paste clipboard data into the input field" _
, "or the Copy button to write the result of the transformation to" _
, "the clipboard." _
, "" _
, "Currently mator-fncs.vbs contains these transformations:" _
, "" _
, " trivial/Copy and trivial/Reverse are just test function" _
, " which return the source text unchanged resp. mangled by the" _
, " VBScript Reverse function." _
, "" _
, " nice/DbgDump transforms lines of variable data dumps from" _
, " the (Interdev) Debugger into tables. Block mark interesting" _
, " lines from the Auto/Local/Watch variable display and feed" _
, " them via the clipboard to this function." _
, "" _
, " nice/LNumOn and nice/LNumOff add resp. remove line numbers." _
, "" _
, " sort/Lines expects some text lines (terminated by vbCrLf) and" _
, " sorts them alphabetically (using a disconnected ADO recordset)." _
, "" _
, " build/MatorFunc generates a Mator function frame from two" _
, " lines of input:" _
, " group/func => e.g. build/MatorFunc" _
, " description => e.g. generates a Mator function frame" _
, "" _
, " cut/WMINames extracts property names from ScriptCenter sample" _
, " code like" _
, " For Each objWMISetting in colWMISettings" _
, " Wscript.Echo ""Last backup: "" & objWMISetting.BackupLastTime" _
, " Wscript.Echo ""Build version: "" & objWMISetting.BuildVersion" _
, " ..." _
, " Next" _
, " This 'work in progress' function is included to demonstrate the use" _
, " of RegExps in Mator funcs." _
, "" _
, "New functions for your special needs can easily be added to the" _
, "file mator-fncs.vbs. Just look at the provided examples and use" _
, "build/MatorFunc to get started." _
)
document.getElementById( "mleDisp" ).value = Join( aHelp, vbCrLf )
End Sub
']]>
</script>
</head>
<!-- BODY ############################################################## -->
<body onload = "onloadBody()">
<div id = "divBody"
>
<table id = "tblBody"
border = "1"
summary = "LOT"
>
<!-- Title row ========================================================= -->
<tr>
<td>
<table border = "0"
class = "maxH"
summary = "LOT"
>
<tr>
<td id = "tdTitle">
wbr
</td>
<td id = "tdInfo">
wbr
</td>
</tr>
</table>
</td>
</tr>
<!-- Input block ======================================================= -->
<tr id = "trInput">
<td>
<textarea id = "mleInput"></textarea>
</td>
</tr>
<tr class = "minV">
<td>
<input class = "stdBtt"
onclick = 'resetXLEdit( document.getElementById( "mleInput" ) )'
type = "BUTTON"
value = "Clear"
>
<input class = "stdBtt"
onclick = 'pasteClipbXLEdit( document.getElementById( "mleInput" ) )'
type = "BUTTON"
value = "Paste"
>
<input class = "stdBtt"
onclick = "doTranslate()"
type = "BUTTON"
value = "Translate"
>
Groups:
<select class = "stCbx"
id = "cbxGroups"
onchange = "top.onChangeCbxGroups()"
size = "1"
></select>
Funcs:
<select class = "stCbx"
id = "cbxChilds"
size = "1"
></select>
</td>
</tr>
<!-- Output block ====================================================== -->
<tr id = "trDisp">
<td>
<textarea id = "mleDisp"></textarea>
</td>
</tr>
<tr class = "minV">
<td>
<table border = "0"
class = "maxH"
summary = "LOT"
>
<tr>
<td>
<input class = "stdBtt"
onclick = 'resetXLEdit( document.getElementById( "mleDisp" ) )'
type = "BUTTON"
value = "Clear"
>
<input class = "stdBtt"
onclick = 'copyClipbXLEdit( document.getElementById( "mleDisp" ) )'
type = "BUTTON"
value = "Copy"
>
<input class = "stdBtt"
onclick = "showHelp"
type = "BUTTON"
value = "Help"
>
</td>
<td class = "rightA">
<input class = "stdBtt"
onclick = "reloadHTA"
type = "BUTTON"
value = "Reload"
>
<input class = "stdBtt"
onclick = "printPage"
type = "BUTTON"
value = "Print"
>
</td>
</tr>
</table>
</td>
</tr>
</table>
</div>
</body>
</html>
mator-fncs.vbs
' ############################################################################
''# functions to transform texts
' ############################################################################
Option Explicit ''< Variablen mssen vor ihrer Verwendung deklariert werden
' ############################################################################
''# Consts
' ############################################################################
' ############################################################################
''# Globals
' ############################################################################
' ============================================================================
''= dictionary containing
''= Key: name of function (format: <group>/<func>)
''= Value: array of VBScript "pointer to function" (obtained by GetRef())
''= short description of function
' ============================================================================
Dim gdicFuncs : Set gdicFuncs = CreateObject( "Scripting.Dictionary" )
' ============================================================================
''= default content for mleInput in mator.hta
' ============================================================================
Dim gsDefSrc
gsDefSrc = ""
gsDefSrc = "If you are working on a Mator function (e.g. testing a" + vbCrLf _
+ "RegExp) you may use gsDefSrc to set this input field" + vbCrLf _
+ "to your default source"
' ############################################################################
''# Mator-Funktionen
' ############################################################################
' ============================================================================
''= returns copy of sSrc (trivial test)
' ============================================================================
Function trivialCopy( sSrc )
trivialCopy = sSrc
End Function
' ----------------------------------------------------------------------------
gdicFuncs.Add "trivial/Copy" _
, Array( GetRef( "trivialCopy" ) _
, "liefert exakte Kopie der Zeichenkette sSrc zurck (trivialer Test)" _
)
' ============================================================================
''= liefert Umkehrung der Zeichenkette sSrc zurck (trivialer Test)
' ============================================================================
Function trivialReverse( sSrc )
trivialReverse = StrReverse( sSrc )
End Function
' ----------------------------------------------------------------------------
gdicFuncs.Add "trivial/Reverse" _
, Array( GetRef( "trivialReverse" ) _
, "liefert Umkehrung der Zeichenkette sSrc zurck (trivialer Test)" _
)
' ============================================================================
''= transforms debugger variable dump into a nice table
' ============================================================================
' Sample Src:
' 012345
' - oTmp {...} Object
' nodeName "#document" String
' nodeValue Null Variant
' nodeType 9 Object
' parentNode Nothing Object
' + childNodes {...} Object
' ============================================================================
Function niceDbgDump( sSrc )
Dim aLines
Dim aMxL
Dim nIdx
Dim nIdxC
Dim sLine
aLines = Split( sSrc, vbCrLf )
aMxL = Array( 0, 0, 0, 0 )
For nIdx = 0 To UBound( aLines )
aLines( nIdx ) = Split( aLines( nIdx ), vbTab )
Next
For nIdx = 0 To UBound( aLines )
If 3 = UBound( aLines( nIdx ) ) Then
For nIdxC = 1 To UBound( aMxL )
If aMxL( nIdxC ) < Len( aLines( nIdx )( nIdxC ) ) Then
aMxL( nIdxC ) = Len( aLines( nIdx )( nIdxC ) )
End If
Next
End If
Next
For nIdx = 0 To UBound( aLines )
If 3 = UBound( aLines( nIdx ) ) Then
sLine = "' " + Right( Space( 3 ) & nIdx , 3 ) _
+ " " + Right( Space( 1 ) + aLines( nIdx )( 0 ) , 1 ) _
+ " " + Left( aLines( nIdx )( 1 ) + Space( aMxL( 1 ) ), aMxL( 1 ) ) _
+ " " + Left( aLines( nIdx )( 2 ) + Space( aMxL( 2 ) ), aMxL( 2 ) ) _
+ " " + Left( aLines( nIdx )( 3 ) + Space( aMxL( 3 ) ), aMxL( 3 ) )
aLines( nIdx ) = sLine
Else
aLines( nIdx ) = ""
End If
Next
niceDbgDump = Join( aLines, vbCrLf )
End Function
' ----------------------------------------------------------------------------
gdicFuncs.Add "nice/DbgDump" _
, Array( GetRef( "niceDbgDump" ) _
, "formatiert Debugger Data Dump" _
)
' ============================================================================
''= adds line numbers to sSrc (splitted into array)
' ============================================================================
Function niceLNumOn( sSrc )
Const cnINDENT = 4
Dim aLines
Dim nLine
Dim sIndent
aLines = Split( sSrc, vbCrLf )
' what about Unix/Mac line endings?
sIndent = Space( cnINDENT )
For nLine = 0 To UBound( aLines )
aLines( nLine ) = Right( sIndent & (nLine + 1 ), cnINDENT ) + ": " + aLines( nLine )
Next
niceLNumOn = Join( aLines, vbCrLf )
' what about Unix/Mac line endings?
End Function
' ----------------------------------------------------------------------------
gdicFuncs.Add "nice/LNumOn" _
, Array( GetRef( "niceLNumOn" ) _
, "adds line numbers" _
)
' ============================================================================
''= removes line numbers from sSrc (splitted into array)
' ============================================================================
Function niceLNumOff( sSrc )
Dim oRE
Set oRE = New RegExp
' oRE.Pattern = "\n\s*\d+: " failed for first line
oRE.Pattern = "(^|\n)\s*\d+: "
oRE.Global = True
niceLNumOff = oRE.Replace( sSrc, "" )
End Function
' ----------------------------------------------------------------------------
gdicFuncs.Add "nice/LNumOff" _
, Array( GetRef( "niceLNumOff" ) _
, "removes line numbers" _
)
' ============================================================================
''= splits sSrc into an arry of lines, sorts it via sortLinesAdo() (--> VBSLib.vbs)
''= and returns joined result
' ============================================================================
Function sortLines( sSrc )
Dim aLines
aLines = Split( sSrc, vbCrLf )
sortLines = Join( sortLinesAdo( aLines ), vbCrLf )
End Function
' ----------------------------------------------------------------------------
gdicFuncs.Add "sort/Lines" _
, Array( GetRef( "sortLines" ) _
, "sort sSrc as array of lines (Jon Paal special)" _
)
' ============================================================================
''= builds a Mator function frame from name and description
''= epected input: <group>/<func>vbCrLfdescription
' ============================================================================
Function buildMatorFunc( sSrc )
Dim aLines
Dim aGrpFunc
Dim aTemplate
Dim sRVal
aLines = Split( sSrc, vbCrLf )
If 1 <> UBound( aLines ) Then
buildMatorFunc = "bad input"
Exit Function
End If
aGrpFunc = Split( aLines( 0 ), "/" )
aTemplate = Array( _
"@Cmnt ============================================================================" _
, "@Cmnt@Cmnt= @Description" _
, "@Cmnt ============================================================================" _
, "" _
, "Function @Name( sSrc )" _
, " Dim sRVal" _
, " sRVal = sSrc" _
, " @Name = sRVal" _
, "End Function" _
, "" _
, "@Cmnt ----------------------------------------------------------------------------" _
, "" _
, "gdicFuncs.Add '@Key' _" _
, " , Array( GetRef( '@Name' ) _" _
, " , '@Description' _" _
, " )" _
, "" _
)
sRVal = Join( aTemplate, vbCrLf )
sRVal = Replace( sRVal, "@Name" , aGrpFunc( 0 ) + aGrpFunc( 1 ) )
sRVal = Replace( sRVal, "@Description", aLines( 1 ) )
sRVal = Replace( sRVal, "@Key" , aLines( 0 ) )
sRVal = Replace( sRVal, "'" , """" )
sRVal = Replace( sRVal, "@Cmnt" , "'" )
buildMatorFunc = sRVal
End Function
gdicFuncs.Add "build/MatorFunc" _
, Array( GetRef( "buildMatorFunc" ) _
, "builds a Mator function frame from name and description" _
)
' ============================================================================
''= cuts WMI names from sample code
' ============================================================================
Function cutWMINames( sSrc )
Dim sRVal
Dim oRE
Dim oMTS
Dim oMT
Dim sObjPfx
Set oRE = New RegExp
' oRE.Pattern = "^\s*(\w+)" ' get the first word after zero or more whitespace
oRE.Pattern = "^For\s+Each\s+(\w+)\s+In" ' get the word "For Each X In"
oRE.IgnoreCase = True
Set oMTS = oRE.Execute( sSrc )
sObjPfx = "objWMISetting" ' default value
If 1 = oMTS.Count Then sObjPfx = oMTS( 0 ).SubMatches( 0 )
oRE.Pattern = sObjPfx + "\.(\w+)" ' get the word after "sObjPfx."
oRE.Global = True
Set oMTS = oRE.Execute( sSrc )
sRVal = ""
For Each oMT In oMTS
sRVal = sRVal + oMT.SubMatches( 0 ) + vbCrLf
Next
cutWMINames = sRVal
End Function
' ----------------------------------------------------------------------------
gdicFuncs.Add "cut/WMINames" _
, Array( GetRef( "cutWMINames" ) _
, "cuts WMI names from sample code" _
)
VBSLib.vbs
' ############################################################################
''# VBScript functionality
' ############################################################################
Option Explicit ''< Variablen mssen vor ihrer Verwendung deklariert werden
' ############################################################################
''# Globale Konstanten
''# vbscript5.chm
''# adoinc.vbs
' ############################################################################
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const TristateTrue = -1 ' True
Const TristateFalse = 0 ' False
Const TristateUseDefault = -2 ' Use the computer's regional settings.
Const FFUnicode = -1 ' Dateiformat: UNICODE
Const FFAscii = 0 ' Dateiformat: ASCII
Const FFDefault = -2 ' Dateiformat: DEFAULT
Const adBSTR = 8 ' 00000008
Const adVarChar = 200 ' 000000C8
Const adVarWChar = 202 ' 000000CA
' ############################################################################
''# Funktionen
' ############################################################################
' ============================================================================
''= liefert den ID (Name + Version) der VBScript-Engine im Format
''= /^\w+ \d\.\d \(\d{4}\)$/, also z.B. "VBScript 5.6 (6626)"
' ============================================================================
Function getVBSInfo()
getVBSInfo = ScriptEngine & " " _
& ScriptEngineMajorVersion & "." _
& ScriptEngineMinorVersion & " (" _
& ScriptEngineBuildVersion & ")"
End Function
' ============================================================================
''= liefert den ID (Name + Version) der VBScript-Engine im Format
''= /^\w+ \d\.\d$/, also z.B. "VBScript 5.6"
' ============================================================================
Function getShortVBSInfo()
getShortVBSInfo = ScriptEngine & " " _
& ScriptEngineMajorVersion & "." _
& ScriptEngineMinorVersion
End Function
' ============================================================================
''= sorts (array of) lines via ADO Recordset
' ============================================================================
Function sortLinesAdo( aLines )
Dim oRS : Set oRS = CreateObject( "ADODB.Recordset" )
Dim nIdx
oRS.Fields.Append "Fld0", adVarWChar, 2000
oRS.Open
For nIdx = 0 To UBound( aLines )
oRS.AddNew
oRS.Fields( 0 ).value = aLines( nIdx )
oRS.UpDate
Next
If Not (oRS.BOF Or oRS.EOF) Then
oRS.Sort = "Fld0"
nIdx = 0
oRS.MoveFirst
Do Until oRS.EOF
aLines( nIdx ) = oRS( "Fld0" ).value
nIdx = nIdx + 1
oRS.MoveNext
Loop
End If
sortLinesAdo = aLines
End Function
' ############################################################################
''# Library
' ############################################################################
' ============================================================================
''=
' ============================================================================
Class cVBSLIB
' ----------------------------------------------------------------------------
' cVBSLIB::Data
' ----------------------------------------------------------------------------
' ----------------------------------------------------------------------------
' cVBSLIB::*structors
' ----------------------------------------------------------------------------
Private Sub Class_Initialize()
End Sub
Private Sub Class_Terminate()
End Sub
' ----------------------------------------------------------------------------
' cVBSLIB::access
' ----------------------------------------------------------------------------
' ----------------------------------------------------------------------------
' cVBSLIB::End
' ----------------------------------------------------------------------------
End Class
' ============================================================================
''= ModuleMainCode
' ============================================================================
Dim goVBSLIB
Set goVBSLIB = New cVBSLIB
' ############################################################################
''# Dev: change "False" to "True" to test your code with "cscript VBSLib.vbs"
' ############################################################################
If False Then
Dev00
End If
' ============================================================================
''= tests getVBSInfo()
' ============================================================================
Sub Dev00
WScript.Echo "getVBSInfo(): |" + getVBSInfo() + "|"
End Sub
HTXLib.vbs
' ############################################################################
''# HTML/HTA functionality
' ############################################################################
Option Explicit ''< Variablen mssen vor ihrer Verwendung deklariert werden
' ############################################################################
''# Funktionen
' ############################################################################
' ============================================================================
''= liefert Informationen (Name + Version) ber den Internet Explorer
' ============================================================================
Function getShortIEInfo()
Dim sRVal
sRVal = window.navigator.appName
sRVal = window.navigator.userAgent
' Stop
Dim oRE
Set oRE = New RegExp
oRE.Pattern = ";\s+(MSIE\s+\d+\.\d+);"
On Error Resume Next
sRVal = oRE.Execute( sRVal )( 0 ).SubMatches( 0 )
If 0 <> Err.Number Then
sRVal = "*** Unbekannt **"
End If
On Error GoTo 0
getShortIEInfo = sRVal
End Function
' ============================================================================
''= clears single/multi line edit field xlEdit and sets focus to xlEdit
' ============================================================================
Sub resetXLEdit( xlEdit )
With xlEdit
.value = ""
.focus()
End With
End Sub
' ============================================================================
''= puts clipboard text data into xlEdit
' ============================================================================
Sub pasteClipbXLEdit( xlEdit )
With xlEdit
.value = window.clipboardData.getData( "Text" )
End With
End Sub
' ============================================================================
''= puts xlEdit content into clipboard
' ============================================================================
Sub copyClipbXLEdit( xlEdit )
With xlEdit
window.clipboardData.setData "Text", .value
End With
End Sub
' ############################################################################
''# Funktionen
' ############################################################################
' ============================================================================
''= refreshes the HTA page, which includes re-running any Windows_Onload code
' ============================================================================
Sub reloadHTA
location.reload( True )
End Sub
' ============================================================================
''= calls MS IE print dialog
''= http://members.tripod.com/~housten/printing.html
' ============================================================================
Sub printPage()
window.print
End Sub
' ############################################################################
''# Library
' ############################################################################
' ============================================================================
''=
''=
' ============================================================================
Class cHTXLLIB
' ----------------------------------------------------------------------------
' cHTXLLIB::Data
' ----------------------------------------------------------------------------
' ----------------------------------------------------------------------------
' cHTXLLIB::*structors
' ----------------------------------------------------------------------------
Private Sub Class_Initialize()
End Sub
Private Sub Class_Terminate()
End Sub
' ----------------------------------------------------------------------------
' cHTXLLIB::access
' ----------------------------------------------------------------------------
' ----------------------------------------------------------------------------
' cHTXLLIB::End
' ----------------------------------------------------------------------------
End Class
' ============================================================================
''= LibMainCode
' ============================================================================
Dim goHTMLLIB
Set goHTMLLIB = New cHTXLLIB
cns-mator.vbs
' ############################################################################
''# transformiert den Inhalt der Datei .\mator.in gem der auf der
''# Kommandozeile spezifizierten Methode in die Datei .\mator.out
' ############################################################################
Option Explicit ''< Variablen mssen vor ihrer Verwendung deklariert werden
' ############################################################################
'' Consts
' ############################################################################
Const csInFSpec = "mator.in" ''< Spezifikation der Eingabedatei (Source)
Const csOutFSpec = "mator.out" ''< Spezifikation der Ausgabedatei (Destination)
Const csFncFSpec = "mator-fncs.vbs" ''< Spezifikation der Datei mit den Funktionen
' ############################################################################
''# global data
' ############################################################################
' go*LIB - library object provided by *Lib.vbs
' gdicFuncs - provided by mator-fncs.vbs
Dim goFS ''< FileSystemObject fr den Zugriff auf's Dateisystem
Set goFS = CreateObject( "Scripting.FileSystemObject" )
' ############################################################################
'' Dienst-Funktionen
' ############################################################################
' ============================================================================
'' liefert die Gebrauchsanweisung in *einer* Zeichenkette
' ============================================================================
Function mkUsage()
Dim sRVal
Dim sKey
sRVal = "cns-mator: " _
+ "transforms content of file '" + csInFSpec + "' according to a function " + vbCrLf _
+ "specified on the command line to the file '" + csOutFSpec + "'." + vbCrLf
sRVal = sRVal + "Available functions:" + vbCrLf
For Each sKey In gdicFuncs
sRVal = sRVal + " " + sKey + ": " + gdicFuncs( sKey )( 1 ) + vbCrLf
Next
mkUsage = sRVal
End Function
' ############################################################################
'' MAIN
' ============================================================================
'' liefert den Rckgabewert der Funktion doMain() ans Betriebssystem
' ############################################################################
WScript.Quit doMain()
' ============================================================================
''= transforms content of file csInFSpec according to a function
''= specified on the command line to the file csOutFSpec. Mator functions
''= come from csFncFSpec; this file sets up a dictionary gdicFuncs of items
''=
' ============================================================================
Function doMain()
Const ForReading = 1
Const ForWriting = 2
Dim nRVal ''< Rckgabewert
Dim sMsg ''< (Miss)Erfolgsmeldung
Dim nArgC ''< Anzahl der Kommandozeilenargumente
Dim sMthd ''< Erstes/Einziges Kommandozeilenargument: Lator-Func Key
Dim fMthd ''< Mator-Func Referenz
Dim sTmp ''< Kann man fr Zwischenergebnisse immer brauchen
If "CSCRIPT.EXE" <> UCase( Right( WScript.Fullname, 11 ) ) Then
WScript.Echo "Das Programm ist fuer CSCRIPT bestimmt!"
doMain = 1
Exit Function
End If
If Not goFS.FileExists( csInFSpec ) Then
sMsg = mkUsage() + "Input file '" + csInFSpec + "' not found!"
WScript.Echo sMsg
doMain = 1
Exit Function
End If
If Not goFS.FileExists( csFncFSpec ) Then
sMsg = mkUsage() + "Functions file " + csInFSpec + "' not found!"
WScript.Echo sMsg
doMain = 1
Exit Function
End If
ExecuteGlobal goFS.OpenTextFile( csFncFSpec ).ReadAll
nRVal = 1
nArgC = WScript.Arguments.Count
If 1 <> nArgC Then
sMsg = mkUsage()
Else
sMthd = WScript.Arguments( 0 )
If gdicFuncs.Exists( sMthd ) Then
Set fMthd = gdicFuncs( sMthd )( 0 )
sTmp = goFS.OpenTextFile( csInFSpec, ForReading, False ).ReadAll
sTmp = fMthd( sTmp )
goFS.OpenTextFile( csOutFSpec, ForWriting, True ).Write sTmp
nRVal = 0
sMsg = csInFSpec + " -- " + sMthd + " --> " + csOutFSpec
Else
sMsg = mkUsage() + "'" + sMthd + "' not found,"
End If
End If
WScript.Echo sMsg
doMain = nRVal
End Function
|
|
Printable Version
(transfor)mator - 
New Messages
No New Messages
Hot Topic w/ New Messages
Hot Topic w/o New Messages
Locked w/ New Messages
Locked w/o New Messages
Post New Thread