<%@LCID=5130 %> <% ' ** Copyright 1999-2001 by John Martin d/b/a www.ANYPORTAL.com ** ' ** All Rights Reserved. ** ' ** ** ' ** This software is freeware and is not in the public domain. ** ' ** You are hereby granted the right to freely distribute this ** ' ** software as long as this copyright notice remains in place. ** ' ** ** ' ** Comments or suggestions? email: andmore@alief.com ** ' ** ** ' ** Date Remarks ** ' ** --------- ----------------------------------------------- ** ' ** 25 MAY 99 original ** ' ** 26 MAY 99 allow the script to run from a subdirectory ** ' ** 27 MAY 99 increase security use of cookie ** ' ** 03 JUN 99 fix UNIX html file record endings ** ' ** 07 JUN 99 fix spaces in file name problem ** ' ** 10 JUL 99 fix subdirectory problem with createimagetag ** ' ** 10 JUL 99 add create document/folder logic ** ' ** 11 JUL 99 fix spaces in file name, again ** ' ** 11 JUL 99 .cfm & .php3 now edit like .asp/.html, etc. ** ' ** 25 JUL 99 add interface to SA-FILEUP to upload files ** ' ** 25 AUG 99 recode authorization routine, allow no password ** ' ** 31 AUG 99 some cosmetic; integrate with email community ** ' ** 01 SEP 99 add link on detail page ** ' ** 05 SEP 99 add missing EndHTML on detail page ** ' ** 24 OCT 00 plug /../ hole ** ' ** 14 NOV 00 add Windows login security method ** ' ** 14 NOV 00 convert in-line HTML to response.write ** ' ** 14 NOV 00 improve shortcut parsing, clean-up link styles ** ' ** 10 APR 01 make more file types editable/listable ** ' ** 11 APR 01 add code to execute BAT and VBS files on server ** ' ** 11 APR 01 allow either SA-FILEUP or ASPSimpleUpload ** ' ** 07 JUN 01 add cut/paste textarea for img tags ** ' ** 07 JUN 01 fix typo ! for ' ** ' ** 12 JUN 01 fix missing IsEditable on detail page ** ' ** 11 OCT 01 implementación del código a TecnoMercadeo ** ' ** 11 OCT 01 Script Upload is now WORKING !!! ** Option Explicit ' universal variables (these undo the option explicit) Dim action Dim a,b,c,i,item,j Dim f,fso Dim arr,tstr ' security Dim gblPassword gblPassword = "tecnoadmin" 'your password here '^^^^------ NULL forces mandatory Windows login. Dim gblUpload 'Pick one: how to do upload? gblUpload = "Script" 'implementado por TecnoMercadeo. ' gblUpload = "ASPSimpleUpload" ' gblUpload = "SA-FILEUP" ' configuration Dim gblSiteName,gblSiteCode gblSiteName = Request.ServerVariables("SERVER_NAME") gblSiteCode = "" Dim gblNow 'server may not be local time gblNow = Now Dim gblFace,gblColor 'needs three quotes gblFace = """Arial, Helvetica, sans-serif""" gblColor = """#000066""" Dim gblRed,gblReverse gblRed = """#FF0000""" gblReverse = """#E0E0E0""" ' global variables Dim gblTitle,gblPageText gblTitle = "Administrador de Servidores - Tecnomercadeo." gblPageText = " " ' global constants Dim gblScriptName,gblRoot gblScriptName = Request.ServerVariables("Script_Name") gblScriptName = Mid(gblScriptName,InstrRev(gblScriptName,"/") + 1) gblRoot = Replace(Request.ServerVariables("Script_Name"),"/" & gblScriptName,"") '-- 'StartHTML Sub StartHTML response.write "Administrando " & gblSiteName & " con :: " & gblTitle & "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "
" & gblSiteName If Request.ServerVariables("LOGON_USER")="" Then Else response.write " (USUARIO: " & Request.ServerVariables("LOGON_USER") & ")" End If response.write "
 " & gblTitle & "
" & gblPageText & "
" & VBCRLF response.write "<" & "!" & "-- begin " & gblScriptName & " --" & ">" & VBCRLF response.write "<" & "!" & "-- ---------------------------------------------------------- --" & ">" & VBCRLF End Sub 'StartHTML '-- 'EndHTML Sub EndHTML response.write "<" & "!" & "-- ---------------------------------------------------------- --" & ">" & VBCRLF response.write "<" & "!" & "-- end " & gblScriptName & " --" & ">" & VBCRLF response.write "
" & gblSiteName If Request.ServerVariables("LOGON_USER")="" Then Else response.write " (USUARIO: " & Request.ServerVariables("LOGON_USER") & ")" End If response.write "
" & FormatDateTime(gblNow,1) & "   " & FormatDateTime(gblNow,3) & "" & VBCRLF response.write "
Código provisto por AnyPortal " & gblTitle & " © Derechos Reservados " & Year(gblNow) & " por www.AnyPortal.com
" & VBCRLF response.write "" & VBCRLF response.write VBCRLF End Sub 'EndHTML '-- ' Authorize Function Authorize Dim a,i,pw If _ (gblPassword="") OR _ (Request.Cookies(gblSiteCode & gblScriptName)=Condensation(SStr(gblPassword))) OR _ Request.ServerVariables("LOGON_USER")<>"" _ Then Authorize = TRUE Else If Request.QueryString("w")="y" AND Request.ServerVariables("LOGON_USER")="" Then Response.Status = "401 Access Denied" StartHTML response.write "
" response.write "Acceso Denegado." response.write "
Disculpe, pero el usuario/clave que digitó
no fue reconocido por el servidor de " & gblSiteName & ". " & VBCRLF response.write "

Contacte a su administrador del sitio para más infromación." & VBCRLF response.write "

" & VBCRLF EndHTML Response.End End If Authorize = FALSE pw = Request.Form("password") a = Condensation(pw) If pw<>"" OR Request.Form("OK")<>"" Then If pw = gblPassword Then ' cookie expires when browser is closed... Response.Cookies(gblSiteCode & gblScriptName) = a ' set a permanent one to never see this page again If Request.Form("SAVE") = "on" Then Response.Cookies(gblSiteCode & gblScriptName).Expires = gblNow+30 Response.Redirect gblScriptName & "?d=" Else gblPageText = gblPageText & "Contraseña Inválida." End If End If If Request.ServerVariables("SERVER_SOFTWARE")>="Microsoft-IIS/4.0" Then StartHTML response.write "
" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "
Contraseña:" & VBCRLF response.write "   ¿Almacenar Contraseña?" & VBCRLF response.write "
" response.write "" & chr(255) & " ¿Desea usar el login de Windows.
" & VBCRLF response.write VBCRLF Else gblPageText = "Su servidor web se ha identificado a sí mismo como un """ & Request.ServerVariables("SERVER_SOFTWARE") & """." StartHTML response.write "
Disculpe.

" & VBCRLF response.write "TecnoAdmin " & gblTitle & " requiere Microsoft NT/2000, Internet Information Server (IIS) 4.0 or superior." & VBCRLF response.write "

" & VBCRLF End If EndHTML End If End Function 'Authorize '-- ' Condensation Function Condensation(s) a = 0 For i = 1 to len(s) a = (ASC(mid(s,i,1))+a*2) Mod 77411 Next 'i Condensation = Right("00000" & Cstr(a),5) & Right("00000" & Cstr((len(s)*23)+25433),5) End Function 'Condensation(s) '-- ' CreateImageTag Function CreateImageTag(fn,altstr,align,border) Dim f,fso,pn Dim tstr,alignstr,borderstr Dim chars,hw,width,height If border="" Then borderstr = " BORDER=0" Else borderstr = " BORDER=" & Cstr(border) End If If align="" Then alignstr = "" Else alignstr = " ALIGN=""" Select Case UCase(left(align,1)) Case "L" tstr = "LEFT" Case "R" tstr = "RIGHT" Case "C" tstr = "CENTER" Case Else End Select alignstr = " ALIGN=""" & tstr & """" End If Set fso = CreateObject("Scripting.FileSystemObject") pn = Server.MapPath(fn) tstr = "" Set f = fso.OpenTextFile(pn) Select Case UCase(Right(fn,4)) Case ".GIF",".JPG" If NOT f.AtEndOfStream Then If UCase(Right(fn,4))=".GIF" Then 'always works chars = f.read(10) width = asc(mid(chars,8,1))*256 + asc(mid(chars,7,1)) height = asc(mid(chars,10,1))*256 + asc(mid(chars,9,1)) hw = " WIDTH=" & width & " HEIGHT=" & height Else 'usually works chars = f.read(200) height = asc(mid(chars,164,1))*256 + asc(mid(chars,165,1)) width = asc(mid(chars,166,1))*256 + asc(mid(chars,167,1)) If (height>600) OR (height<3) OR (WIDTH<3) OR (WIDTH>600) Then ' could be wrong height, width... forget 'em Else hw = " WIDTH=" & width & " HEIGHT=" & height End If End If End If tstr = "" End Select f.Close Set f = Nothing Set fso = Nothing CreateImageTag = tstr End Function 'CreateImageTag '-- ' DetailPage Sub DetailPage Dim chars,fstr,hw,height,width Dim IsTextFile,pathname Dim fsize,fdatecreated,fdatelastmodified pathname = Lcase(fsDir & fn) If right(pathname,1)="\" Then pathname = Left(pathname,len(pathname)-1) If fso.FolderExists(pathname) Then response.redirect gblScriptName & "?d=" & URLSpace(pathname) & "\" End If ' create if you gotta If fso.FileExists(pathname) Then Else Select Case UCase(Request.QueryString("T")) Case "D" 'create document Set f = fso.CreateTextFile(pathname) f.Close Set f= Nothing Case "F" 'create folder Set f = fso.CreateFolder(pathname) pathname = pathname & "\" response.redirect gblScriptName & "?d=" & URLSpace(pathname) End Select End If StartHTML response.write "

" & pathname & "
" & VBCRLF response.write "" & webbase & fn & "
" & VBCRLF If fso.FileExists(pathname) Then ' fetch Window's file information Set f = fso.GetFile(pathname) fsize = f.size fdatecreated = f.datecreated fdatelastmodified = f.datelastmodified response.write "

" & VBCRLF
		response.write "Tamaño del archivo:  " & FormatNumber(fsize,0) & " caracteres" & VBCRLF
		response.write "Archivo creado:  " & FormatDateTime(fdatecreated,1) & "  " & FormatDateTime(fdatecreated,3) & VBCRLF
		response.write "Última modificación:  " & FormatDateTime(fdatelastmodified,1) & "  " & FormatDateTime(fdatelastmodified,3) & VBCRLF
		response.write "
" & VBCRLF Set f = Nothing End If response.write "
" & VBCRLF response.write "" & VBCRLF IsTextFile = FALSE Select Case UCase(Right(fn,4)) Case ".GIF",".JPG" tstr = CreateImageTag(basedir & fn,fn & " (" & FormatNumber(Int(fsize/1024*10+.05)/10,1) & " Kb)","",0) response.write "
CORTE Y PEGUE ESTA ETIQUETA IMG

" & tstr & "
" & VBCRLF Case ".URL" Set f = fso.OpenTextFile(pathname) If NOT f.AtEndOfStream Then tstr = f.readall f.Close Set f = Nothing response.write "" & VBCRLF response.write Replace(Server.HTMLEncode(tstr),VBCRLF,VBCRLF & "
") response.write "
" & VBCRLF Case Else If IsEditable(fn) Then 'read the file Set f = fso.OpenTextFile(pathname) If NOT f.AtEndOfStream Then fstr = f.readall f.Close Set f = Nothing Set fso = Nothing IsTextFile = TRUE response.write "
" & VBCRLF response.write "CONTENIDO DEL DOCUMENTO
" & VBCRLF response.write "" & VBCRLF response.write "
" & VBCRLF End If End Select response.write VBCRLF & "

" & VBCRLF If IsTextFile Then response.write "" & VBCRLF response.write " " & VBCRLF response.write "
" & VBCRLF Else response.write "" & VBCRLF response.write "
" & VBCRLF End If response.write "
¿ELIMINAR """ & UCase(fn) & """? " & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "
" & VBCRLF EndHTML End Sub 'DetailPage '-- ' DisplayCode Sub DisplayCode Dim fn,fso,f Dim code,tstr Dim a,arr,i fn = Request.QueryString("c") response.write "" & fn & "" & VBCRLF response.write "" & VBCRLF If Instr(fn,fsroot)=1 Then Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.OpenTextFile(fn, 1, 0, 0) If f.AtEndOfStream Then code = "" Else code = f.ReadAll End If response.write "
" & VBCRLF response.write " " & fn & "
" & VBCRLF ' quickly format code for readability... ' could be smarter, but it sure is simple! tstr = Server.HTMLEncode(code) tstr = Replace(tstr,chr(9)," ") If len(fn)>3 Then Select Case lcase(Mid(fn,InstrRev(fn,".")+1)) Case "asa","asp","aspx","htm","html","shtm","shtml","php","php3" tstr = Replace(tstr," ","  ") tstr = Replace(tstr,"<%","<" & "%") tstr = Replace(tstr,"%>","%" & ">") tstr = Replace(tstr,"<!--","<!--") tstr = Replace(tstr,"-->","-->") response.write "" & VBCRLF Case Else response.write "" & VBCRLF End Select End If response.write "" & VBCRLF & VBCRLF arr = Split(Replace(tstr,chr(13),""),chr(10)) 'handle unix/linux files, too For i = 0 to UBound(arr) ' add line numbers and output response.write "
" & Right("000" & i+1,4) & ": " tstr = arr(i) If left(Replace(Replace(tstr," ","")," " ,""),1)="'" Then response.write "" & tstr & "" & VBCRLF Else response.write tstr & VBCRLF End If Next 'i response.write VBCRLF & "" & VBCRLF response.write "
" & VBCRLF Else response.write "

Cannot access " & fn & "" & VBCRLF End If response.write "


" End Sub 'DisplayCode '-- ' DisplayFileName Sub DisplayFileName(dirfile,fhandle) Dim newgif,linktarget,execlink Dim fsize execlink = "" response.write "" & VBCRLF If dirFile="DIR" Then linktarget = "" tstr = "" & linktarget & LCase(fhandle.name) & "" response.write "" & MockIcon("fldr") & "" & VBCRLF response.write "" & Tstr & "" & VBCRLF Else newgif = "" If fhandle.datelastmodified+14>gblNow Then newgif = MockIcon("newicon") b = "" If len(fhandle.name)>4 Then b = Ucase(Right(fhandle.name,4)) If Left(b,1) = "." Then b = Right(b,3) Select Case b Case "VBS","BAT" execlink = "" & LCase(fhandle.name) & "" End Select Select Case b Case "URL" tstr = ShortCutURL Case Else If IsEditable(fhandle.name) Then newgif = newgif & " " & MockIcon("view") & "" tstr = webbase & replace(fhandle.name," ","%20") End Select If fhandle.size<10240 Then If fhandle.size=0 Then fsize = "0" Else fsize = FormatNumber(fhandle.size,0,0,-2) End If Else fsize = FormatNumber((fhandle.size+1023)/1024,0,0,-2) & "K" End If If execlink="" Then tstr = "" & LCase(fhandle.name) & "" & newgif Else tstr = "" & execlink & "" & newgif End If response.write "" & MockIcon(b) & "" & VBCRLF response.write "" & Tstr & "" & VBCRLF response.write "" & FormatDateTime(fhandle.datelastmodified,0) & "" & VBCRLF response.write "" & fsize & " bytes" & VBCRLF End If response.write "" & VBCRLF End Sub 'DisplayFileName '-- ' IsEditable Function IsEditable(pn) Dim rt If len(pn)>3 Then rt = TRUE Select Case lcase(Mid(pn,InstrRev(pn,".")+1)) ' Wanna make a file editable and listable? ' Just add the extension to any of these lists (all lower case!) Case "asa","asp","aspx","css","htm","html","js","shtm","shtml" Case "cfm","jsp","php3","php4" Case "bat","inc","ini","log","txt","url","vbs" Case "c","cpp","h","src","tag" Case "loc","out","sql" Case Else rt = FALSE End Select Else rt = FALSE End If IsEditable = rt End Function 'IsEditable '-- ' MockIcon (icon emulator) Function MockIcon(txt) Dim tstr,d ' Sorry, mac/linux users. tstr = "" Select Case Lcase(txt) Case "bmp","gif","jpg","tif","jpeg","tiff" d = 176 Case "doc" d = 50 Case "exe","bat","bas","c","src","vbs" d = 255 Case "file" d = 51 Case "fldr" d = 48 Case "htm","html","asa","asp","cfm","php3","php" d = 182 Case "pdf" d = 38 Case "xls" d = 252 Case "zip","arc","sit" d = 59 Case "newicon" tstr = "" d = 171 Case "view" d = 52 Case Else If IsEditable("." & txt) Then d = 52 Else d = 51 End If End Select tstr = tstr & Chr(d) & "" MockIcon = tstr End Function 'mockicon '-- ' Navigate Sub Navigate Dim emptyDir emptyDir = TRUE response.write "" ' get the directory of file names If toplevel Then parent = "" Else parent = fso.GetParentFolderName(fsDir) & "\" response.write "" & VBCRLF response.write "" & VBCRLF End If Set f = fso.GetFolder(fsDir) Set FileList = f.subFolders a = 0 For Each fn in FileList emptyDir = FALSE If a = 0 Then a = 1 response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF End If DisplayFileName "DIR",fn Next 'fn response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF response.write "" & VBCRLF Set filelist = f.Files For Each fn in filelist emptyDir = FALSE DisplayFileName "FILE",fn Next 'fn If emptyDir Then response.write " " & VBCRLF response.write " " & VBCRLF End If response.write "" & VBCRLF response.write " " & VBCRLF response.write " " & VBCRLF response.write "
" & chr(199) & "" & UCASE(fso.GetParentfolderName(fsDir) & "\") & "
 
Carpetas Adicionales
 NOMBRE DE LA CARPETA
 
" & fsDir & "
 NOMBRE DEL ARCHIVOÚLTIMA MODIFICACIÓNTAMAÑO
" & VBCRLF response.write " " & VBCRLF response.write " " & VBCRLF response.write "   ¿PUEDO ELIMINAR ESTA CARPETA VACÍA? " & VBCRLF response.write "  " & VBCRLF response.write " " & VBCRLF response.write "

" & VBCRLF response.write "   CREAR " & VBCRLF response.write " DOCUMENTO" & VBCRLF response.write " O " & VBCRLF response.write " CARPETA:  " & VBCRLF response.write "   NOMBRE  " & VBCRLF response.write "  " & VBCRLF response.write " " & VBCRLF response.write " " & VBCRLF If gblUpload<>"" Then response.write "   O HAGA UN UPLOAD USANDO " & gblUpLoad & "" & VBCRLF response.write "
" & VBCRLF End Sub 'Navigate '-- ' RunVBSCode Sub RunVBSCode Dim fn,fso,f Dim code,tstr Dim a,arr,i Dim wshShell,outFile,batFile Dim runWait If Request.QueryString("t")="" Then Server.ScriptTimeout = 2*60 '2 minutes Else Server.ScriptTimeout = Request.QueryString("t")*60 'convert to minutes End If fn = Request.QueryString("x") response.write "" & fn & "" & VBCRLF response.write "
" & VBCRLF response.write " " & fn & "
" & VBCRLF & VBCRLF response.write "

" & VBCRLF If Instr(fn,fsroot)=1 Then Set fso = CreateObject("Scripting.FileSystemObject") Set wshShell = Server.CreateObject("Wscript.Shell") If LCase(Mid(fn,InstrRev(fn,".") + 1)) = "bat" Then batFile = fn runWait = FALSE Else batFile = replace(fsroot & fso.GetTempName,".tmp",".bat") Set f = fso.CreateTextFile(batFile) outFile = fsroot & fso.GetTempName tstr = "cscript " & fn & " > " & outFile f.Write tstr & VBCRLF f.Close runWait = TRUE End If Response.Write "" & VBCRLF a = wshShell.Run(batFile,1,runWait) If runWait Then If fso.FileExists(outFile) Then Set f = fso.OpenTextFile(outFile, 1, 0, 0) If f.AtEndOfStream Then Else code = f.ReadAll Response.Write replace(replace(code," ","  "),VBCRLF,"
" & VBCRLF) & VBCRLF End If f.Close Set f = fso.GetFile(outFile) f.delete Set f = nothing Else Response.Write "Completado con el código=" & a & "." & VBCRLF & "No hay archivo de salida." & VBCRLF End If If fso.FileExists(batFile) Then Set f = fso.GetFile(batFile) f.delete Set f = nothing End If Else Response.Write "Proceso por lotes (Batch) iniciado" & VBCRLF & FormatDateTime(gblNow,1) & " " & FormatDateTime(gblNow,3) & VBCRLF End If Else Response.Write "No se puede ejecutar " & fn & VBCRLF End If response.write "
" & VBCRLF EndHTML End Sub 'RunVBSCode '-- ' ShortCutURL Function ShortCutURL Dim f,fstr,tstr tstr = "" Set f = fso.OpenTextFile(fn) Do While NOT f.AtEndOfStream tstr = f.readline If len(tstr)<7 Then Else If left(lcase(tstr),4)="url=" Then fstr = tstr End If End If Loop f.Close Set f= Nothing If fstr = "" Then ShortCutURL = fn Else ShortCutURL = Replace(mid(fstr,5,255)," ","%20") End If End Function 'ShortCutURL '-- ' SStr (force null to "") Function SStr(v) Dim rt If IsNull(v) Then rt = "" Else rt = Trim(Cstr(v)) End If SStr = rt End Function 'sstr '-- ' UploadPage Sub UploadPage StartHTML response.write "

" & VBCRLF response.write "
" & VBCRLF response.write "
" & VBCRLF response.write "FOLDER DESTINO EN EL SITIO WEB
" & VBCRLF response.write "" & fsDir & "

" & VBCRLF response.write "RUTA LOCAL DEL DOCUMENTO
(ENVIAR ESTE ARCHIVO AL SERVIDOR WEB)

" & VBCRLF response.write "  " & VBCRLF response.write "" & VBCRLF response.write "

Si el botón [BROWSE...] no aparece desplegado en su computador," & VBCRLF response.write "
debe actualizar si versión de Netscape" & VBCRLF response.write "o de Internet Explorer." & VBCRLF response.write "

" & VBCRLF response.write "

Su navegador es :
Agente(HTTP_USER_AGENT): " & Request.ServerVariables("HTTP_USER_AGENT") & "" & VBCRLF Select Case gblUpLoad Case "SA-FILEUP" 'No lo vamos a usar response.write "

Upload also requires that the SA-FileUp object is registered on your web server.
" Case "ASPSimpleUpload" 'No lo vamos a usar response.write "

Upload also requires that the ASPSimpleUpload object is registered on your web server.
" Case "Script" response.write "

El Upload utilizará código propio.
Puede encontrar que el objeto ASPSimpleUpload (gratuito) o el objeto SA-FileUp object (pagado) puede tener un mejor desempeño.
" Case Else End Select response.write "
" & VBCRLF response.write "

" & VBCRLF response.write "
" & VBCRLF If gblUpload="Script" Then Else response.write "¿NO TIENE EL OBJETO " & gblUpload & " INSTALADO?
LO SIENTO! PRESIONE AQUI...

" & VBCRLF response.write "" & VBCRLF End If response.write "
" & VBCRLF response.write "

" & VBCRLF EndHTML End Sub 'UploadPage '-- ' URLspace Function URLSpace(s) URLSpace = replace(replace(s,"+","%2B")," ","+") End Function 'URLSpace '---- 'MAIN '---- Dim filelist,fn,upl Dim TextObject,fhandle,lsplit Dim fsDir,baseDir,webbase Dim fsRoot,webRoot Dim pathname,parent,toplevel gblTitle = "TECNO-admin" If NOT Authorize Then ' function will output HTML for password Else ' initialization Set fso = CreateObject("Scripting.FileSystemObject") ' dynamically find out where the documents and web pages are located fsDir = replace(LCase(replace(Request.QueryString("d"),"..",".")),"/.","/") If fsDir="" Then fsDir = Request.Form("fsDir") fsRoot = LCase(Replace(Server.MapPath(gblScriptName),"\" & gblScriptName,"") & "\") If Instr(fsdir,fsroot)<>1 Then fsDir = fsRoot If Lcase(fsDir)=Lcase(fsRoot) Then toplevel = TRUE basedir = Replace(Mid(fsDir,len(fsRoot),250),"\","/") webRoot = "http://" & Request.ServerVariables("SERVER_NAME") & Replace(Request.ServerVariables("SCRIPT_NAME"),"/" & gblScriptName,"") webbase = replace(webroot & basedir," ","%20") ' process a GET/POST request If Request.QueryString("u")="D" Then Action = "UPLOAD" Else Action = Request.Form("POSTACTION") pathname = Request.Form("PATHNAME") End If Select Case UCase(Action) Case "UPLOAD" Select Case gblUpload Case "SA-FILEUP" Set upl = Server.CreateObject("SoftArtisans.FileUp") tstr = Mid(upl.UserFilename, InstrRev(upl.UserFilename, "\") + 1) If tstr = "" Then Else upl.SaveAs fsdir & tstr End If Case "ASPSimpleUpload" Set upl = Server.CreateObject("ASPSimpleUpload.Upload") If Len(upl.Form("f1")) > 0 Then tstr = fsdir & upl.ExtractFileName(upl.Form("f1")) tstr = Mid(tstr,len(fsroot)) tstr = upl.SaveToWeb("f1", tstr) End If Case "Script" Dim objUpload, lngLoop If Request.TotalBytes > 0 Then Set objUpload = New clsUpload For lngLoop = 0 to objUpload.Files.Count - 1 'If accessing this page annonymously, 'the internet guest account must have 'write permission to the path below. objUpload.Files.Item(lngLoop).Save fsdir Next End If Case Else End Select Case "SAVE" If IsEditable(pathname) Then If Instr(pathname,fsroot) = 1 Then Set f = fso.CreateTextFile(pathname) f.write Request.Form("FILEDATA") f.close End If End If Case "DELETE" 'either document or folder If Request.Form("OK") = "on" Then parent = Request.Form("Parent") If Instr(pathname,fsroot) = 1 Then fso.DeleteFolder Left(pathname,Len(pathname)-1),TRUE response.redirect gblScriptName & "?d=" & URLSpace(parent) End If End If If Request.Form("DELETEOK") = "on" Then If Instr(pathname,fsroot) = 1 Then If fso.FileExists(Request.Form("PathName")) Then Set f = fso.GetFile(Request.Form("PathName")) f.delete End If End If End If End Select If Action="" Then Else tstr = gblScriptName & "?d=" If NOT toplevel Then tstr = tstr & URLSpace(fsDir) response.redirect tstr End If ' check for mode... navigate, code display, upload, or detail? fn = LCase(Request.QueryString("f")) If fn="" Then If Request.QueryString("u")="Y" Then gblTitle = gblTitle & " (Upload Page)" gblPageText = "Utilice esta página para hacer un upload de cualquier archivo a este sitio web." UploadPage Else If Request.QueryString("c")="" Then If Request.QueryString("x")="" Then gblPageText = "Utilice esta página para agregar, eliminar o revisar documentos en este sitio web." StartHTML Navigate EndHTML Else RunVBSCode End If Else DisplayCode End If End If Else gblTitle = gblTitle & " (Página Detalle)" gblPageText = "Utilice esta página para ver, modificar o elminar cualquier documento ded este sitio web." DetailPage End If End If %>