[ALLY] Double Popup (window)
From: greg_piney::mcgraw-hill::com at: 26-Apr-2001 12:19
I guess after my first post, since the example wou't run, I would post
the entire script. The very first window, a login screen, is displayed
twice for no apparent reason. I should go away after good
authentication. It did under the old version of /View.
Here it is:
REBOL [
Title: "Standard and Poor's FTP Administration"
File: %myfirst.r
Purpose: {A Learning Experience.}
]
ftpadm: ""
ckpw: ""
enduser-ipnum: :system/network/host-address
user-function: "authenticate"
ckok: false
check-admin-logon: func [] [
admin-list: read/lines %admpw.conf
foreach line admin-list [
if find line ftpadm [
set [admin-usr
admin-pass
admin-ip
admin-site
admin-root] parse line none
if ckpw = admin-pw[
admusr-ok: true ]
return
]
]
]
check-admin2: func[] [
call-server: open/lines tcp://151.108.66.42:5999
nudata: reduce [ rejoin [
user-function" " ftpadm" "ckpw
]
]
insert call-server nudata
response: first call-server
close call-server
set [admin-ok
admin-usr
admin-site
admin-root
admin-ip] parse response none
]
my-styles: stylize [
txt12: text [font: [color: yellow shadow: none]]
txt16: txt12 [font: [size: 16]]
name: txt12 [size: 100x24 font: [align: 'right]]
namv: txt12 [size: none]
inp: field [size: none]
password: field [size: none]
]
main-window: func[] [
layout [
styles my-styles
subtitle "S&P FTP Admin"
across
label "Admin User: "
t1: txt12 "xxxxxxxx" return
label "Site: "
t2: txt12 "xxxxxxxxxxxxxxxxxxxxxxxxxx" return
label "Subdirectory: "
t3: txt12 "xxxxxxxxxxxxxxxx" return
label "Server: "
t4: txt12 "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" return
below
box 200x2 effect [gradient 1x0 100.100.100]
button "Check User" 80x30 [show-check ]
button "New User" 80x30 [show-newuser ]
button "Suspend User" 80x30 [ show-suspend]
button "Change a Password" 80x30 [show-change]
button "Delete a User" 80x30 [show-delete]
button "Quit" 80x30 #"^Q" [quit]
]
]
login-popup: func[] [view dialog: layout [
styles my-styles
subtitle "FTP Administrator Login"
across
name "Login: " admin-name: inp 100x24
button "OK!" [ftpadm: admin-name/text
print reduce [ "pw = " admin-pw/data ]
ckpw: admin-pw/data
check-admin2
if admin-ok = "true" [
unview/only dialog
show-main
return]
login-popup ]
return
name "Password:" admin-pw: password hide 100x24
across
button "Cancel" [quit ]
]
]
show-main: func[] [
print reduce [admin-name/text admin-pw/data]
new-main-window: make main-window [ do [
t1/text: admin-usr
t2/text: admin-site
t3/text: admin-root
t4/text: admin-ip
]
]
view/new new-main-window
]
show-newuser: func[] [
new-newuser-window: make newuser-window [ do [
t2/text: admin-site
]
]
view/new/offset new-newuser-window 250x50
]
newuser-window: func [] [
layout [
styles my-styles
size 450x400
subtitle "Create a New User"
across
txt16 bold italic "Create for site: "
t2: txt16 bold "xxxxxxxxxxxxxxxxxxxxxxxxxx" return
indent 40
txt12 bold italic "Note: ALL fields are required." return
across
guide 4x120
name "UserName:" uname: inp 75x24 return
name "Group: " ugroup: inp 75x24
text "Default is UserName"
return
name "Comment: " ucomt: inp 200x24 return
name "Shell Type: " shell1: choice "/nosuchshell" data ["/nosuchshell"
/bin/ksh
"/bin/sh"]
text "(Use /nosuchshell for FTP Only users)"
return
name "Password:" upass1: password hide 70x24 return
name "Again: " upass2: password hide 70x24
at 0x330 indent 10
button "OK" [check-newu-fields
send-newu-stuff
unview]
button "Apply" [check-newu-fields]
button "Reset" [clear-all-newu]
button "Quit" [unview]
]
]
show-check: func[] [
new-check-window: make check-window [ do [
t2/text: admin-site
]
]
view/new/offset new-check-window 250x50
]
check-window: func[] [
layout [
styles my-styles
size 300x200
subtitle "Check a User"
below
txt16 bold "Check to see if a UserName is already taken" return
across
txt12 bold italic "Note: ALL fields are required." return
across
guide 4x120
name "UserName:" uname: inp 75x24 return
at 0x160 indent 70
button "Check" 50x30 [check-chku-fields
send-chku-stuff
unview]
button "Reset" 50x30 [clear-all-newu]
button "Quit" 40x30 [unview]
]
]
show-suspend: func[] [
new-suspend-window: make suspend-window [ do [
t2/text: admin-site
]
]
view/new/offset new-suspend-window 250x50
]
suspend-window: func[] [
layout [
styles my-styles
size 300x200
subtitle "Suspend a User"
below
txt16 bold "Suspend for site: "
t2: txt16 bold "xxxxxxxxxxxxxxxxxxxxxxxxxx" return
indent 40
txt12 bold italic "Note: ALL fields are required." return
across
guide 4x120
name "UserName:" uname: inp 75x24 return
at 0x150 indent 20
button "OK" 30x30 [check-newu-fields
send-newu-stuff
unview]
button "Apply" 50x30 [check-newu-fields]
button "Reset" 50x30 [clear-all-newu]
button "Quit" 40x30 [unview]
]
]
show-delete: func[] [
new-delete-window: make delete-window [ do [
t2/text: admin-site
]
]
view/new/offset new-delete-window 250x50
]
delete-window: func[] [
layout [
styles my-styles
size 300x200
subtitle "Delete a User"
below
txt16 bold "Delete for site: "
t2: txt16 bold "xxxxxxxxxxxxxxxxxxxxxxxxxx" return
indent 40
txt12 bold italic "Note: ALL fields are required." return
across
guide 4x120
name "UserName:" uname: inp 75x24 return
at 0x150 indent 20
button "OK" 30x30 [check-newu-fields
send-newu-stuff
unview]
button "Apply" 50x30 [check-newu-fields]
button "Reset" 50x30 [clear-all-newu]
button "Quit" 40x30 [unview]
]
]
show-change: func[] [
new-change-window: make change-window [ do [
t2/text: admin-site
]
]
view/new/offset new-change-window 250x50
]
change-window: func[] [
layout [
styles my-styles
size 300x270
subtitle "Change a Password"
below
txt16 bold "Change Password for site: "
t2: txt16 bold "xxxxxxxxxxxxxxxxxxxxxxxxxx" return
indent 40
txt12 bold italic "Note: ALL fields are required." return
across
guide 4x120
name "UserName:" uname: inp 75x24 return
name "Password:" user-pw1: password hide return
name "Again:" user-pw2: password hide return
at 0x220 indent 50
button "OK" 30x30 [check-uname
pwok: true
pword: :user-pw1/data
check-pw pword
if pwok = false [
clear user-pw1/data
show user-pw1]
pwok: true
pword: :user-pw2/data
check-pw pword
if pwok = false [
clear user-pw2/data
show user-pw2]
compare-pws user-pw1/data user-pw2/data
if pwok = true [
{send-chgpw-stuff}
unview ]
if pwok = false [
clear user-pw1/data
show user-pw1
clear user-pw2/data
show user-pw2
]
]
button "Apply" 50x30 [check-newu-fields]
button "Reset" 50x30 [clear-all-newu]
button "Quit" 40x30 [unview]
]
]
clear-all-newu: func [][[unview]-newu]ds]data
foreach nu-field reduce [uname ugroup ucomt upass1 upass2] [clear
nu-field/text]
shell1/text: copy "Shell Type"
show uname show ugroup show ucomt show upass1
show upass2 show shell1
]
send-newu-stuff: func [] [
adm-server: open/lines tcp://151.108.66.42:5999
nudata: reduce [ rejoin [
user-function" " admin-root" "
uname/text" " ugroup/text" " ucomt/text" "
upass1/data" " upass2/data" " shell1/text ]
]
insert adm-server nudata
print first adm-server
close adm-server
print nudata
]
check-newu-fields: func [][
check-uname
check-ugroup
check-ucomt
]
check-chku-fields: func [][
check-uname
]
send-chku-stuff: func [] [[ta"
adm-server: open/lines tcp://151.108.66.42:5999
nudata: reduce [ rejoin [
"check " admin-root ]
]
insert adm-server nudata
print first adm-server
close adm-server
print nudata
]
bad-chars: make bitset! "`~!@#$%^&*()_+ =[{]};:'/?><,"
check-uname: func [] [
sub-field: copy "Bad Username"
field-err: copy "UserName is Required!"
if 0 = length? uname/text [inform bad-field]
field-err: copy "UserName must be 4 to 8 characters in length"
if 4 > length? uname/text [inform bad-field
clear uname/text
show uname]
if 8 < length? uname/text [inform bad-field
clear uname/text
show uname]
field-err: copy "Username cannot contain special characters"
if find uname/text bad-chars [inform bad-field
clear uname/text
show uname]
]
check-ugroup: func [] [
sub-field: copy "Bad Group!"
field-err: copy "Group must be 4 to 8 characters in length"
if 4 > length? ugroup/text [inform bad-field
clear ugroup/text
show ugroup]
if 8 < length? ugroup/text [inform bad-field
clear ugroup/text
show ugroup]
field-err: copy "Group cannot contain special characters"
if find ugroup/text bad-chars [inform bad-field
clear ugroup/text
show ugroup]
]
check-ucomt: func [] [
sub-field: copy "No Comment!"
field-err: copy "Comment field should contain clients name"
if 0 = length? ucomt/text [inform bad-field
clear ucomt/text
show ucomt]
]
check-pw: func [pword] [
sub-field: copy "Bad password"
field-err: copy "Password is Required!"
if 0 = length? pword[inform bad-field]
field-err: copy "Password must be 4 to 10 characters in length"
pwlen: length? pword
print pwlen
if (4 > length? pword) [inform bad-field
pw-ok: false
]
if (10 < length? pword) [inform bad-field
pw-ok: false
]
]
compare-pws: func [pw1 pw2] [
sub-field: copy "Bad Password"
field-err: copy "Passwords Don't Match!"
print pw1
print pw2
pwok: false
if pw1 = pw2 [ print "They Match!"
pwok: true]
if pwok = false [ inform bad-field
pwok: false]
]
bad-field: func [] [return layout [
styles my-styles
subtitle :sub-field red
txt12 yellow 200x50 :field-err
indent 60 across
button 60x24 "OK" [hide-popup]
]
]
{view layout [
styles my-styles
p: password [print ["Password:" p/text]]
]
}
view login-popup
Thanks in Advance,
Greg Piney
S&P Web Engineering
