Using Visual-Basic inside FWH

[ukoenig]

Hello,

For some special functions, I use Visual-Basic inside my application.
Hardware-informations, connection to any computer inside a network and much more.

I create the needed files inside the application, because I dont want them on disk.
There is allways only one Visual-Basic-Script created.

Also You can call the WSH, executing a VBSript from disk
Winexec('WSCRIPT.exe VBFUNC.VBS')

Some samples :

With just 2 lines, You can call a Window-service-function

Code: Select all  Expand view

// Call Function
// ----------------
SYS_EDIT( 1 )
// 1 = Tray-Settings
// 2 = Time / Date-Settings
// 3 = Shut-Down
// 4 = Mouse-Settings

FUNCTION SYS_EDIT(nType)

IF FILE( "VBFUNC.VBS" )
    DELETE FILE  "VBFUNC.VBS"
ENDIF

oText := TTxtFile():New( "VBFUNC.VBS" )
IF oText:Open()
   oText:Add('set IShellDispatch2 = CreateObject("Shell.Application") ')
   IF nType = 1
         oText:Add('Call IShellDispatch2.TrayProperties ' )
   ENDIF
   IF nType = 2
         oText:Add('Call IShellDispatch2.SetTime ')
   ENDIF
   IF nType = 3
         oText:Add(' Call Shell.ShutdownWindows ')
   ENDIF
   IF nType = 4
         oText:Add(' Call IShellDispatch2.ControlPanelItem("main.cpl") ')
   ENDIF
ENDIF

Winexec('WSCRIPT.exe VBFUNC.VBS')

RETURN NIL

 

Shutdown the computer
-----------------------------


Mouse-Settings
------------------



Detect ADO - connection
-----------------------------

Code: Select all  Expand view

FUNCTION ADO_STATUS()

IF FILE( "VBFUNC.VBS" )
    DELETE FILE  "VBFUNC.VBS"
ENDIF

oText := TTxtFile():New( "VBFUNC.VBS" )
IF oText:Open()

    oText:Add('set fs = CreateObject("Scripting.FileSystemObject") ')
    oText:Add('set wshshell = CreateObject("WScript.Shell") ')

    oText:Add('msg = "ADO status:" & vbCr & vbCr ')

    oText:Add('on error resume next ')
    oText:Add('set dummy = CreateObject("ADODB.Connection") ')
    oText:Add('if not err.number = 0 then ')
    oText:Add(' MsgBox msg & "ADODB.Connection missing !" ')
    oText:Add(' WScript.Quit ')
    oText:Add('else ')
    oText:Add(' msg = msg & "ADODB.Connection works." & vbCr ')
    oText:Add('end if ')
    oText:Add('on error goto 0 ')

    oText:Add('on error resume next ')
    oText:Add('clsid = wshshell.RegRead("HKCR\ADODB.Connection\CLSID\") ')
    oText:Add('exec = wshshell.RegRead("HKCR\CLSID\" & clsid & "\InProcServer32\") ')
    oText:Add('path = Left(exec, InstrRev(exec, "\")-1) ')
    oText:Add('path = Left(path, InstrRev(path, "\")-1) & "\Ole DB\" ')

    oText:Add('if not err.number=0 then ')
    oText:Add(' MsgBox msg & "Could not detect File-Versions !" ')
    oText:  Add('WScript.Quit ')
    oText:Add('end if ')
    oText:Add('on error goto 0 ')

    oText:Add('filename = "msdadc.dll" ')
    oText:Add('if fs.FileExists(path & filename) then ')
    oText:Add(' filever = fs.GetFileVersion(path &filename) ')
    oText:Add(' msg = msg & filename & " existing : Version " _ ')
    oText:Add(' & filever & vbCr ')
    oText:Add('else ')
    oText:Add(' msg = msg & filename & " missing." & vbCr ')
    oText:Add('end if ')

    oText:Add('filename = "oledb32.dll" ')
    oText:Add('if fs.FileExists(path & filename) then ')
    oText:Add(' filever = fs.GetFileVersion(path &filename) ')
    oText:Add(' msg = msg & filename & " existing : Version " _ ')
    oText:Add(' & filever & vbCr ')
    oText:Add('else ')
    oText:Add(' msg = msg & filename & " missing." & vbCr ')
    oText:Add('end if ')

    oText:Add('MsgBox msg, vbInformation ')

ENDIF

Winexec('WSCRIPT.exe VBFUNC.VBS')

RETURN NIL

 

Show all Computers and Users in Network
------------------------------------------------

Code: Select all  Expand view

FUNCTION SHOW_NET()

IF FILE ( "VBFUNC.VBS" )
    DELETE FILE  "VBFUNC.VBS"
ENDIF

oText := TTxtFile():New( "VBFUNC.VBS" )
IF oText:Open()
   oText:Add('Set network = CreateObject("Wscript.Network") ')
   oText:Add('Computer = network.ComputerName ')
   oText:Add('set computer = GetObject("WinNT://" & computer) ')
   oText:Add('computer.Filter = Array("User") ')
   oText:Add('for each user in computer ')
   oText:Add('   list = list & user.name & vbCr ')
   oText:Add('next ')
   oText:Add('MsgBox list, vbInformation ')
ENDIF

Winexec('WSCRIPT.exe VBFUNC.VBS')

RETURN NIL

 

Regards
Uwe

[Enrico Maria Giordano]

I have both DLLs in my system. Do you?

EMG

[ukoenig]

Enrico,
do You mean the 2 missing ADO-dll's ?
I didn't check it, because it is just a test, how to use VB-Scripts

I using the SCRIPTING-HOST-calls
If there are problems using it, I have solutions to solve this.

Code: Select all  Expand view

FUNCTION HOST_VERSION()

IF FILE( "VBFUNC.VBS" )
    DELETE FILE  "VBFUNC.VBS"
ENDIF

oText := TTxtFile():New( "VBFUNC.VBS" )
IF oText:Open()
   oText:Add('n = "Name: " & wscript.name')
   oText:Add('fn = "FullName: " & wscript.fullname')
   oText:Add('p = "Path: " & wscript.path')

   oText:Add('msg = n & vbCr & fn & vbCr & p')
   oText:Add('MsgBox msg, vbInformation')
ENDIF

Winexec('WSCRIPT.exe VBFUNC.VBS')

RETURN NIL
 

Rgards
Uwe

[Enrico Maria Giordano]

Enrico,
do You mean the 2 missing ADO-dll's ?

Yes.

EMG

[ukoenig]

Enrico,

I found the two DLL's in directory :

C:\Program Files\Common Files\system\Ole DB

The VB-function looks inside the Registry for the DLL's.
Maybe wrong ( not the place for VISTA )

[kajot]

which dll-s need I to run Visula basic inside FWH ?

[ukoenig]

Hello Kajot,

no extra DLL's needed.
The Windows < SCRIPTINGHOST > handles the functions.
Be shure, the Host is not deaktivated ( can happen, because of a Virus-scanner ).
Normally in XP and Vista it is installed automaticly.
To make it possible for the HOST, to execut the functions,
I save the source to a file with extension .VBS ( Visual Basic Script ).
and call after that : WINEXEC( "WSCRIPT.exe file.vbs" )

To test, if the SCRIPTINGHOST is aktivated on Your computer, You can save these
lines to a file TEST.VBS

Code: Select all  Expand view

n = "Name: " & wscript.name
fn = "FullName: " & wscript.fullname
p = "Path: " & wscript.path
msg = n & vbCr & fn & vbCr & p
MsgBox msg, vbInformation
 

Just dbl-click the file and You get the installed SCRIPTINGHOST-version.

Regards
Uwe