'**************************************
'Filename: DocLinkCreator.vbs
'Date created: 25/09/06
'Last update: 05/10/06
'Author: Ryan Roque
'**************************************

Dim objFile, objFolder, strLink, strFilePath, strDirectory

strFilePath = "c:\doclink.ndl"			'File path for the doclink.ndl
strDirectory = "c:\doclinks\"			'Directory for the doclink.ndl

Call CreateLink(strFilePath, strDirectory)
Call RenameLink(strFilePath, strDirectory)

'This function will create the doclink.ndl file by reading the contents of the clipboard.
Sub CreateLink(strFilePath, strDirectory)
	
	'Create the object to be used to read the Clipboard.
	Set objHTML = CreateObject("htmlfile")
	'Create the File System Object
	Set objFile = CreateObject("Scripting.FileSystemObject")
	
	'Retrieves data from the clipboard formatted as text
	ClipboardText = objHTML.ParentWindow.ClipboardData.GetData("text")
	
	'Ensure the folder "c:\doclinks\" exist. If not create it.	
	'The created doclink folder will be empty at this stage.
	If objFile.FolderExists(strDirectory) Then
		Set objFolder = objFile.GetFolder(strDirectory)
	Else
		Set objFolder = objFile.CreateFolder(strDirectory)
	End If

	'This will create the doclink.ndl file.
	'This file will be empty stage since we havent read the contents of the Clipboard.
	Set strLink = objFile.CreateTextFile(strFilePath, True)

	'Copy the contents of the clipboard to the doclink.ndl file. First check if the clipboard has text to write in the file.
	If ClipboardText <>" " then
		'The text contents written in the doclink.ndl file
		strLink.WriteLine(ClipboardText)
		'Write and close file.
		strLink.Close
	else
		'At this stage the doclink.ndl file is still empty.
		Msgbox "Please copy a database or document in Lotus Notes."
	End if

	'Clear the memory
	Set objHTML = Nothing
	Set objFile = Nothing
	
End Sub

'This method is used to rename the docLink.ndl file.
'The script will read the first line on the file on  C:\doclinks.ndl created by CreateLink(strFilePath, strDirectory)
'Then RenameLink will will call CleanTheString(sTitle) method to remove characters that are not allowed to used in a Windows Filename.
'Once the docLink.ndl is renamed Windows Explorer is called to display the newly created docLink file.
Sub RenameLink(strFilePath, strDirectory)
	dim filesys, text, readfile, contents, objFile, newFile, strTime
	set filesys = CreateObject("Scripting.FileSystemObject")

	If filesys.FileExists(strFilePath) Then
		set objFile =filesys.GetFile(strFilePath)
			
			If objFile.Size > 0 then
				set readfile = filesys.OpenTextFile(strFilePath, 1)
				contents = Trim(readfile.ReadLine)
				readfile.close
		
				'Const OverwriteExisting = True
				newFile = CleanTheString(contents) & ".ndl"
	
				If filesys.FileExists(strDirectory & newFile) then
					strTime = CleanTheString(CStr(Time()))
					filesys.CopyFile strFilePath , strDirectory & CleanTheString(contents) & " - " & strTime & ".ndl"
				Else
					filesys.CopyFile strFilePath , strDirectory & newFile
				End If
				'Display the renamed doc link.
				DisplayLink(strDirectory)
				
				'Clear the memory
				Set filesys = nothing
		else
			'MsgBox "Doc Link File is empty."
			Set filesys = nothing
		End if
	Else
		WScript.echo "Doc Link doesn't exist"
	End If
End Sub

'This function is used to remove non-alpha numeric characters from the string.
'Once the string is clean it can be used as the filename for the doclink.
Function CleanTheString(sTitle)
     strAlphaNumeric = "-.0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ "'Used to check for numeric characters.
     For i = 1 to len(sTitle)
         strChar = mid(sTitle,i,1)
         If instr(strAlphaNumeric,strChar) Then
             CleanedString = CleanedString & strChar
         End If
     Next
	'Return the parsed string.
     CleanTheString = CleanedString
End Function

'This function will open the created doclink in Windows Explorer.
Sub DisplayLink(strDirectory)
	'Display the created the file in Windows Explorer
	If err.number = vbEmpty then
		Set objShell = CreateObject("WScript.Shell")
		objShell.run ("Explorer" & " " & strDirectory)
		'objShell.run ("Explorer" & " " & strDirectory & "\" )
	Else 
		MsgBox "VBScript Error: " & err.number
	End If
End Sub