'++LotusScript Development Environment:2:5:(Options):0:74
Option Public


'++LotusScript Development Environment:2:5:(Forward):0:1
Declare Type SECURITY_ATTRIBUTES
Declare Function ReplaceStr (S As String, O As String, R As String) As String
Declare Sub Initialize
Declare Sub ParseNetscapeBookmark
Declare Sub CallDefaultBrowser
Declare Sub SetWebTrekLicenseKey

'++LotusScript Development Environment:2:5:(Declarations):0:10
Declare Public Function GetPrivateProfileString Lib"Kernel" (Byval lpName As String, Byval lpKey As Any, Byval lpDefault As String, Byval lpReturn As String, Byval nSize As Integer, Byval lpFile As String) As Integer
Declare Public Function RegOpenKeyExA Lib "advapi32" Alias "RegOpenKeyExA" (Byval HKEY As Long,Byval lpszSubKey As String,Byval dwreserved As Integer,Byval samDesired As Long, keyresult As Long) As Long
Declare Public Function RegQueryValueExA Lib "advapi32" Alias "RegQueryValueExA" (Byval HKEY As Long,Byval lpszValueName As String,Byval dwreserved As Integer, lpdwtype As Long, Byval lpData As String, readbytes As Long) As Long
Declare Public Function RegCloseKey Lib "advapi32" Alias "RegCloseKey" (Byval HKEY As Long) As Long
Declare Public Function GetPrivateProfileStringA Lib "kernel32" Alias "GetPrivateProfileStringA"(Byval AppName As String,Byval KName As Any, Byval Def As String, Byval RStr As String, Byval nSize As Integer, Byval FName As String) As Integer

Dim strURL As String
Dim strPageTitle As String

Dim iMoreInfo As Integer   'Tracks 'more info' on the Found Set Report

'Begin Global BlockTranslated from WebTrek Licensing Source Code

Type SECURITY_ATTRIBUTES
	nLength As Long
	lpSecurityDescriptor As Long
	bInheritHandle As Integer
End Type

Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (Byval hKey As Long, Byval lpSubKey As String, phkResult As Long) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (Byval hKey As Long, Byval lpSubKey As String, phkResult As Long) As Long
Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (Byval hKey As Long, Byval lpSubKey As String, Byval lpValue As String, lpcbValue As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (Byval hKey As Long, Byval lpSubKey As String, Byval ulOptions As Long, Byval samDesired As Long, phkResult As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (Byval hKey As Long, Byval lpSubKey As String, Byval Reserved As Long, Byval lpClass As String, Byval dwOptions As Long, Byval samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (Byval hKey As Long, Byval lpValueName As String, Byval Reserved As Long, Byval dwType As Long, lpData As Any, Byval cbData As Long) As Long         
Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (Byval hKey As Long, Byval lpSubKey As String, Byval dwType As Long, Byval lpData As String, Byval cbData As Long) As Long


Public Const MAX_PATH = 32
Public Const ERROR_SUCCESS = 0&
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const SYNCHRONIZE = &H100000
Public Const KEY_SET_VALUE = &H2
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Public Const REG_SZ = 1                         
Public Const REG_OPTION_NON_VOLATILE = 0       

'End Global BlockTranslated from WebTrek Licensing Source Code




'++LotusScript Development Environment:2:1:ReplaceStr:1:8
Function ReplaceStr (S As String, O As String, R As String) As String
' S is the input string, O is the old string, R is the replacement string
	If (S = "") Then
		ReplaceStr = ""
	Else
		n = Instr(S,O)
		While (n > 0)
			Mid(S,n) = R
			n = Instr(S,O)	
		Wend
		ReplaceStr = S
	End If
End Function
'++LotusScript Development Environment:2:2:Initialize:1:10
Sub Initialize
	iMoreInfo = False
End Sub
'++LotusScript Development Environment:2:2:ParseNetscapeBookmark:1:8
Sub ParseNetscapeBookmark
	'Declarations
	Dim strNetPath As String
	Dim  strBookmarkFile As String
	Dim strBookmarks As String
	Dim strType As String	
	Dim strCrntHdr As String
	Dim strSurfnet As String
	Dim strTableName As String
	Dim strCrntURL As String
	Dim strCrntBkmrk As String
	Dim strMsg As String   'Messag for message box.
	
	Dim iFileId As Integer
	Dim rval As Integer   'Return value.
	   'Flag (0=quit, 1=quit, 2=go)
	Dim iOK As Integer
	
	Dim lFileLen As Long
	
	Dim Con As New Connection
	Dim Qry As New Query
	Dim RS As New ResultSet
	
	'Array of bookmarks (Title, URL, Category)
	Dim aryBookmarks(10, 10, 10) As String
	
	'Initializations
	iOK = 0
	strMsg = "Incorrect directory or  file" & Chr(10) &  "doesn't exist, try again?"
	On Error Resume Next   'If error occurs, continue.
	
	Do Until (iOK <> 0)
		strNetPath = Inputbox("Enter the name of the Netscape directory.", "Netscape Directory", "C:\PROGRAM FILES\NETSCAPE\NAVIGATOR", 150, 150)
		
		strBookmarkFile = strNetPath & "\BOOKMARK.HTM"
		strTemp = Dir(strBookmarkFile)  'List the file.
		
		If Lcase$(Dir(strBookmarkFile)) <> "bookmark.htm" Then   'If the file doesn't exist...
			If strNetPath = "" Then
				Exit Sub
			Else
				rval = 1   'Reset
				rval = Messagebox(strMsg , 1,  "Warning")
				If (rval = 1) Then
					iOK = 0
				Else
					iOK = 1
				End If
			End If
		Else
			iOK = 2
		End If
	Loop
	
	
	
	If (iOK = 2) Then
		lFileLen = Filelen(strBookmarkFile)
		'iFileId = 1
		iFileId = Freefile
		'Open the file.
		Open strBookmarkFile For Input Access Read As iFileId Len = lFileLen
		
		If lFileLen >32000 Then
			rval = Messagebox("The Netscape Bookmark file is too large at "+Trim(Str$(lFileLen))+ " characters.  Please reduce to 32000 characters or less.", 0, "Import Bookmarks")
			Exit Sub			
		End If
		
		strType = "N"
		strTableName = CurrentDocument.Tables(0).FileName
		strSurfnet = CurrentDocument.Path & strTableName
		
		'Use the data object to enter records.
		If (Con.ConnectTo("dBASE IV")) Then
			Set Qry.Connection = Con
			Qry.Tablename = strSurfnet
			Set RS.Query = Qry
			If (RS.Execute = False) Then
				Messagebox "Couldn't access file for import."
			End If
		Else
			Messagebox "Couldn't access file for import."
		End If
		
		'Put the contents of the file in a variable.
		strBookmarks = Input$(lFileLen, iFileId)
		
		
		For i = 1 To lFileLen
			'Reset the header if the bookmark has none.
			If (Mid$(strBookmarks, i, 8) = "</DL><p>") Then
				strCrntHdr = ""
			End If
			
			'Find the header.
			If (Mid$(strBookmarks, i, 3) = "<H3") Then
				'We've found a header.
				strCrntHdr = ""
				'Now let's find the header name
				Do Until (Mid$(strBookmarks, i, 1) = ">")
					i = i + 1
				Loop
				i = i+ 1   'Get next character.
				'Get the header and put in a variable.
				strCrntHdr = ""   'Reset variable.
				Do Until (Mid$(strBookmarks, i, 1) = "<")
					strCrntHdr = strCrntHdr & Mid$(strBookmarks, i, 1)
					i = i+ 1
				Loop
				
			'Find the bookmark
			Elseif (Mid$(strBookmarks, i, 2) = "<A") Then
			'We've found a bookmark
				strType = "B"
			'Now let's find the URL
				Do Until (Mid$(strBookmarks, i, 1) = """")
					i = i + 1
				Loop
				i = i+ 1   'Get next character.
				
			'Get the URL and put in a variable.
				Do Until (Mid$(strBookmarks, i, 1) = """")
					strCrntURL = strCrntURL & Mid$(strBookmarks, i, 1)
					i = i+ 1
				Loop
				
        		'delete all http;// prefix
				Dim HTTPPos As Integer
				HTTPPos = Instr(strCrntURL, "http://")
				If HTTPPos <> 0 Then
					strCrntURL = Right$(strCrntURL, Len(strCrntURL) - 7)
				End If
				
				
			'Now let's find the bookmark name.
				Do Until (Mid$(strBookmarks, i, 1) = ">")
					i = i + 1
				Loop
				i = i+ 1   'Get next character.
			'Get the bookmark name  and put in a variable.
				Do Until (Mid$(strBookmarks, i, 1) = "<")
					strCrntBkmrk = strCrntBkmrk & Mid$(strBookmarks, i, 1)
					i = i+ 1
				Loop
				
				If (Mid$(strBookmarks, i, 4) = "</A>") Then
					'Now let's add the record to the file.
					RS.AddRow
					rval = RS.SetValue(2, strCrntBkmrk)
					rval = RS.SetValue(1, strCrntURL)
					rval = RS.SetValue(3, strCrntHdr)
					RS.UpdateRow
					strCrntURL = ""
					strCrntBkmrk = ""
				End If
			End If
		Next
		Close(iFileId)
		RS.Close
		Messagebox "Import" & Chr(10) & "complete.", 0, "Import"
	End If
	
EndImport:
End Sub
'++LotusScript Development Environment:2:2:CallDefaultBrowser:1:8
Sub CallDefaultBrowser
	
	Dim happkey As Long
	Dim HKEY_LOCAL_MACHINE As Long
	Dim KEY_READ As Long
	Dim HKEY_CURRENT_USER As Long
	Dim HKEY_CLASSES_ROOT As Long
	Dim ValueType As Long
	Dim ReturnedKeyContents As String * 255
	Dim readbytes As Long
	Dim ReturnString As String * 255
	MaxBytes%=Len(ReturnString$)
	IniFileName$ = "Win.Ini"
	ReturnedKeycontents$=String$(255,Chr$(32))
	
	HKEY_CLASSES_ROOT= &H80000000
	HKEY_CURRENT_USER= &H80000001
	HKEY_LOCAL_MACHINE= &H80000002
	
	KEY_QUERY_VALUE=1
	KEY_ENUMERATE_SUBKEYS=8
	KEY_NOTIFY=16
	KEY_READ=KEY_QUERY_VALUE Or KEY_ENUMERATE_SUBKEYS Or KEY_NOTIFY
	
	KeyName$="http\shell\open\command"
	URL$= "http://"+currentview.body.url.text
	
	GNNStat = GetPrivateProfileStringA("GNNWorks","AppPath","NA",ReturnString$,MaxBytes%,IniFileName$)
	AppPath$=Left$(ReturnString$,GNNStat)
	
	If AppPath$="NA" Then ' did not find 16 bit GNN works
		ValueName$=""
		lstat=RegOpenKeyExA(HKEY_CLASSES_ROOT,KeyName$,0,KEY_READ,happkey)
		ReadBytes=255
		lstat=RegQueryValueExA(happkey,ValueName$,0,valueType, ReturnedKeyContents$,ReadBytes)
		regclosekey(happkey)
		
		
		TrimmedKeyContents$ = Trim$(ReturnedKeyContents$)
		If TrimmedKeyContents$ ="" Then
			Messagebox("Approach can't determine if a WWW browser is installed, script aborted.")
			Exit Sub
		End If
		
		' Strip out any Double quotation marks - Internet Explorer adds these into default browser settings whereas Netscape does not.
		
		NewKeyContents$ = ""
		For cnt = 1 To Len(TrimmedKeyContents$)
			If Mid$(TrimmedKeyContents$, cnt, 1) <> """" Then
				NewKeyContents$ = NewKeyContents$ + Mid$(TrimmedKeyContents$, cnt, 1)
			End If
		Next cnt		
		
		BrowserPath$=Left$(NewKeyContents$,ReadBytes-1)
		
        ' delete all command line params:
		ExePos=Instr(BrowserPath$,".exe")
		If ExePos<>0 Then
			BrowserPath$=Left$(BrowserPath$,ExePos+4)
		End If
		
		' return path without leading quote, if there is one:
		QuotePos=Instr(BrowserPath$,Chr$(34))
		If QuotePos<>0 Then
			BrowserPath$=Mid$(BrowserPath$,QuotePos+1)
		End If
	Else
		' found GNN Works
		BrowserPath$ = Left(AppPath$,GNNStat) & "\IW.EXE"
	End If
	
	LaunchPath$=BrowserPath$+" "+URL$
	Err=0
	On Error Resume Next
	stat = Shell(LaunchPath$, 1)
	On Error Goto 0
	If Err<>0 Then
		Messagebox "Error launching web browser, please check installation and try again.", MB_OK, "Error"
	End If 
End Sub
'++LotusScript Development Environment:2:2:SetWebTrekLicenseKey:1:8
Sub SetWebTrekLicenseKey
	Dim stringCLSIDKey As String *255
	Dim stringCLSIDKeyValue As String * 82
	Dim strCLSIDKeyValue As String
	Dim stringCopyrightValue As String 
	
	Dim notused As Long	
	Dim cvLength As Long
	Dim szKey As String
	
	Dim hKeyControl As Long	
	Dim dwLength As Long
	Dim hKeyCLSID As Long
	Dim hKeyMyCLSID As Long
	Dim hKeyCLSIDTree As Long
	Dim  hKeyCopyright As Long
	Dim dwDisposition As Long
	Dim lpSecurityAttributes As SECURITY_ATTRIBUTES
	
	stringCopyrightValue$ = "WebTrek -- Copyright © 1996 Home Page Software Inc. -- A Webster CodeBase Product"
	dwLength = 255
	
	
	If (RegOpenKey(HKEY_CLASSES_ROOT, "WebTrek.WebsterCtrl.1", hKeyControl) = ERROR_SUCCESS) Then
		 '// Have the main entry:
		
     	 '// Get the class GUID
		
		If (RegOpenKey(hKeyControl, "CLSID", hKeyCLSID) = ERROR_SUCCESS) Then
			notused = RegQueryValue(hKeyCLSID, "", stringCLSIDKeyValue$, dwLength)
			
			strCLSIDKeyValue$ = Left$(stringCLSIDKeyValue$, dwLength - 1)
			
	         '// Done
			notused = RegCloseKey(hKeyCLSID)
		End If
		
     	 '// Get the CLSID entry
		
		If (RegOpenKey(HKEY_CLASSES_ROOT, "CLSID", hKeyCLSIDTree) = ERROR_SUCCESS) Then
			 '// In HKEY_CLASSES_ROOT\CLSID tree: open our GUID
			
			If (RegOpenKeyEx(hKeyCLSIDTree, strCLSIDKeyValue$, 0, KEY_WRITE, hKeyMyCLSID) = ERROR_SUCCESS) Then
				
				If (RegCreateKeyEx(hKeyMyCLSID, "Copyright", 0, "REG_SZ", REG_OPTION_NON_VOLATILE, KEY_WRITE, lpSecurityAttributes, hKeyCopyright, dwDisposition) = ERROR_SUCCESS) Then
			 		'// Created the key or found an existing one:
					
		               '// Set the license key value value
					cvLength = Len(stringCopyrightValue$) + 1
					szKey$ = "CLSID\" & strCLSIDKeyValue$ & "\Copyright"
					If(RegSetValue(HKEY_CLASSES_ROOT, szKey$, REG_SZ,  stringCopyrightValue$, Clng(cvLength)) <> ERROR_SUCCESS) Then
						Messagebox "Error Setting Registry Value"
						
					End If
					
          		     '// Done
					notused = RegCloseKey(hKeyCopyright)
				End If
				
          		'// Done
				notused = RegCloseKey(hKeyMyCLSID)
			End If
			
	         '// Done
			notused = RegCloseKey(hKeyCLSIDTree)
		End If
		
		'// Done
		notused = RegCloseKey(hKeyControl)
	End If
	
	
End Sub