Yahasp | 4 | WebReference

Yahasp | 4

Yahasp Source
1  <%
2  ' yahasp.asp - builds a yahoo like web directory
3  ' by Larry Gold v1.1 19990503
4  ' Copyright (c) internet.com. All Rights Reserved
5  '
6  ' This program is free software; you can redistribute it and/or modify
7  ' it under the terms of the GNU General Public License as published by
8  ' the Free Software Foundation; either version 2 of the License, or 
9  ' (at your option) any later version
10  '
11  ' This program is distributed in the hope that it will be useful,
12  ' but WITHOUT ANY WARRANTY; without even the implied warranty of
13  ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14  ' GNU General Public License for more details
15  '
16  ' You should have recieved a copy of the GNU General Public License
17  ' along with this program; if not write to the Free Software Foundation
18  ' Inc, 59 Temple Place, Suite 330, Boston MA 02111-1307 USA
19  '
20  ' Originally published and documented at https://www.webreference.com
21  ' Contact [email protected] for all other uses
22  %>
23  
24  
25  <HTML>
26  <HEAD>
27          <TITLE>YahASP! Web Portal</TITLE>
28  </HEAD>
29  <BODY>
30  
31  <h2>YahASP! portal v0.01</h2>
32  
33  <% 
34  ' Constants
35  Const datafile      = "perlhoo.csv"
36  Const rootdir       = "d:\inetpub\wwwroot\perlhoo"
37  Const new_datafile  = "yahasp_new.csv"
38  Const baseURL       = "/yahasp/yahasp2.asp"
39  Const website       = "https://165.177.138.165"
40  
41  Sub Yahasp
42  	' Dimension Variables
43  	dim dir, so, sd, f, fs, f1, fc, s, start, local, temp,  temp2
44  	' Create MS FileSystemObject
45  	Set fs = CreateObject("Scripting.FileSystemObject")
46  	' Set starting poing to the Directory in the URL + "\"
47  	start = Request("dir") + "\"
48  	' Set the who directory
49  	' Than check to see if the directory is the root + an additional '\'
50  	' If it is, remove the additional '\'
51  	dir = rootdir + start
52  	if dir = rootdir + "\\" then
53          	dir = rootdir + "\"
54  	end if
55  	local = Replace(start, "\", " - ")
56  	%>
57  	<a href="<%= website %><%= baseURL%>">Return to Top</a>&nbsp;&nbsp;&nbsp You are in the <b><% = Mid(local, 2, (Len(local)-3)) %></b>Category
58  	<br><br>
59  
60  	Categories
61  	<hr>
62  	<%
63  	' Go through directory looking for other directories
64  	' and print out only if it is a directory
65  	Set f = fs.GetFolder(dir)
66  	Set fc = f.SubFolders
67  	For Each f1 in fc
68  		'Temp is the Actual File Name
69          	temp = f1.name
70  		'Temp2 is the File name with underscores replace by spaces
71          	temp2 = Replace(temp, "_", " ")
72  	        Response.write ("<li><a href='" & website & baseURL & "?dir=") 
73          	Response.write ( start + temp + "&type='><b>" + temp2 +"</b></a><br>")
74  	next
75  	' End of Directory Print out
76  	%>
77  
78  	<br>
79  	Sites
80  	<hr>
81  	<%
82  	' This section reads the text file and prints out the sites.
83  	' MS has a component for this, the FileSystemObject
84  	Dim whichfile, thisbreak, thisline, thislen
85  	Dim fs2, thisfile, thisone, A
86  	whichfile = dir + datafile
87  	Set fs2 = CreateObject("Scripting.FileSystemObject")
88  	set thisfile = fs2.OpenTextFile(whichfile, 1, True)
89  	'Define the break to search
90  	thisbreak = chr(34) + chr(44) + chr(34)
91  	do while not thisfile.AtEndOfStream
92  	        'parse the string
93  	        thisline = thisfile.readline
94          	thislen  = Len(thisline) - 2
95  	        thisone  = Mid(thisline, 2, thislen)
96          	thisone  = Replace(thisone, thisbreak, "\")
97  	        A        = Split(thisone, "\")
98  		Response.write("<li><a href='"  & A(0) & "' target='" & A(1) & "'>")
99  	        Response.write(A(2) & "</a> - " & A(3))
100  	loop
101  
102  	thisfile.Close
103  	set thisfile=nothing
104  	set fs=nothing
105  	%>
106  	<HR>
107  	<center><a href="<%= website %><%= baseURL%>">Home </a> | <a href="<%= website %><%= baseURL%>?type=Form">Suggest Link</a>
108  	</center>
109  	<%
110  End Sub
111  
112  Sub ShowForm()
113  	%>
114  	
115  	<p><H3>Add a Resource to: </H3><HR noshade>
116  	<form action="<%= website %><%= baseURL%>" method="GET">
117  	<input type="hidden" name="keywords" value="add">
118  	<input type="hidden" name="type" value="Submit">
119  	<table border="0" cellpadding="2" cellspacing="2">
120  	<tr><td align="right"><B>URL:</B></td><td><input name="url" size="40"></td></tr>
121  	<tr><td align="right"><B>Title:</B></td><td><input name="title" size="40"></td></tr>
122  	<tr><td align="right"><B>Description:</B></td><td><textarea name="description" rows="3" cols="40"></textarea></td></tr>
123  	<tr><td align="right"><B>Your Name:</B></td><td><input name="name" size="40"></td></tr>
124  	<tr><td align="right"><B>Your Email:</B></td><td><input name="email" size="40"></td></tr>
125  	<tr><td></td><td><input type="submit" value=" Submit Resource ">
126  	<input type="reset" value=" Reset "></td></tr>
127  	</table>
128  	<HR noshade>
129  	</form>
130  	<%
131  End Sub
132  
133  Sub SubmitForm()
134  	'Get Information
135  	newURL   = Request("url")
136  	newTitle = Request("title")
137  	newDesc  = Request("description")
138  	newName  = Request("name")
139  	newEmail = Request("email")
140  
141  	Const ForReading = 1, ForWriting = 2, ForAppending = 8
142  	Dim tFs, tF
143  	tFile   = rootdir & "\" & new_datafile
144  	Set tFs = CreateObject("Scripting.FileSystemObject")
145  	Set tF  = tFs.OpenTextFile(tFile, ForAppending, True)
146  	tF.Write newURL & "," & newTitle & "," & newDesc & "," & newName & "," & newEmail & vbCrLf
147  	tF.close
148  
149  	%>
150  	<a href="<%= website %><%= baseURL%>">TOP </a>
151  	<br><hr>
152  	Thank you for suggested addition to the YahASP category.  While we do review all new site 
153  	suggestions, we cannot guarantee that all submissions will be added.  The following information
154  	will be sent to the directory editor:
155  	<br><Br>
156  	<table>
157  		<tr><td align=right><b>URL:</b></td>
158  		    <td><%= newURL %></td></tr>
159  
160  		<tr><td align=right><b>Title:</b></td>
161  		    <td><%= newTitle %></td></tr>
162  
163  		<tr><td align=right><b>Description:</b></td>
164  		    <td><%= newDesc %></td></tr>
165  
166  		<tr><td align=right><b>Your Name:</b></td>
167  		    <td><%= newName %></td></tr>
168  
169  		<tr><td align=right><b>Your Email:</b></td>
170  		    <td><%= newEmail %></td></tr>
171  	</table>
172  	Return to:<br><hr>
173  	<center><a href="<%= website %><%= baseURL%>">Home </a> | <a href="<%= website %><%= baseURL%>?type=Form">Suggest Link</a>
174  	</center>
175  	<%
176  End Sub
177  
178  ' Main
179  Select Case Request("type")
180  Case "Form"
181  	Call ShowForm()
182  Case "Submit"
183  	Call SubmitForm()
184  Case Else
185  	Call Yahasp()
186  End Select
187  %>
188  </body>
189  </html>

https://www.internet.com

Produced by Jonathan Eisenzopf and
Created: April 19, 1999
Revised: April 20, 1999

URL: https://www.webreference.com/perl/tutorial/4/