Option Explicit

Const                 MAILBOX_SIZE_GROUP_PREFIX = "Exchange Mailbox Size Limit -"
Const                   LIMIT_WARNING_KEY_WORDS = "Issue Warning"
Const             LIMIT_PROHIBIT_SEND_KEY_WORDS = "Prohibit Send"
Const LIMIT_PROHIBIT_SEND_AND_RECEIVE_KEY_WORDS = "Prohibit Send and Receive"
Const                                  LOG_FILE = "Mailbox Size Restriction Script.log"
Const                           VERSION_DETAILS = "Mailbox Size Restriction Script - Version 1.0, 4 Feb 2005"

 
Dim aMessageGroupInformation, sLogFile, sTime, iObjectsUpdated

Dim WSHShell   : Set WshShell = CreateObject("WScript.Shell")
Dim oDic       : Set oDic = CreateObject("Scripting.Dictionary")
Dim fso        : Set fso = CreateObject("Scripting.FileSystemObject")
Dim objArgs    : Set objArgs = WScript.Arguments

sTime = Now()
iObjectsUpdated = 0
oDic.CompareMode = vbTextCompare
sLogFile = AddTrailingBackSlash(WshShell.ExpandEnvironmentStrings("%TEMP%")) & LOG_FILE
CheckLogFile(sLogFile)
AppendtoLogFile ""
AppendtoLogFile "Start - " & VERSION_DETAILS
AppendtoLogFile TAB & "Getting Group Information"
aMessageGroupInformation = GetMessageSizeGroupInformation
if UBound(aMessageGroupInformation) < 0 Then
	AppendtoLogFile	ERROR_STR & "No valid groups found, process terminating" 
Else
	AppendtoLogFile TAB & "Processing Mail Enabled Users"
	ProcessMailEnbabledUsers(aMessageGroupInformation)
	AppendtoLogFile TAB & "Users updated in this run : " & iObjectsUpdated
End If

AppendtoLogFile "Completed - elapsed time " & CalculateElapsedTime(sTime,Now())

Set objArgs = Nothing
Set fso = Nothing
Set oDic = Nothing
Set WshShell = Nothing
WScript.Quit(0)

' ------------------------------------------------------------------------------------------------------------------------------------------
' 
'    XX  XX              XXX                                 XXXXXXX                                X        XX                              
'    XX  XX               XX                                  XX   X                               XX                                        
'    XX  XX    XXXXX      XX    XX XXX    XXXXX   XX XXX      XX X    XX  XXX   XX XXX   XXXXX    XXXXX     XXX      XXXX    XX XXX  XXXXXXX 
'    XXXXXX   XX    X     XX     XX  XX  XX    X   XXX XX     XXXX    XX  XX    XXX XX  XX   XX    XX        XX     XX  XX   XXX XX  XX      
'    XX  XX   XXXXXXX     XX     XX  XX  XXXXXXX   XX         XX X    XX  XX    XX  XX  XX         XX        XX     XX  XX   XX  XX  XXXXXXX 
'    XX  XX   XX          XX     XXXXX   XX        XX         XX      XX  XX    XX  XX  XX   XX    XX XX     XX     XX  XX   XX  XX       XX 
'    XX  XX    XXXXX     XXXX    XX       XXXXX   XXXX       XXXX      XXX XX   XX  XX   XXXXX      XXX     XXXX     XXXX    XX  XX  XXXXXXX 
'                               XXXX              
' 
' ------------------------------------------------------------------------------------------------------------------------------------------


Sub ProcessMailEnbabledUsers(aMessageGroupInformation)
	Dim objRootDSE, strDNSDomain, objCommand, objConnection, strQuery, objRecordSet, strBase, strFilter, strAttributes
	Dim iLimitWarning, iProhibitSend, iProhibitSendRecieve, bResult
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")
	Set objCommand = CreateObject("ADODB.Command")
	Set objConnection = CreateObject("ADODB.Connection")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	objCommand.ActiveConnection = objConnection
	strBase = "<LDAP://" & strDNSDomain & ">"
	strFilter = "(&(objectCategory=person)(objectClass=user)(mailNickname=*))"
	strAttributes = "displayName,adsPath,mail"
	strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	objCommand.CommandText = strQuery
	objCommand.Properties("Page Size") = 100
	objCommand.Properties("Timeout") = 30
	objCommand.Properties("Cache Results") = False
	Set objRecordSet = objCommand.Execute
	If objRecordSet.EOF Then
	  	AppendtoLogFile	ERROR_STR & "No mail enabled users found, process terminating" 
	  	Exit Sub
	End If
	Do Until objRecordSet.EOF
		if oDic.Exists(Right(objRecordSet.Fields("adspath"),Len(objRecordSet.Fields("adspath"))-7)) Then 
			if InTheGroupList(oDic(Right(objRecordSet.Fields("adspath"),Len(objRecordSet.Fields("adspath"))-7)),aMessageGroupInformation,iLimitWarning, iProhibitSend, iProhibitSendRecieve) then
				bResult = SetMailBoxSizeLimits(objRecordSet.Fields("adspath"),iLimitWarning, iProhibitSend, iProhibitSendRecieve)
			End if
		Else
			bResult = UseStoreDefaultSizeLimits(objRecordSet.Fields("adspath"))
		End if 	
		objRecordSet.MoveNext
	Loop
End Sub


' --------------------------------------------------------------------------

Function InTheGroupList(sGrpName,aMessageGroupInformation, iLimitWarning, iProhibitSend, iProhibitSendRecieve)
	Dim iI, aGroupData
	InTheGroupList = False
	iLimitWarning = 0
	iProhibitSend = 0
	iProhibitSendRecieve = 0
	For iI = LBound(aMessageGroupInformation) To UBound(aMessageGroupInformation)
		aGroupData = csvparse(aMessageGroupInformation(iI))
		If Not IsArray(aGroupData) Then : Exit Function
		If UBound(aGroupData) < 3 Then :  Exit Function
		If UCase(aGroupData(0)) = UCase(sGrpName) Then
			iLimitWarning = aGroupData(1)
			iProhibitSend = aGroupData(2)
			iProhibitSendRecieve = aGroupData(3)
			InTheGroupList = True
			Exit Function
		End if
	Next
End Function

' --------------------------------------------------------------------------

Function UseStoreDefaultSizeLimits(adspath)
	Dim oObj, bChanged
	UseStoreDefaultSizeLimits = False
	bChanged = False
	On Error Resume Next
	Err.Clear
	Set oObj = GetObject(adspath)
	If (oObj.mDBUseDefaults = False) And oObj.mDBUseDefaults <> "" Then
		oObj.mDBUseDefaults = True
		bChanged = True
	End if
	if oObj.mDBStorageQuota <> "" then
		oObj.PutEx ADS_PROPERTY_CLEAR, "mDBStorageQuota", 0
		bChanged = True
	End If
	if oObj.mDBOverQuotaLimit <> "" then
		oObj.PutEx ADS_PROPERTY_CLEAR, "mDBOverQuotaLimit", 0
		bChanged = True
	End If
	if oObj.mDBOverHardQuotaLimit <> "" then
		oObj.PutEx ADS_PROPERTY_CLEAR, "mDBOverHardQuotaLimit", 0
		bChanged = True
	End if
	if bChanged then
		AppendtoLogFile TABTAB & TAB & "Clearing explicit settings for " & Chr(34) & Right(adspath,Len(adspath)-7) & Chr(34)
		oObj.SetInfo
		If Err.Number = 0 Then
			iObjectsUpdated = iObjectsUpdated + 1
			AppendtoLogFile TABTAB & TABTAB & "Update Successful"
		Else
			AppendtoLogFile "####" & TABTAB & TAB & "WARNING Update Failed - Err: 0x" & Hex(Err.Number) & " " & Err.Description  		
		End if
	End if
	If Err.Number = 0 Then : UseStoreDefaultSizeLimits = True
	On Error Goto 0
	Set oObj = Nothing
End Function

' --------------------------------------------------------------------------

Function SetMailBoxSizeLimits(adspath,iLimitWarning, iProhibitSend, iProhibitSendRecieve)
	Dim oObj, bChanged
	SetMailBoxSizeLimits = False
	bChanged = False
	On Error Resume Next
	Err.Clear
	Set oObj = GetObject(adspath)
	If (oObj.mDBUseDefaults = True) Or oObj.mDBUseDefaults = "" Then
		oObj.mDBUseDefaults = False
		bChanged = True
	End If
	If IsNumeric(iLimitWarning) then
		If CLng(oObj.mDBStorageQuota) <> CLng(iLimitWarning) Then
			oObj.mDBStorageQuota = CLng(iLimitWarning)
			bChanged = True
		End If
	End if
	If IsNumeric(iProhibitSend) then
		if CLng(oObj.mDBOverQuotaLimit) <> CLng(iProhibitSend) Then
			oObj.mDBOverQuotaLimit = CLng(iProhibitSend)
			bChanged = True
		End If
	End If
	If IsNumeric(iProhibitSendRecieve) then
		if CLng(oObj.mDBOverHardQuotaLimit) <> CLng(iProhibitSendRecieve) Then
			oObj.mDBOverHardQuotaLimit = CLng(iProhibitSendRecieve)
			bChanged = True
		End If
	End If
	if bChanged then
		AppendtoLogFile TABTAB & TAB & "Setting explicit limits for " & Chr(34) & Right(adspath,Len(adspath)-7) & Chr(34)
		oObj.SetInfo
		If Err.Number = 0 Then
			iObjectsUpdated = iObjectsUpdated + 1
			AppendtoLogFile TABTAB & TABTAB & "Update Successful"
		Else
			AppendtoLogFile "####" & TABTAB & TAB & "WARNING Update Failed - Err: 0x" & Hex(Err.Number) & " " & Err.Description  		
		End if
	End if
	If Err.Number = 0 Then : SetMailBoxSizeLimits = True
	On Error Goto 0
	Set oObj = Nothing
End Function

' --------------------------------------------------------------------------

Function GetMessageSizeGroupInformation
	Dim objRootDSE, strDNSDomain, objCommand, objConnection, strQuery, objRecordSet, strBase, strFilter, strAttributes
	Dim aResult, iI, iJ, aGroupMembership, sInfoField, aInfoField, sLimitWarning, sProhibitSend, sProhibitSendRecieve, sGroupName
	iI= 0
	ReDim aResult(-1)
	GetMessageSizeGroupInformation = aResult
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")
	Set objCommand = CreateObject("ADODB.Command")
	Set objConnection = CreateObject("ADODB.Connection")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	objCommand.ActiveConnection = objConnection
	strBase = "<LDAP://" & strDNSDomain & ">"
	strFilter = "(&(objectCategory=group)(name=" & MAILBOX_SIZE_GROUP_PREFIX & "*))"
	strAttributes = "name,adsPath,member,info"
	strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	objCommand.CommandText = strQuery
	objCommand.Properties("Page Size") = 100
	objCommand.Properties("Timeout") = 30
	objCommand.Properties("Cache Results") = False
	Set objRecordSet = objCommand.Execute
	If objRecordSet.EOF Then
		Exit Function
	End If
	Do Until objRecordSet.EOF
		iI = iI + 1
		sInfoField = ""
		sLimitWarning = ""
		sProhibitSend = ""
		sProhibitSendRecieve = ""
		sGroupName = ""
		AppendtoLogFile TABTAB &  "Found group " & Chr(34) & objRecordSet.Fields("name") & Chr(34)
		if not IsNull(objRecordSet.Fields("info")) Then 
			sInfoField = objRecordSet.Fields("info")
		End If
		sGroupName = objRecordSet.Fields("name")
		aGroupMembership = objRecordSet.Fields("member")
		if IsArray(aGroupMembership) then
			AppendtoLogFile TABTAB &  TAB & "Group has " & UBound(aGroupMembership) + 1 & " member(s)"
			sInfoField = Trim(sInfoField)
			If sInfoField = "" Then
				AppendtoLogFile TABTAB &  TAB & "The information field for this group is blank, it will be skipped"	
			Else
				If (InStr(1,sInfoField,LIMIT_WARNING_KEY_WORDS,1) = 0) And (InStr(1,sInfoField,LIMIT_PROHIBIT_SEND_KEY_WORDS,1) = 0)_
			   	And (InStr(1,sInfoField,LIMIT_PROHIBIT_SEND_AND_RECEIVE_KEY_WORDS,1) = 0) Then
					AppendtoLogFile TABTAB & TAB & "No keywords in the information field of this group is blank, it will be skipped"							
				Else
					sLimitWarning = GetInfoField(sInfoField,LIMIT_WARNING_KEY_WORDS)
					sProhibitSend = GetInfoField(sInfoField,LIMIT_PROHIBIT_SEND_KEY_WORDS)
					sProhibitSendRecieve = GetInfoField(sInfoField,LIMIT_PROHIBIT_SEND_AND_RECEIVE_KEY_WORDS)
					If IsNumeric(sLimitWarning) Then
						sLimitWarning = sLimitWarning * 1024
					Elseif sLimitWarning <> "" Then
						AppendtoLogFile "####" & TABTAB & "WARNING: Invalid value specified for " & Chr(34) & LIMIT_WARNING_KEY_WORDS & Chr(34) & ", it will be ignored. (value was " & Chr(34) & sLimitWarning & Chr(34) & ")" 
						sLimitWarning = ""
					End if
					If IsNumeric(sProhibitSend) Then
						sProhibitSend = sProhibitSend * 1024
					Elseif sProhibitSend <> "" Then
						AppendtoLogFile "####" & TABTAB & "WARNING: Invalid value specified for " & Chr(34) & LIMIT_PROHIBIT_SEND_KEY_WORDS & Chr(34) & ", it will be ignored. (value was " & Chr(34) & sProhibitSend & Chr(34) & ")" 
						sProhibitSend = ""
					End if
					If IsNumeric(sProhibitSendRecieve) Then
						sProhibitSendRecieve = sProhibitSendRecieve * 1024				
					Elseif sProhibitSendRecieve <> "" Then
						AppendtoLogFile "####" & TABTAB & "WARNING: Invalid value specified for " & Chr(34) & LIMIT_PROHIBIT_SEND_AND_RECEIVE_KEY_WORDS & Chr(34) & ", it will be ignored. (value was " & Chr(34) & sProhibitSendRecieve & Chr(34) & ")" 					
						sProhibitSendRecieve = ""
					End if
					If sLimitWarning <> "" then
						AppendtoLogFile TABTAB & TAB & LIMIT_WARNING_KEY_WORDS & "             : " & sLimitWarning / 1024 & " Mb"
					Else
						AppendtoLogFile TABTAB & TAB & LIMIT_WARNING_KEY_WORDS & "             : Unspecified"					
					End if
					If sProhibitSend <> "" then
						AppendtoLogFile TABTAB & TAB & LIMIT_PROHIBIT_SEND_KEY_WORDS & "             : " & sProhibitSend / 1024 & " Mb"
					Else
						AppendtoLogFile TABTAB & TAB & LIMIT_PROHIBIT_SEND_KEY_WORDS & "             : Unspecified"					
					End if
					If sProhibitSendRecieve <> "" then
						AppendtoLogFile TABTAB & TAB & LIMIT_PROHIBIT_SEND_AND_RECEIVE_KEY_WORDS & " : " & sProhibitSendRecieve / 1024 & " Mb"
					Else
						AppendtoLogFile TABTAB & TAB & LIMIT_PROHIBIT_SEND_AND_RECEIVE_KEY_WORDS & " : Unspecified"					
					End If
					If (sLimitWarning = "") And (sProhibitSend = "") And (sProhibitSendRecieve = "") Then
						AppendtoLogFile TABTAB &  TAB & "The limits fields for this group are all blank, it will be skipped"		
					Else
						' ----------------------------------------'
						'                                         '
						' Add logic here to expand nested groups  '
						'                                         '
						' ----------------------------------------'
						ReDim Preserve aResult(UBound(aResult)+1)
						aResult(UBound(aResult)) = QuoteStringsWithEmbeddedCommas(sGroupName) & "," & QuoteStringsWithEmbeddedCommas(sLimitWarning) & "," & QuoteStringsWithEmbeddedCommas(sProhibitSend) & "," & QuoteStringsWithEmbeddedCommas(sProhibitSendRecieve)
						For iJ = LBound(aGroupMembership) To UBound(aGroupMembership)
							if Not oDic.Exists(aGroupMembership(iJ)) then
								oDic.Add aGroupMembership(iJ), sGroupName
								'aResult(UBound(aResult)) = aResult(UBound(aResult)) & QuoteStringsWithEmbeddedCommas("LDAP://" & aGroupMembership(iJ)) & ","
							Else
								AppendtoLogFile "####" & TABTAB & "WARNING: This user is in multiple groups, this entry is ignored " & Chr(34) & aGroupMembership(iJ) & Chr(34)
								AppendtoLogFile TABTAB & TAB & "         Other group is " & Chr(34) & oDic(aGroupMembership(iJ)) & Chr(34)
							End if
						Next
						'aResult(UBound(aResult)) = Left(aResult(UBound(aResult)),Len(aResult(UBound(aResult)))-1)
					End if 
				End If
			End If
		Else
			AppendtoLogFile TABTAB &  TAB & "This group has no members listed, it will be skipped"
		End If
		objRecordSet.MoveNext
	Loop
	GetMessageSizeGroupInformation = aResult
End Function

' --------------------------------------------------------------------------

Function QuoteStringsWithEmbeddedCommas(sString)
	if Instr(sString,",") then
		QuoteStringsWithEmbeddedCommas = Chr(34) & sString & Chr(34)
	else
		QuoteStringsWithEmbeddedCommas = sString
	end if
End Function

' --------------------------------------------------------------------------

Function GetInfoField(sInfo,sFieldID)
	Dim iI, aInfo, sLine
	GetInfoField = ""
	aInfo = Split(sInfo,vbCRLF)
	For iI = LBound(aInfo) To UBound(aInfo)
		sLine = Trim(aInfo(iI))
		If sLine <> "" then
			If Len(sLine) > Len(sFieldID) then
				if InStr(1,sLine,sFieldID,1) = 1 Then
					sLine = Right(sLine,Len(sLine)-Len(sFieldID))
					sLine = Trim(sLine)
					If Left(sLine,1) = "=" Then
						sLine = Right(sLine,Len(sLine)-1)
						sLine = Trim(sLine)
						GetInfoField = sLine
						Exit Function
					End if
				End if
			End If
		End if
	Next
End Function

' --------------------------------------------------------------------------

Function DeleteFile(strFiletoDelete)
   Dim f
   if fso.FileExists(strFiletoDelete) then
       set f=fso.GetFile(strFiletoDelete)
       f.attributes = 0       
       f.Delete True 
   end if
End Function

' --------------------------------------------------------------------------

Function AppendtoLogFile(str)
   Const MAX_RETRIES = 3
   Dim f, iRetries
   iRetries=0
   Err.Clear
   On Error Resume Next
   Do
       Set f = fso.OpenTextFile(sLogFile, FOR_APPENDING, True)
       If err.Number <> 0 Then 
           WScript.Sleep(200)
           iRetries=iRetries+1
       End If
   Loop Until (err.Number = 0) Or (iRetries => MAX_RETRIES)         
   If err.Number = 0 Then
       f.Writeline FormatDateTime(Now,0) + "  " + str
       f.Close
   End If    
   On Error Goto 0
   AppendtoLogFile=err.Number
End Function

' --------------------------------------------------------------------------

Function CheckLogFile(sFile)
	Const MAX_LOGFILE_SIZE = 512 'kbytes
	Dim f, iFS, sBakFileName
	If InStr(sFile,".") <> 0 Then
		sBakFileName = Left(sFile,InStrRev(sFile,".")-1)
	Else
		sBakFileName = sFile
	End If
	sBakFileName = sBakFileName + ".bak"
	If fso.FileExists(sFile) Then
		Set f = fso.GetFile(sFile)
		iFS = f.Size
		Set f = Nothing
		If iFS => (MAX_LOGFILE_SIZE * 1024) Then		
			DeleteFile(sBakFileName)
			fso.MoveFile sFile, sBakFileName
			AppendtoLogFile "Log File roll over"
		End If
	End If
End Function

' --------------------------------------------------------------------------

Function AddLeadingBackSlash(sTargetString)
   AddLeadingBackSlash = Trim(sTargetString)
   if Left(sTargetString,1) <> "\" Then : AddLeadingBackSlash = "\" & Trim(sTargetString)
End Function

' --------------------------------------------------------------------------

Function AddTrailingBackSlash(sTargetString)
   AddTrailingBackSlash = Trim(sTargetString)
   if right(sTargetString,1) <> "\" Then : AddTrailingBackSlash=sTargetString & "\" 
End Function

' --------------------------------------------------------------------------

Function RemoveLeadingBackSlash(sTargetString)
   RemoveLeadingBackSlash = Trim(sTargetString)
   if Left(sTargetString,1) = "\" Then : RemoveLeadingBackSlash = Right(sTargetString,len(sTargetString)-1)
End Function

' --------------------------------------------------------------------------

Function RemoveTrailingBackSlash(sTargetString)
   RemoveTrailingBackSlash = Trim(sTargetString)
   if right(sTargetString,1) = "\" Then : RemoveTrailingBackSlash = left(sTargetString,len(sTargetString)-1)
End Function

' --------------------------------------------------------------------------

Function CalculateElapsedTime(sTime,fTime)
	Dim iTotSecs, iHours, iMinutes, iSeconds, sResult
	CalculateElapsedTime = 0
    iTotSecs =DateDiff("s",sTime,fTime)
	iHours=INT(iTotSecs / 3600)
    iTotSecs=(iTotSecs MOD 3600)
    iMinutes=INT(iTotSecs / 60)
    iSeconds=(iTotSecs MOD 60)
    If Len(CStr(iHours)) > 1 Then
    	sResult = sResult & CStr(iHours)
    Else
    	sResult = sResult & "0" & CStr(iHours)
	End if
	sResult = sResult & ":"
	if Len(CStr(iMinutes)) > 1 Then
    	sResult = sResult & CStr(iMinutes)
    Else
    	sResult = sResult & "0" & CStr(iMinutes)
	End if
	sResult = sResult & ":"
    If Len(CStr(iSeconds)) > 1 Then
    	sResult = sResult & CStr(iSeconds)
    Else
    	sResult = sResult & "0" & CStr(iSeconds)
	End if
	CalculateElapsedTime = sResult
End Function

' --------------------------------------------------------------------------

function csvparse(byval vstring)
  '=================================================================
  'Walks a string in CSV format where fields are
  'separated by commas.  In CSV format, fields containing commas
  'or embedded double quotes are enclosed in double quotes.
  'Embedded double quotes are themselves doubled.  When parsed,
  'the enclosing double quotes are stripped and doubled embedded
  'double qoutes are replaced with single double quotes.
  '
  'Null fields (2 consequtive commas) are given the value Empty.
  '
  'The degenerative case of a null line returns an empty array,
  'i.e., an array with ubound = -1.  It is also assumed that any
  'terminating carriage-return/line-feed characters have been removed,
  'otherwise they are treated as part of the last field.
  '
  'Each field is placed in a dynamic array which
  'becomes the return value of the function.
  '=================================================================

  'Check for empty string and return empty array...
  if len(trim(vstring)) = 0 then
    csvparse = array()
    exit function
  end if

  dim arwork       'work array
  dim ignore       'flag to ignore commas
  dim fieldcount   'field count
  dim currpos      'pointer to start of field
  dim startpos
  dim char
  dim data
  const qt = """"  'literal double quote

  'initialize...
  ignore = false
  fieldcount = 0
  startpos = 1
  arwork = array()

  ' add "," to delimit the last field
  vstring = vstring&","

  ' walk the string
  for currpos = 1 to len(vstring)
    ' get a character...
    char = mid(vstring,currpos,1)
    select case char
      ' if it's a " then toggle the ignore flag...
      case qt: ignore = not ignore
      ' if it's a ,
      case ","
        ' and we're not ignoring commas,
        ' then it's a field delimiter,
        ' otherwise just move on.
        if not ignore then
          ' grow the array by one element
          redim preserve arwork(fieldcount)
          ' if the "field" has a non-zero length...
          if currpos-startpos > 0 then
            ' extract the field value
            data = mid(vstring,startpos,currpos-startpos)
            ' if it's a quoted string, use eval to
            ' remove outer quotes and reduce inner
            ' doubled quotes
            if left(data,1) = qt then
              arwork(fieldcount) = eval(data)
            else
              arwork(fieldcount) = data
            end if
          else
            ' an empty field is an empty array element
            arwork(fieldcount) = empty
          end if
          ' get ready for next field
          fieldcount = fieldcount + 1
          startpos = currpos+1
        end if
      end select
  next
  ' return the array
  csvparse = arwork
end function

' --------------------------------------------------------------------------

Const                    ERROR_STR  = "### ERROR "
Const                           TAB = "    "
Const                        TABTAB = "        "
Const                  FOR_READING  =  1
Const                 FOR_WRITTING  =  2
Const                FOR_APPENDING  =  8
Const             TEMPORARY_FOLDER  =  2
Const         TRISTATE_USE_DEFAULT  = -2 'Opens the file using the system default.
Const                TRISTATE_TRUE  = -1 'Opens the file as Unicode.
Const               TRISTATE_FALSE  =  0 'Opens the file as ASCII.
Const           ADS_PROPERTY_CLEAR  =  1