Never been to TextSnippets before?

Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world (or not, you can keep them private!)

« Newer Snippets
Older Snippets »
3 total  XML / RSS feed 

ASP/VBScript ADO parameterized query


use like:

Set rs = execute_query(conn, "SELECT custid, custname FROM customers WHERE (somefield > ?) AND (someotherfield < ?)", Array(someValue, someOtherValue));

where conn is a "ADODB.Connection"

Function create_variant_input_parameter(command, name, value)
  Dim param
  ' 12 -> adVariant
  ' 1 -> adParamInput
  Set param = command.CreateParameter(name, 12, 1, 0, value)  
  Set create_variant_input_parameter = param
End Function

Function execute_query(connection, querytext, parameters)
  Dim cmd, i, rs
  Set cmd = Server.CreateObject("ADODB.Command")
  cmd.CommandText = querytext
  ' 1 -> adCmdText
  cmd.CommandType = 1
  For i = 0 To UBound(parameters)
    cmd.Parameters.Append(create_variant_input_parameter(cmd, "", parameters(i)))    
  Next
  Set cmd.ActiveConnection = connection 
  Set rs = cmd.Execute()
  Set execute_query = rs
End Function

kill remote application

'probably 2k and xp only

'not my own code. Borrowed from
'http://groups.google.com/group/microsoft.public.scripting.vbscript/browse_thread/thread/f197a145c8c9f1e6

Option Explicit

Dim sComputer, sProcess, oShell
Const WindowStyle = 0
Const WaitOnReturn = True

sComputer = "XXXXXXX" ' remote machine
sProcess = "XXXXX.exe" ' app on remote machine
Set oShell= CreateObject("WScript.Shell")
oShell.Run "TaskKill /s " & strComputer & " /im " & strProcess & " /f", WindowStyle, WaitOnReturn
Set oShell = Nothing

VBScript function for editing the registry via WMI

'= ***********************************************************************
'= Function Name: RegWrite( )
'= Purpose:               Creates a value, if it does not exist, and writes a value
'=
'= Arguments Supplied:  strRoot - registry subtree
'=                      strType - value type
'=                      strPath - path of value
'=                      strName - name of value
'=                      unkValue - value contents (varies by type)
'= Return Value:        <NONE>
'= Function Calls:      
'= ***********************************************************************
Function RegWrite( ByVal strRoot, ByVal strType, ByVal strPath, ByVal strName, ByVal unkValue )

  
  Dim hexRoot, intType
  Dim objReg
  Const strComputer = "."

  '= Convert string value into native hexadecimial value
  Select Case strRoot
    Case "HKCR"                hexRoot = &H80000000
    Case "HKCU"                hexRoot = &H80000001
    Case "HKLM"                hexRoot = &H80000002
    Case "HKEY_USERS"          hexRoot = &H80000003
    Case "HKEY_CURRENT_CONFIG" hexRoot = &H80000005
  End Select
  
  '= Convert value type into native integer format
  Select Case strType
    Case "REG_SZ"        intType = 1
    Case "REG_EXPAND_SZ" intType = 2
    Case "REG_BINARY"    intType = 3
    Case "REG_DWORD"     intType = 4
    Case "REG_MULTI_SZ"  intType = 7
  End Select

  '= If in debug mode print out the arguments                                                                                         
  ' If blnDebug Then
'     WScript.StdOut.WriteLine "Root = " & Hex(hexRoot)
'     WScript.StdOut.WriteLine "Type = " & intType
'     WScript.StdOut.WriteLine "Path = " & strPath
'     WScript.StdOut.WriteLine "Name = " & strName
'     WScript.StdOut.WriteLine "Value = " & unkValue
'   End If
  
  '= Connect to WMI of specified target
  Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
      strComputer & "\root\default:StdRegProv")
  
  '= Create Key if it does not already exist
  objReg.CreateKey hexRoot, strPath
    
  '= Call Write methode depending on value type  
  Select Case intType
    Case 1               
      objReg.SetStringValue hexRoot, strPath, strName, unkValue
    Case 2
      objReg.SetExpandedStringValue hexRoot, strPath, strName, unkValue
    Case 3
      '= NOTE: Writing BINARY reg types is not available
    Case 4
      objReg.SetDWORDValue hexRoot, strPath, strName, unkValue
    Case 7
      objReg.SetMultiStringValue hexRoot, strPath, strName, unkValue 
  End Select
  
  '= If error occurs, then return 1 for the value of the function
  '= NOTE: WMI does not appear to return any error objects.
  If Err.Number <> 0 Then
    WScript.Echo "Error: " & Err.Number & " - " & Err.Description
    RegWrite = 1
  End If

End Function
'= ***********************************************************************
« Newer Snippets
Older Snippets »
3 total  XML / RSS feed