Post by turbov21 on Feb 17, 2008 22:04:28 GMT -5
An experimental prototype for a Run BASIC file-sharing server/client scheme. It's pretty useless right now, but I'm working on ideas how to integrate the concept into other programs.
' UPLOADLIST
'''''
' A good bit of this code was copied off the Run BASIC wiki.
' Props and credit to Alyce for her UploadAndMove demo:
' runbasic.wikispaces.com/UploadAndMove
'''''
global DefaultDir$, UpDir$, FullUpDir$, WebDir$, ErrorMsg$, xml$, domain$
UpDir$ = "uploads"
WebDir$ = "/" + UpDir$ + "/"
FullUpDir$ = DefaultDir$ + "\public\" + UpDir$
ErrorMsg$ = ""
domain$ = "http://kerovia.net:8008" + WebDir$
' Checks for and maybe makes a directory
' "made" is there, because "mkdir()" returns a boolean
made = mkdir(FullUpDir$)
FullUpDir$ = FullUpDir$ + "\"
titlebar "Upload"
[start]
cls
xml$ = ""
html "<div style=""width: 100%; text-align: center;""><h1>My Files</h1></div>"
html "<b>Files:</b><ul>"
files #ud, FullUpDir$ + "*.*"
while #ud hasanswer()
#ud nextfile$()
html "<li><a href=""" + WebDir$ + #ud name$() + """>" + #ud name$() + "</a></li>"
xml$ = xml$ + " <file name=""" + #ud name$() + """ url=""" + domain$ + #ud name$() + """ />" + cr$
wend
if xml$ <> "" then
xml$ = "<?xml version=""1.0"" encoding=""UTF-8""?>" + cr$ + "<files>" + cr$ + xml$ + "</files>"
else
xml$ = xml$ + "<?xml version=""1.0"" encoding=""UTF-8""?>" + cr$
xml$ = xml$ + "<files/>"
end if
list$ = DefaultDir$ + "\public\file.xml"
open list$ for output as #1
print #1, xml$
close #1
html "</ul><br/><b>Upload:</b>"
upload "Select an image file."; image$
if image$ = "" then
ErrorMsg$ = "No file uploaded"
goto [ErrorOut]
end if
open image$ for binary as #f
filedata$ = input$(#f, LOF(#f))
close #f
open FullUpDir$ + image$ for binary as #g
print #g, filedata$;
close #g
kill image$
goto [start]
[ErrorOut]
cls
print ErrorMsg$
end
' DOWNLOADLIST
'''''
global #sf
run "StrFunc", #sf
'''''
global SaveDir$, SaveToDir$, url$, DispMsg$, Dlimit$, list$
SaveDir$ = "dlpics"
SaveToDir$ = DefaultDir$ + "\public\" + SaveDir$
url$ = "http://kerovia.net:8008/file.xml"
Dlimit$ = "|||"
DispMsg$ = ""
' Checks for and maybe makes a directory
' "made" is there, because "mkdir()" returns a boolean
made = mkdir(SaveToDir$)
SaveToDir$ = SaveToDir$ + "\"
titlebar "DownloadList"
list$ = httpget$(url$)
if list$ <> "" then
Call DisplayList
else
Call ErrorMsg "Could not download list"
end if
' Generates a list of files
Sub DisplayList
cls
if DispMsg$ <> "" then
html DispMsg$
DispMsg$ = ""
end if
xmlparser #list, list$
for count = 1 to #list elementCount()
#file = #list #element(count)
temp$ = #file attribValue$("name") + Dlimit$ + #file attribValue$("url")
link #link, #file attribValue$("name"), DownloadFile
#link setkey(temp$)
print ""
next count
wait
End Sub
' Downloads the file
Sub DownloadFile dat$
dnam$ = #sf SplitStr$(Dlimit$, dat$, 1)
durl$ = #sf SplitStr$(Dlimit$, dat$, 2)
dl$ = httpget$(durl$)
if dl$ <> "" then
fullname$ = SaveToDir$ + dnam$
open fullname$ for binary as #dl
print #dl, dl$
close #dl
fullpath$ = "/" + SaveDir$ + "/" + dnam$
DispMsg$ = "<p><a href=""" + fullpath$ + """>" + dnam$ + "</a> has downladed.</p>"
Call DisplayList
else
Call ErrorMsg "Could now download file"
end if
End Sub
' Displays and error message and ends the program
Sub ErrorMsg msg$
print msg$
end
End Sub