/* Scol Engine 5 - 2008/04/22 - B.Bourineau */
fun cbSendStat(inet, p, data, err)=
0;;
fun sendStats(id)=
let (strextr _getpack _checkpack sVersionFile) -> lver in
let btime htoi (getInfo lver "version") -> vd in
let (getInfo lver "name") -> vn in
INETGetURLex2 _channel "POST" sStatsUrl "content-type: application/x-www-form-urlencoded" strcatn("id="::id::"&ver="::(strcatn vn::" - "::vd::nil)::nil) 0 @cbSendStat nil;
0;;
fun pubbyname(a,s)=
let a->[x _ _] in !strcmp webtostr x webtostr s;;
fun nameofpub(a)=
let a->[x _ _] in x;;
fun ipofpub(a)=
let a->[_ port port2] in
if port==nil then
if port2==nil then nil else
strcatn "scol://applet:http://"::_hostIP::":"::(itoa port2)::"/"::(itoh4 port2)::"?X"::nil
else
strcatn "scol://"::_hostIP::":"::(itoa port)::nil;;
fun ipofpub2(a)=
let a->[_ port port2] in
if port==nil && port2==nil then nil else
strcatn "scol://"::_hostIP::":"::(nameofpub a)::nil;;
fun searchpub(l,n)=
if l==nil then nil else
let l->[r nxt] in
let search_in_list r.pubRun @pubbyname n -> x in
(
if x==nil then
searchpub nxt n
else
x
);;
fun searchpub2(l,n)=
if l==nil then nil else
let l->[r nxt] in
let search_in_list r.pubRun @pubbyname n -> x in
(
if x==nil then
searchpub2 nxt n
else
r
);;
fun _resizeT(a,t,x,y)=
_SIZEtext t x-2 y-2 1 1;;
fun chgusm2(l,a,b,s,k)=
if l==nil then
if k then
s::nil
else nil
else
let l->[ll n] in
let hd strextr ll -> [h [hh _]] in
if (!strcmp h a)&&((b==nil)||(!strcmpi b substr hh 0 strlen b)) then
s::chgusm2 n a b s 0
else
ll::chgusm2 n a b s k;;
fun chgusm(a,b,line)=
_saveusmini linebuild chgusm2 (lineextr _loadusmini nil) a b line 1;;
fun _showsetupwin(a,b)=
showSetup 0;
0;;
/*task menu right click*/
fun callmenu(a,b,c)=
if c != 1 then nil else
(
createmenus;
_SETfocus nil;
let _GETscreenPos->[x y] in
_DRAWmenu nil contmenu x y PM_SCREEN|PM_RIGHT_ALIGN|PM_BOTTOM_ALIGN;
);
0;;
/*task menu dbl click*/
fun dclicktask(a,b,c)=
showAddressBar hd back;
0;;
fun buildl(l)=
if l==nil then nil else
let l->[a n] in let buildl n -> res in
if (!strcmp substr a 0 19 "locked/lang/master.")&&(!strcmp substr a (strlen a)-5 5 ".lang") then
let hd getInfos strextr _getpack _checkpack a "LANGUAGE" -> s in
if s==nil then
res
else
[substr a 19 (strlen a)-24 s]::res
else res;;
fun insertstring(s,l,f)=
if l==nil then
s::nil
else
let exec f with [s hd l] -> res in
if res==0 then
insertstring s tl l f
else if res<0 then
s::l
else
(hd l)::insertstring s tl l f;;
fun sort(l,f)=
if l==nil then nil else
insertstring hd l sort tl l f f;;
fun cmpbyclear(x,y)=
let x->[_ a] in
let y->[_ b] in
strcmp a b;;
fun buildlanguages()=
set languages = sort buildl _listoffiles "locked/lang" @cmpbyclear;;
fun reinitloc()=
buildlanguages;
startloc "locked/lang/master";
_SETdefaultFont set font = _CRfont chn0 atoi loc "FONTSZ" 0 0 loc "FONT";
_SETtaskIconText icon strcat strcat loc "SE" " - " _versionname;
0;;
fun launchmachine(n,r)=
_newmachine n _getpack _checkpack n r 0;
0;;
fun launchscript(n)=
launchmachine n.nameScript n.rightsScript;;
fun _launch(t,n)=
launchscript n;;
fun search_in_script(l,f,i)=
if l==nil then nil else
let l->[a n] in
if exec f with [a i] then
a
else
let search_in_script a.sonsScript f i -> b in
if b!=nil then
b
else
search_in_script n f i;;
fun srvbyname(r,s)=
if !strcmp r.nameScript s then
1
else
0;;
fun srvbyclear(r,s)=
if !strcmp r.clearScript s then
1
else
0;;
fun runbychan(r,c)=
if r.canalRun==c then
1
else
0;;
fun runbyname(r,n)=
if !strcmp r.nameRun n then
1
else if !strcmp r.nameRun strcat n " *" then
1
else
0;;
fun rebuild2(l)=
if l==nil then nil else
let l->[a b] in
if b==nil then
a::nil
else
a::" "::rebuild2 b;;
fun rebuild(l)=
if l==nil then nil else
let l->[a nxt] in
if (nth_char hd a 0)=='> then
let rebuild nxt -> [nxt2 q] in
let mkScript[nil strcatn rebuild2 a nil nil q]-> s in
let rebuild nxt2->[nxt3 qq] in [nxt3 s::qq]
else if !strcmp hd a "<" then
[nxt nil]
else
let rebuild nxt->[n q] in
[n (mkScript[hd tl a hd a nil nil nil])::q];;
fun servics()=
let search_in_list customs @srvbyclear loc "STARTUP"->s in
s.sonsScript;;
fun launch(t,l)=
if l==nil then
_deltimer t
else
let l->[x n] in
(
launch nil x.sonsScript;
if x.nameScript!=nil then
launchscript x
else nil;
if t==nil then
set t=_starttimer _channel AutoStartDelay
else nil;
_rfltimer t @launch n;
nil
);;
fun newstart(l,olds)=
if l==nil then
0
else
let l->[x n] in
(
newstart x.sonsScript olds;
let search_in_script olds @srvbyname x.nameScript -> s in
if s==nil then
launchscript x
else nil;
newstart n olds
);;
fun initcustserv()=
let rebuild strextr _getpack _checkpack "locked/etc/custom.txt" ->[_ c] in
set customs=c;
set back=lineextr _getpack _checkpack "locked/etc/history.txt"
;;
fun _select(t,r)=
set current=r;
_scriptc r.canalRun "_load \"locked/master2.pkg\"\niniwindow";
0;;
/*public*/
fun createpublic2(r,mpublic)=
let ipofpub r -> url in
_CBmenu (_APPitem chn0 mpublic ME_ENABLED strcat strcat nameofpub r " : " url) @_contact ipofpub r;;
fun createpublic(r,mpublic)=
apply_on_list r.pubRun @createpublic2 mpublic;;
fun refreshpublic(m)=
apply_on_list running @createpublic m;;
/*custom*/
fun _destroycust(s)=
if s==nil then 0 else
let servics -> olds in
(
_storepack s "locked/etc/custom.txt";
initcustserv;
newstart servics olds;
0;
);;
fun _editcust(a,b)=
inibook chn0 nil 300 300 loc "ESM" loc "ESM" @_destroycust
_getpack _checkpack "locked/etc/custom.txt" 1 nil;
0;;
fun createcustom(l,menu)=
if l==nil then
0
else
let l->[s nxt] in
if s.nameScript==nil then
let _APPpopup chn0 menu substr s.clearScript 1 1000 -> z in
(
createcustom s.sonsScript z;
createcustom nxt menu
)
else
let _APPitem chn0 menu ME_ENABLED s.clearScript -> z in
(
_CBmenu z @_launch s;
createcustom nxt menu;
);;
fun refreshcustom(m)=
_CBmenu (_APPitem chn0 m ME_ENABLED loc "ESM") @_editcust "";
_APPitem chn0 m ME_SEPARATOR "";
createcustom customs m;;
/*active*/
fun createactive(r,mactive)=
if r.scriptRun==nil then
let search_in_script servics @srvbyname r.nameRun -> s in
if s==nil then nil else
(
set r.scriptRun=s;
set r.nameRun=strcat r.nameRun " *";
)
else if (search_in_script servics @srvbyname r.scriptRun.nameScript) != nil then nil else
(
set r.scriptRun=nil;
set r.nameRun=substr r.nameRun 0 (strlen r.nameRun)-2;
);
if r.canalRun==nil then nil else
let _APPitem chn0 mactive ME_ENABLED r.nameRun -> z in
_CBmenu z @_select r;;
fun refreshactive(m)=
apply_on_list running @createactive m;;
/*back*/
fun saveBack()=
_storepack linebuild back "locked/etc/history.txt";
0;;
fun createback(name,mhistory)=
let _APPitem chn0 mhistory ME_ENABLED name -> z in
_CBmenu z @_contact name;;
fun refreshback(m)=
apply_on_list back @createback m;;
/*about*/
fun labout(l)=
if l==nil then nil else
let l->[a b] in a::if b==nil then nil else ", "::labout b;;
fun _about(a,b)=
let (strextr _getpack _checkpack sVersionFile) -> lver in
let (getInfo lver "name") -> vn in
let btime htoi (getInfo lver "version") -> vd in
_DLGMessageBox chn0 nil (loc "AB") strloc loc "AB2" vn::vd::_versionname::(btime _versiondate)::_hostIP::nil 0;;
/*----------*/
// update interface url bar
fun _settextsite(n)=
0;;
fun contact(s,env)=
if (!strcmp substr s 0 8 "https://")||(!strcmp substr s 0 7 "http://")||(!strcmp substr s 0 7 "file://")||(!strcmp substr s 0 6 "ftp://")||(!strcmp substr s 0 6 "rtsp://")||(!strcmp substr s 0 7 "mailto:") then
(
_openbrowserhttp s;
set numb=numb+1;
0;
)
else
(
_newmachine strcat "browser" itoa numb (strcat "_load \"locked/stduser.pkg\"\n" mkscript maincom [s rights env]) nil 0;
set numb=numb+1;
0;
);
if s!=nil && strcmp s "" then
(
set back=[s cutlist back 10 s];
saveBack;
)
else nil;;
/*ressources*/
fun _destroyress(s)=
if s==nil then nil else
_saveressini s;
0;;
fun _editress(a,b)=
iniText chn0 nil 300 300 loc "RSE" loc "RSE" @_destroyress _loadressini;
0;;
/*expert mode*/
fun _destroypart(s)=
if s==nil then nil else
_saveusmini s;
0;;
fun _editpart(a,b)=
iniText chn0 nil 300 300 loc "CFE" loc "CFE" @_destroypart _loadusmini nil;
0;;
/*contact*/
fun _contact(t,n)=
_settextsite n;
contact n nil;;
fun _gotosite(a,b)=
_contact nil b;
0;;
fun _startscript(x,s)=
launchmachine s nil;;
// voyager close
fun _quit(a,b)=
_DStaskIcon icon;
_closemachine;
0;;
fun addlinkmenu(a,z)=
let z->[chn root] in
match a with
(
urlLink [n r] ->_CBmenu _APPitem chn root ME_ENABLED n @_gotosite r
)
|
(
scriptLink [n r] ->_CBmenu _APPitem chn root ME_ENABLED n @_startscript r
);;
fun _showurlwin(a, b)=
showAddressBar hd back;
0;;
fun _mnupdate(mnu, mode)=
_checkUpdate mode;
0;;
/*----------*/
/*menu taskIcon*/
fun createmenus()=
let _CRpopupMenu chn0 -> root in
(
// show url window
_CBmenu _APPitem chn0 root ME_ENABLED loc "ADDRESSBAR" @_showurlwin 0;
// open setup window
_CBmenu _APPitem chn0 root ME_ENABLED loc "CONF" @_showsetupwin 0;
refreshcustom _APPpopup chn0 root loc "ST"; /*start application*/
let _APPpopup chn0 root loc "ADV" -> adv in /*advanced*/
(
refreshpublic _APPpopup chn0 adv loc "SRV";
_APPitem chn0 adv ME_SEPARATOR "";
refreshactive _APPpopup chn0 adv loc "CONS";
_APPitem chn0 adv ME_SEPARATOR "";
_CBmenu (_APPitem chn0 adv ME_ENABLED loc "RSE") @_editress 0;
_CBmenu (_APPitem chn0 adv ME_ENABLED loc "EXPERT") @_editpart 0;
// TODO develloper mode check
);
_APPitem chn0 root ME_SEPARATOR "";
// history
refreshback _APPpopup chn0 root loc "HIS";
_APPitem chn0 root ME_SEPARATOR "";
// update
_CBmenu (_APPitem chn0 root ME_ENABLED loc "CHKUPDATE") @_mnupdate 1;
// about
_CBmenu (_APPitem chn0 root ME_ENABLED loc "AB") @_about 0;
_APPitem chn0 root ME_SEPARATOR "";
// close
_CBmenu (_APPitem chn0 root ME_ENABLED loc "QUIT") @_quit 0;
_DSmenu contmenu;
set contmenu=root;
_SETtaskIconMenu icon contmenu;
0;
);;
fun processpile(flags,l)=
if l==nil then
0
else
let l->[[com [arg1 [arg2 _]]] n] in
(
if !strcmp com "goto" then
(
contact arg1 nil;
processpile flags n;
)
else if !strcmp com "loadupdpkg" then
(
_storepack arg2 arg1;
processpile flags n;
)
else if !strcmp com "startupd" then
(
_openchannel nil strcatn (substr arg1 0 (strlen arg1)-1)::"\ "::(itoa flags)::"\n"::nil _envchannel _channel;
processpile flags n;
)
else processpile flags n;
);;
fun fullurl(srv,port,req,first)=
strcatn "http://"::srv::":"::(itoa if first then port else portdef)::"/"::(itoh4 port)::"?"::req::nil;;
fun cbmain(inet,z,s,reason)=
let z->[flags srv port req napps first current] in
if reason==0 then
(
mutate z<-[_ _ _ _ _ _ strcat current s];
0
)
else
let strextr current -> l in
if !strcmp hd hd l "ok" then
(
/*
if napps==nil then
set firstping=1
else nil;
*/
processpile flags tl l;
set pendingreq=0;
)
else if first then
(
_fooS "try again via std port";
startreq flags srv port req napps 0;
)
else
(
_fooS "cannot reach server";
set pendingreq=0;
if napps==nil then nil else
set nbapps=nbapps+napps;
);;
fun cbStartReq (url, param, res) =
_fooS "cbStartReq";
_fooS strcat "valeur de url :" url;
_fooS strcat "valeur de res :" itoa res;
let param -> [flags srv port req napps first] in
if !res then
(
_fooS "cannot open url (connection error)";
set pendingreq = 0;
if napps == nil
then
nil
else
set nbapps = nbapps + napps
)
else
let INETGetURL chn0 _fooS fullurl srv port req first 0 @cbmain [flags srv port req napps first nil] -> url in
if url == nil
then
(
_fooS "cannot open url (inet error)";
set pendingreq = 0;
if napps == nil
then
nil
else
set nbapps = nbapps + napps
)
else
nil;;
/* flags=masque de
1 pour se reconnecter sur le dernier site après un update
2 pour afficher un message si aucune màj disponible */
fun startreq (flags, srv, port, req, napps, first) =
_fooS "startreq1";
set pendingreq = 1;
_rflINETisConnected _fooS strcat "http://" srv @cbStartReq [flags srv port req napps first]; // envoie la requete que si l'on est connecté au net (évite d'afficher la popup d'IE)
0;;
fun requestn(n)=
strcat "USE"
strbuild
("tr"::(_getress "License")::nil)::
("n"::(itoa n)::nil)::
nil;;
fun htmlbin3(l,res)=
if l==nil then res else
let l->[x n] in
htmlbin3 n ((nameofpub x)::(ipofpub2 x)::nil)::res;;
fun htmlbin2(l,res)=
if l==nil then res else
let l->[a n] in
htmlbin3 a.pubRun htmlbin2 n res;;
fun htmlbin()=
strcat http_headerb strbuild ("name"::(_getress "DefaultName")::nil)::htmlbin2 running nil;;
fun htmldir3(l,res)=
if l==nil then res else
let l->[x n] in
htmldir3 n ""::(nameofpub x)::"
"::res;;
fun htmldir2(l,res)=
if l==nil then res else
let l->[a n] in
htmldir3 a.pubRun htmldir2 n res;;
fun htmldir()=
strcatn http_header::"