Public Shared SergeB.Blog()

As I commented on Duncan's Blog about the script I developed for blogs.vbcity.com that allows me to add users easy and quick, I got few emails asking for the script code. So I'm posting it here

Note: The script as it posted requires Windows Scripting Host installed on the server. If you choose you can modify it to run as ASP or ASP.NET code.

There is another script that I use for this site - I'm adding FTP accounts and setting up FTP sites for blog users using ADSI - let me know if you want it posted too.

' Command line parameters:
'
'     %1 - User 
'     %2 - Password 
'     %3 - FullName 
'     %4 - Email 
'     %5 - Blog Title 
'     %6 - Blog SubTitle
'

'/****************************** Main Scrtipt **********************************/

Const DEFAULT_CSS = "Marvin3" ' replace with the CSS of your choice
Const BLOG_HOST = "blogs.vbcity.com" ' replace with your host name or use localhost when testing locally

Dim ConnString
ConnString = "Provider=sqloledb;Password={YOURPASSWORD};User ID={YOURUSER};Initial Catalog=blogs;Data Source={YOURSQLSERVER}"

Set objArgs = WScript.Arguments
Dim boolGoodParams
' debug message
WScript.Echo "Arguments Count: " & WScript.Arguments.Count
boolGoodParams = True

If WScript.Arguments.Count < 6 Then 
  WScript.Echo "Sample Use: scriptname.vbs User Password FullName Email Title SubTitle"
  boolGoodParams = False
End If



 
If boolGoodParams Then
  Dim strUser, strPassword, strFullName, strEmail, strTitle1, strTitle2
  Dim i 
  i = 0 
  
  ' debug message
  For Each strArg in objArgs
    i = i + 1
    WScript.Echo "Argument(" & i & "): " & strArg
  Next 
  strUser = WScript.Arguments(0)
  strPassword = WScript.Arguments(1)
  strFullName = WScript.Arguments(2)
  strEmail = WScript.Arguments(3)
  strTitle1 = WScript.Arguments(4)
  strTitle2 = WScript.Arguments(5)
  Dim conn, rs, bOpened
  bOpened = DatabaseConnect(conn, ConnString)
  Dim bExists, SQL
  SQL = "select count(*) as user_count from blog_config where UserName = '" & strUser & "'"
  bExists = DatabaseGetValue(conn, SQL, "user_count", False)
  ' debug message
  WScript.Echo "bExists: " & CBool(bExists)
  If Not bExists Then
    Call BlogDBUserAdd(strUser, strPassword, strFullName, strEmail, strTitle1, strTitle2)
  End If
  DatabaseDisconnect conn, bOpened
  WScript.Echo "Done."

End If

'/******************************************************************************/

Function BlogDBUserAdd(strUser, strPassword, strFullName, strEmail, strTitle1, strTitle2)
  SQL = "INSERT INTO [blog_Config] ([UserName], [Password], [Email], [Title], [SubTitle], " & _
    "[Skin], [Host], [Author], [TimeZone], [IsActive], [Language], [ItemCount], [Flag], " & _
    "[LastUpdated], [News], [SecondaryCss], [Application], [BlogGroup]) " & _
    "VALUES ('" & DoubleQuotes(strUser) & "', '" & DoubleQuotes(strPassword) & "', '" & DoubleQuotes(strEmail) & "','" & DoubleQuotes(strTitle1) & "', '" & DoubleQuotes(strTitle2) & "', " & _
    "'" & DoubleQuotes(DEFAULT_CSS) & "', '" & DoubleQuotes(BLOG_HOST) & "', '" & DoubleQuotes(strFullName) & "', -8, 1, 'en-US', 15, 55, " & _
    "getdate(), '', '', '" & strUser & "', 1)"

  DatabaseExecute conn, SQL
End Function

'/******************************************************************************/

Function DoubleQuotes(strSource)
  DoubleQuotes = Replace(strSource, "'", "''")
End Function

'/******************************************************************************/

Function DatabaseConnect(objConn, ConnString)
Dim bCreateConn
  If Not IsEmpty(objConn) Then
    If objConn Is Nothing Then
      bCreateConn = True
    Else
      bCreateConn = False
    End If
  Else
    bCreateConn = True
  End If
  If bCreateConn = True Then
    Set objConn = CreateObject("ADODB.Connection")
    objConn.Open ConnString
  End If
  DatabaseConnect = bCloseConn
End Function

Function DatabaseDisconnect(objConn, bOpened)
On Error Resume Next
  If bOpened = True Then
    objConn.Close
    Set objConn = Nothing
    bOpened = False
  End If
End Function

Function DatabaseExecute(objConn, SQL)
  objConn.Execute SQL 
End Function

Function DatabaseSelect(objConn, SQL)
  Set DatabaseSelect = objConn.Execute(SQL)
End Function

Function DatabaseOpenRS(objConn, rs, SQL)
Const adOpenStatic = 3
  If Not IsEmpty(rs) Then
    If rs Is Nothing Then
      Set rs = CreateObject("ADODB.Recordset")
    End If
  Else
    Set rs = CreateObject("ADODB.Recordset")
  End If
  rs.Open SQL, objConn, adOpenStatic
End Function

' Open Forward Only recordset
Function DatabaseOpenRS_FO(objConn, rs, SQL)
Const adOpenForwardOnly = 0
Const adLockReadOnly = 1
Const adCmdText = &H0001
  If Not IsEmpty(rs) Then
    If rs Is Nothing Then
      Set rs = CreateObject("ADODB.Recordset")
    End If
  Else
    Set rs = CreateObject("ADODB.Recordset")
  End If
  rs.Open SQL, objConn, adOpenForwardOnly, adLockReadOnly, adCmdText
End Function

Function DatabaseGetValue(objConn, SQL, Field, Default)
Dim rs, vRetValue
  Set rs = DatabaseSelect(objConn, SQL)
  If rs.BOF Or rs.EOF Then
    vRetValue = Default
  Else
    If Trim("" & rs(Field)) = "" Then
      vRetValue = Default
    Else
      vRetValue = rs(Field)
    End If
  End If
  DatabaseGetValue = vRetValue
  rs.Close
  Set rs = Nothing
End Function