YahASP! Web Portal

<% ' yahasp.asp - builds a yahoo like web directory ' by Larry Gold v1.1 19990503 ' Copyright (c) 2012 quinstreet.com LLC. All Rights Reserved. ' ' This program is free software; you can redistribute it and/or modify ' it under the terms of the GNU General Public License as published by ' the Free Software Foundation; either version 2 of the License, or ' (at your option) any later version ' ' This program is distributed in the hope that it will be useful, ' but WITHOUT ANY WARRANTY; without even the implied warranty of ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU General Public License for more details ' ' You should have recieved a copy of the GNU General Public License ' along with this program; if not write to the Free Software Foundation ' Inc, 59 Temple Place, Suite 330, Boston MA 02111-1307 USA ' ' Originally published and documented at https://www.webreference.com ' Contact larzgold@yahoo.com for all other uses %> YahASP! Web Portal

Please note, this is a STATIC archive of website webreference.com from 01 Oct 2018, cach3.com does not collect or store any user information, there is no "phishing" involved.

YahASP! portal v0.01

<% ' Constants Const datafile = "perlhoo.csv" Const rootdir = "d:\inetpub\wwwroot\perlhoo" Const new_datafile = "yahasp_new.csv" Const baseURL = "/yahasp/yahasp2.asp" Const website = "https://165.177.138.165" Sub Yahasp ' Dimension Variables dim dir, so, sd, f, fs, f1, fc, s, start, local, temp, temp2 ' Create MS FileSystemObject Set fs = CreateObject("Scripting.FileSystemObject") ' Set starting poing to the Directory in the URL + "\" start = Request("dir") + "\" ' Set the who directory ' Than check to see if the directory is the root + an additional '\' ' If it is, remove the additional '\' dir = rootdir + start if dir = rootdir + "\\" then dir = rootdir + "\" end if local = Replace(start, "\", " - ") %> Return to Top You are in the <% = Mid(local, 2, (Len(local)-3)) %>Category

Categories

<% ' Go through directory looking for other directories ' and print out only if it is a directory Set f = fs.GetFolder(dir) Set fc = f.SubFolders For Each f1 in fc 'Temp is the Actual File Name temp = f1.name 'Temp2 is the File name with underscores replace by spaces temp2 = Replace(temp, "_", " ") Response.write ("

" + temp2 +"
") next ' End of Directory Print out %>
Sites

<% ' This section reads the text file and prints out the sites. ' MS has a component for this, the FileSystemObject Dim whichfile, thisbreak, thisline, thislen Dim fs2, thisfile, thisone, A whichfile = dir + datafile Set fs2 = CreateObject("Scripting.FileSystemObject") set thisfile = fs2.OpenTextFile(whichfile, 1, True) 'Define the break to search thisbreak = chr(34) + chr(44) + chr(34) do while not thisfile.AtEndOfStream 'parse the string thisline = thisfile.readline thislen = Len(thisline) - 2 thisone = Mid(thisline, 2, thislen) thisone = Replace(thisone, thisbreak, "\") A = Split(thisone, "\") Response.write("

") Response.write(A(2) & " - " & A(3)) loop thisfile.Close set thisfile=nothing set fs=nothing %>

Home | Suggest Link <% End Sub Sub ShowForm() %>

Add a Resource to:

<% End Sub Sub SubmitForm() 'Get Information newURL = Request("url") newTitle = Request("title") newDesc = Request("description") newName = Request("name") newEmail = Request("email") Const ForReading = 1, ForWriting = 2, ForAppending = 8 Dim tFs, tF tFile = rootdir & "\" & new_datafile Set tFs = CreateObject("Scripting.FileSystemObject") Set tF = tFs.OpenTextFile(tFile, ForAppending, True) tF.Write newURL & "," & newTitle & "," & newDesc & "," & newName & "," & newEmail & vbCrLf tF.close %> TOP

Thank you for suggested addition to the YahASP category. While we do review all new site suggestions, we cannot guarantee that all submissions will be added. The following information will be sent to the directory editor:

URL:	<%= newURL %>
Title:	<%= newTitle %>
Description:	<%= newDesc %>
Your Name:	<%= newName %>
Your Email:	<%= newEmail %>

Return to:

Home | Suggest Link <% End Sub ' Main Select Case Request("type") Case "Form" Call ShowForm() Case "Submit" Call SubmitForm() Case Else Call Yahasp() End Select %>