
Function FormatURL(strPath)
  'Cut off everything before wwwroot and replace all \ with /
  Dim iPos
  iPos = InStr(1,strPath,"wwwroot",1)
		
  Dim str
  str = Mid(strPath,iPos+7,Len(strPath))
		
  FormatURL = Replace(str,"\","/")
End Function
	

Function addarticles(objFolder)
  If Left(objFolder.Name,1) = "_" then exit function

  'Now, loop through each file
  Dim objFile, objTextStream, objFSO, strContents, iUBound, iLoop, bolValid
  Dim strTitle, iPos, strDesc
		
  For Each objFile in objFolder.Files
    'Do we need to search this file?
    If UCase(Right(objFile.Name,6)) = ".SHTML" or UCase(right(objFile.Name,4)) = ".ASP" then
       if objFile.Size > 0 then
          Set objFSO = CreateObject("Scripting.FileSystemObject")
          Set objTextStream = objFSO.OpenTextFile(objFile.Path,1)
          strContents = objTextStream.ReadAll
          objTextStream.Close            
          Set objTextStream = Nothing
          Set objFSO = Nothing
					
          iPos = InStr(1,strContents,"<!--TITLE:")
          If iPos = 0 then
            strTitle = "Untitled (" & objFile.Name & ")"
            strDesc = ""
          Else
            strTitle = Mid(strContents,iPos+10,InStr(iPos,strContents,"-->")-iPos-10)
							
            iPos = InStr(iPos,strContents,"<!--DESC:")
            If iPos = 0 then
              strDesc = ""
            Else
              strDesc = Mid(strContents,iPos+9,InStr(iPos,strContents,"-->")-iPos-9)
            End If
          End If

          if len(strTitle) > 150 then strTitle = Left(strTitle,140) & "..."
          if len(strDesc) >= 254 then strDesc = Left(strDesc,245) & "..."

          objRS.AddNew
          objRS("Title") = strTitle
          objRS("Description") = strDesc
          objRS("Contents") = strContents
          objRS("Url") = FormatURL(objFile.Path)
          objRS.Update

        End If
     End if
   Next
		
   Dim objSubFolder
   For Each objSubFolder in objFolder.SubFolders
      AddArticles objSubFolder
   Next				
End Function



Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

DIm objFolder
Set objFolder = objFSO.GetFolder("D:\Inetpub\wwwroot\webtech")

Dim objConn
Set objConn = CreateObject("ADODB.Connection")
objConn.Open "DSN=4guys"

'Clean out AritlceIndex
objCOnn.Execute "DELETE FROM tblArticleIndex"

Dim objRS
Set objRS = CreateObject("ADODB.Recordset")
objRS.Open "ArticleIndex",objConn,3,3,2
AddArticles objFolder
objRS.Close

Set objRS = Nothing
Set objFolder = Nothing
objConn.Close
Set objConn = Nothing
Set objFSO = Nothing