RosettaCodeData/Task/Active-Directory-Search-for-a-user/Run-BASIC/active-directory-search-for-a-user.basic
2023-07-01 13:44:08 -04:00

107 lines
2.3 KiB
Text

' ---------------------------------------------
' Directory maintenance
' ---------------------------------------------
cr$ = chr$(13)
dirOf$ = "c:\*.*" ' get directory of
' -------------------------------------------
' Shell out directory
' -------------------------------------------
[dirShell]
cls
html "<table bgcolor=lightsteelblue><TR><TD id=wk></TD></TABLE>"
loc$ = strRep$(dirOf$,"*.*","")
x$ = shell$("dir ";dirOf$)
i = 1
while word$(x$,i,cr$) <> ""
a$ = word$(x$,i,cr$)
if trim$(a$) = "" then goto [next]
if left$(a$,1) = " " then goto [next]
if left$(a$,1) = cr$ then goto [next]
type$ = mid$(a$,26,3)
size$ = mid$(a$,30,9)
size$ = strRep$(size$,",","")
size = val(size$)
if type$ <> "DIR" and size = 0 then goto [next]
name$ = mid$(a$,40)
a$ = strRep$(a$,"<","[")
a$ = strRep$(a$,">","]")
html left$(a$,39)
link #ddir,name$, [doDir]
#ddir setkey(type$;"|";loc$;name$)
html "<BR>"
goto [next1]
[next]
print a$
[next1]
i = i + 1
wend
wait
[doDir]
type$ = word$(EventKey$,1,"|")
name$ = word$(EventKey$,2,"|")
if type$ = "DIR" then
dirOf$ = name$;"\*.*"
goto [dirShell]
end if
html "<script> document.getElementById('wk').innerHTML = '"
nname$ = strRep$(name$,"\","\\")
html "What do you want to do with ";nname$;"<BR>"
button #dofile, "Upload",[upload]
button #dofile, "Delete",[delete]
button #rename, "Rename",[rename]
button #view, "View", [view]
html "';</script>"
wait
[delete]
kill name$
goto [dirShell]
[view]
nname$ = strRep$(name$,"\","/")
print "File:";nname$
nname$ = mid$(nname$,3)
html "<EMBED SRC=""..";nname$;""">"
print "<EMBED SRC=""..";nname$;""">"
wait
[upload]
print "Upload File:";name$
files #f, name$
if #f HASANSWER() = 0 then
print "File: ";name$;" not found"
end if
' -------------------------------------
' load data to directory
' -------------------------------------
OPEN name$ FOR binary AS #f
filedata$ = input$(#f, LOF(#f))
CLOSE #f
print filedata$
wait
f$ = photoDir$;uploadId$
OPEN f$ FOR binary AS #f
PRINT #f, filedata$
CLOSE #f
wait
' --------------------------------
' string replace rep str with
' --------------------------------
FUNCTION strRep$(strRep$,rep$,with$)
ln = len(rep$)
k = instr(strRep$,rep$)
while k
strRep$ = left$(strRep$,k - 1) + with$ + mid$(strRep$,k + ln)
k = instr(strRep$,rep$)
WEND
END FUNCTION
end