/******************************************************************************* Module FTP Client part Version: 1.0 Authors: Laurent PLUMAT Last update: //2001 FTP Module *******************************************************************************/ /* gestion des repertoires du serveur */ struct Tsfolder = [ sname : S, /* name of the folder */ spath : S, /* path of the folder */ sauthUser : [[S I] r1] /* all login and auth for user on this folder */ ]mkSfolder;; /* parcour de fichier dans les repertoires */ struct Tsfile = [ fname : S, /* name of the file */ fpath : S, /* path of the file */ file : I, /* 2 : file, 1 : folder */ fsize : I /* size of the file */ ]mkSfile;; /* gestion de la queue de telechargement */ struct Tqueue = [ qfile : P, /* file file to upload */ qLpath : S, /* path to get the file */ qSpath : S, /* path to save the file */ qway : I /* 1 upload, 2 download */ ]mkQueue;; /******** defcom ***************/ defcom SsendFolder = sendFolder S;; defcom SsendFile = sendFile S;; defcom SchangeAuth = changeAuth S S I S I;; defcom SdownloadFile = downloadFile S I I;; defcom SdeleteFile = deleteFile S;; defcom SclosedAdmin = closedAdmin;; defcom SmakeFolder = makeFolder S S;; defcom SremoveFolder = removeFolder S S;; typeof allServerFolder = [Tsfolder r1];; /* folder on the server */ typeof transfertQueue = [Tqueue r1];; /* all file to transfert */ typeof queue_in_progress = I;; typeof myFont = ObjFont;; /* font for all text */ typeof ContToolTip = ObjContainer;; typeof TextToolTip = CompText;; var beforeToolTipDelay=250;; var hideToolTipDelay=4000;; /******* admin ********/ typeof Iadmin = ObjContainer;; /* admin windows */ typeof listAdminFolder = CompList;; /* list of folder in the admin panel */ typeof currentListFolder = CompText;; /* current folder list */ typeof currentFolder = [S r1];; /* current folder path */ typeof buttonFolder = CompRollOver;; /* go pack to the father folder */ typeof listAuth = CompList;; /* complist to show auth of a directory */ typeof authRead = CompCheck;; typeof authWrite = CompCheck;; typeof authList = CompCheck;; typeof followAuth = CompCheck;; typeof listLB = CompText;; typeof followLB = CompText;; typeof deleteLogin = CompRollOver;; /* button to delete a login in the authList */ typeof addLogin = CompRollOver;; /* button to add a login in the authList */ typeof newLogin = CompText;; /* line to write a new login */ typeof readBMP = AlphaBitmap;; /* bitmap to show read permission */ typeof writeBMP = AlphaBitmap;; /* bitmap to show write permission */ typeof readwriteBMP = AlphaBitmap;; /* bitmap to show read an write permission */ typeof makeFolder = CompRollOver;; /* button to make a folder */ typeof removeFolder = CompRollOver;; /* button to remove a folder */ typeof newFolder = CompText;; typeof listAdminSelectedPosition = I;; typeof shareLB = CompText;; /* share folder */ typeof authLB = CompText;; /* label of auth */ typeof loginLB = CompText;; /* label "login" */ /****** user ******/ typeof Iuser = ObjContainer;; /* user window */ typeof Mwindow = CompText;; /* alert window */ typeof Mqueue = CompList;; /* queue window */ typeof queueLB = CompText;; /* label on the tob of the queue */ typeof wayLB = CompText;; /* label on the tob of the queue */ typeof nameLB = CompText;; /* label on the tob of the queue */ typeof stateLB = CompText;; /* label on the tp of the message window */ typeof sizeLB = CompText;; /* label on the tob of the description window */ typeof uploadBMP = AlphaBitmap;; /* picture for ce queue */ typeof downloadBMP = AlphaBitmap;; /* picture for the queue */ typeof gobutton = CompRollOver ;; /* button to lauch the queue transfert */ typeof stopbutton = CompRollOver ;; /* button to stop the transfert */ typeof delbutton = CompRollOver ;; /* button to remove a file */ typeof Tsize = CompText;; /* text where we write the zise of a selected file */ typeof Twindow = ObjWin;; /* windows to allow drag and drop */ typeof ScurrentFolder = [S r1];; /* current folder path on the server */ typeof ScurrentListFolder = CompText;;/* current folder list on the server */ typeof SlistFolder = [Tsfile r1];; /* list to explore server folder */ typeof SbuttonFolder = CompRollOver;; /* go pack to the father folder on the server*/ typeof ScomplistFolder = CompList;; /* list of folder in the user panel */ /* folder picture */ typeof closedBMP = AlphaBitmap;; /* image d'un repertoire non partagé */ typeof sclosedBMP = AlphaBitmap;; /* image d'un repertoire partagé */ /*path*/ typeof modulePath = S;; /* prototype */ proto cbVerify = fun [I] I;; /******************************************************************************** remove a show tooltips t -> Timer : timer of the tooltips b -> Channel : channel of the tooltips ********************************************************************************/ fun _CBtimerHideToolTip(t, b) = _deltimer t; _killchannel b ;; /******************************************************************************* hide a tool tips node -> ObjNode : tooltips father toolTipChannel -> channel : channel of the tooltips txt -> S : txt of the tooltips ********************************************************************************/ fun cbHideToolTip (node, toolTipChannel, txt) = _killchannel toolTipChannel ;; /******************************************************************************* show a tooltips node -> ObjNode : father of the tooltip b -> [channel ObjContainer] : txt -> S : text of the tooltips x, y -> I I : position of the tooltips ********************************************************************************/ fun cbShowToopTip (node,b,txt,x,y)= let b -> [toolTipChannel cont] in ( let _GETwindowPositionSize DMSwin -> [xp yp wp hp] in let _GETcursorPos DMSwin -> [xx yy] in let (xp + xx) + 20 -> x in let (yp + yy) + 30 -> y in if txt==nil || (!strcmpi txt "") then nil else let _GETstringSize Font txt -> [w h] in let [w+1 h+1] -> [w h] in let _GETscreenSize -> [sw sh] in let if (x+w)>sw-10 then sw-w-10 else x -> x in /*si depassement ecran, on decale à gauche*/ let 4 -> dw in let 4 -> dh in let _CRcontainerFromObjCont toolTipChannel cont x y w+dw h+dh CO_NOCAPTION make_rgb 240 240 240 "tooltip" -> cont in ( _CRcompText toolTipChannel cont nil [dw/2+1 dh/2] OBJ_ENABLE|OBJ_VISIBLE|CT_CENTER|CT_WORDWRAP 0 w h txt Font [make_rgb 0 0 0 0 0 0] [0 0] nil nil; _PAINTcontainer cont; _TOPcontainer cont; _rfltimer _starttimer toolTipChannel hideToolTipDelay @_CBtimerHideToolTip toolTipChannel ); ) ;; /******************************************************************************** create a tooltips cont -> ObjContainer node -> ObjNode txt -> S ********************************************************************************/ fun CreateToolTip (cont, node, txt) = let _openchannel nil nil nil -> toolTipChannel in ( _CRtoolTip node beforeToolTipDelay txt @cbShowToopTip [toolTipChannel cont] @cbHideToolTip toolTipChannel; toolTipChannel ) ;; /******************************************************************************** destroy all bitmap element -> alphabitmap :bitmap to destroy param -> parameter : not used ********************************************************************************/ fun cbDestroyBitmap (element, param) = _DSalphaBitmap element ;; /******************************************************************************** callback for destroy the admin pannel container -> objcontainer : The admin panel picture -> [alphabitmap r1] : all pictures *********************************************************************************/ fun cbContAdminPreDestroy (container, picture)= _DScompList listAdminFolder; _DScompList listAuth; _DScompText currentListFolder; _DScompRollOver buttonFolder; _DScompRollOver deleteLogin; _DScompRollOver addLogin; _DScompText listLB; _DScompCheck authRead; _DScompCheck authWrite; _DScompCheck authList; _DScompText newLogin; _DScompCheck followAuth; _DScompText followLB; _DScompRollOver removeFolder; _DScompRollOver makeFolder; _DScompText newFolder; _DScompText shareLB; _DScompText authLB; _DScompText loginLB; _DScontainer Iadmin; apply_on_list picture @cbDestroyBitmap nil; _DMSsend this SclosedAdmin []; set Iadmin = nil ;; /******************************************************************************** fill the server folder *********************************************************************************/ fun cbfillServerFolder (folder, param) = let if folder.sauthUser == nil then closedBMP else sclosedBMP -> bmp in _ADDcompList listAdminFolder 200 [folder.sname bmp] ;; /******************************************************************************* search a folder in te folder list element -> Tsfolder : element of allServerFolder folder -> S : folder to find ********************************************************************************/ fun cbSearchFolder (element, folder) = !strcmpi element.sname folder ;; /******************************************************************************** explore a choose folder complist -> compList : the list of folder param -> S : not used pos -> I : position of the selected item *********************************************************************************/ fun cbExplor (complist, param, pos) = let _GETcompListValue complist pos -> [name _] in let search_in_list allServerFolder @cbSearchFolder name -> f in ( set listAdminSelectedPosition = pos; set currentFolder = f.spath::currentFolder; _DMSsend this SsendFolder [f.spath] ) ;; /****************************************************************************** callback of buttonFolder roll -> CompRollOver : buttonFolder param -> S : not used x y btn msk -> I I I I : position and button click *******************************************************************************/ fun cbdownFolder (roll, param, x, y, btn, msk) = set currentFolder = tl currentFolder ; _DMSsend this SsendFolder [(hd currentFolder)] ;; /****************************************************************************** search a user in an auth list element -> [S I] : element of the list login -> S : login to find ******************************************************************************/ fun cbSearchUser (element, login) = let element -> [login2 _] in !strcmpi login2 login ;; /***************************************************************************** server confirma that the login exist login -> S : login to had folder -> S : folder to had login ******************************************************************************/ fun __AddLogin (login) = if !strcmpi login "-1" then (_DLGMessageBox _channel nil (_loc this "WARNING_TITLE" nil) (_loc this "NO_DATABASE" nil) 0;0) else if login == nil then (_DLGMessageBox _channel nil (_loc this "WARNING_TITLE" nil) (_loc this "INVALID_USER" nil) 0;0) else let _GETcompListClicked listAdminFolder -> [_ [folder _]] in let search_in_list allServerFolder @cbSearchFolder folder -> f in ( set f.sauthUser = [login 0]::f.sauthUser; _SSETcompListValue listAdminFolder f.sname [f.sname sclosedBMP]; _SETcompCheckState authList 1; _ADDcompList listAuth 200 [login nil]; _SETcompText newLogin "" myFont [0 0 0 0] CT_NOCHANGE; _PAINTcontainer Iadmin; 0 ) ;; /****************************************************************************** callback to add a new login roll -> CompRollOver : Add button param -> parameter : not used x y btn mask -> I I I I : position bouton and mask ******************************************************************************/ fun cbAddLogin (roll, param, x, y, btn, mask) = let _GETcompText newLogin -> login in if (!strcmpi login "") then nil else ( let _GETcompListClicked listAdminFolder -> [_ [folder _]] in let search_in_list allServerFolder @cbSearchFolder folder -> f in if f == nil then nil else let search_in_list f.sauthUser @cbSearchUser login -> fu in if fu == nil then ( if !strcmpi login "guest" then (_DLGMessageBox _channel nil (_loc this "GUEST_TITLE" nil) (_loc this "GUEST_BODY" nil) 0;0) else nil; _DMSsend this SchangeAuth [f.spath login 0 (hd currentFolder) _GETcompCheckState followAuth] ) else ( _SETcompText newLogin "" myFont [0 0 0 0] CT_NOCHANGE; _PAINTcontainer Iadmin; 0 ) ) ;; /******************************************************************************* callback to remove a login roll -> CompRollOver : Delete button param -> paramater : not used x y btn mask -> I I I I : position bouton and mask ******************************************************************************/ fun cbDeleteLogin (roll, param, x, y, btn, mask) = let _GETcompListClicked listAdminFolder -> [_ [folder _]] in let _GETcompListClicked listAuth -> [pos [login _]] in if (pos == nil) || (folder == nil) then nil else ( _DELcompList listAuth pos; let search_in_list allServerFolder @cbSearchFolder folder -> f in let search_in_list f.sauthUser @cbSearchUser login -> fu in ( set f.sauthUser = remove_from_list f.sauthUser fu; _DMSsend this SchangeAuth [f.spath login (-1) (hd currentFolder) _GETcompCheckState followAuth]; if f.sauthUser == nil then( _SETcompCheckState authList 0; _SSETcompListValue listAdminFolder f.sname [f.sname closedBMP] ) else nil ); _PAINTcontainer Iadmin ) ;; /******************************************************************************* callback to change readauth check -> CompCheck : authRead param -> paramater : not used x y btn mask -> I I I I : position bouton and mask ********************************************************************************/ fun cbauthRead (check, param, x, y, btn, mask) = let _GETcompListClicked listAdminFolder -> [_ [folder _]] in let _GETcompListClicked listAuth -> [pos [login _]] in if (pos == nil) || (folder == nil) then nil else let search_in_list allServerFolder @cbSearchFolder folder -> f in let search_in_list f.sauthUser @cbSearchUser login -> fu in if fu == nil then nil else let fu -> [l a] in if a == 0 then ( mutate fu <- [_ 1]; _DMSsend this SchangeAuth [f.spath login 1 (hd currentFolder) _GETcompCheckState followAuth]; _SSETcompListValue listAuth login [login readBMP]; _PAINTcontainer Iadmin ) else if a == 1 then ( mutate fu <- [_ 0]; _DMSsend this SchangeAuth [f.spath login 0 (hd currentFolder) _GETcompCheckState followAuth]; _SSETcompListValue listAuth login [login nil]; _PAINTcontainer Iadmin ) else if a == 2 then ( mutate fu <- [_ 3]; _DMSsend this SchangeAuth [f.spath login 3 (hd currentFolder) _GETcompCheckState followAuth]; _SSETcompListValue listAuth login [login readwriteBMP]; _PAINTcontainer Iadmin ) else if a == 3 then ( mutate fu <- [_ 2]; _DMSsend this SchangeAuth [f.spath login 2 (hd currentFolder) _GETcompCheckState followAuth]; _SSETcompListValue listAuth login [login writeBMP]; _PAINTcontainer Iadmin ) else nil ;; /******************************************************************************* callback to change writeauth check -> CompCheck : authRead param -> paramater : not used x y btn mask -> I I I I : position bouton and mask ********************************************************************************/ fun cbauthWrite (check, param, x, y, btn, mask) = let _GETcompListClicked listAdminFolder -> [_ [folder _]] in let _GETcompListClicked listAuth -> [pos [login _]] in if (pos == nil) || (folder == nil) then nil else let search_in_list allServerFolder @cbSearchFolder folder -> f in let search_in_list f.sauthUser @cbSearchUser login -> fu in if fu == nil then nil else let fu -> [l a] in if a == 0 then ( mutate fu <- [_ 2]; _DMSsend this SchangeAuth [f.spath login 2 (hd currentFolder) _GETcompCheckState followAuth]; _SSETcompListValue listAuth login [login writeBMP]; _PAINTcontainer Iadmin ) else if a == 1 then ( mutate fu <- [_ 3]; _DMSsend this SchangeAuth [f.spath login 3 (hd currentFolder) _GETcompCheckState followAuth]; _SSETcompListValue listAuth login [login readwriteBMP]; _PAINTcontainer Iadmin ) else if a == 2 then ( mutate fu <- [_ 0]; _DMSsend this SchangeAuth [f.spath login 0 (hd currentFolder) _GETcompCheckState followAuth]; _SSETcompListValue listAuth login [login nil]; _PAINTcontainer Iadmin ) else if a == 3 then ( mutate fu <- [_ 1]; _DMSsend this SchangeAuth [f.spath login 1 (hd currentFolder) _GETcompCheckState followAuth]; _SSETcompListValue listAuth login [login readBMP]; _PAINTcontainer Iadmin ) else nil ;; /***************************************************************************** refresh check of auth when chossing a new login cl -> CompList : complist of auth param -> parameter : not used pos -> I : clicked item position ******************************************************************************/ fun cbRefreshAuth (cl, param, pos) = let _GETcompListClicked listAdminFolder -> [_ [folder _]] in let _GETcompListClicked listAuth -> [pos [login _]] in if (pos == nil) || (folder == nil) then nil else let search_in_list allServerFolder @cbSearchFolder folder -> f in let search_in_list f.sauthUser @cbSearchUser login -> fu in if fu == nil then nil else let fu -> [_ a] in ( if (a & 1) == 1 then _SETcompCheckState authRead 1 else _SETcompCheckState authRead 0; if (a & 2) == 2 then _SETcompCheckState authWrite 1 else _SETcompCheckState authWrite 0; _PAINTcontainer Iadmin ) ;; /***************************************************************************** fill the auth list element -> [S I] : element of list param -> parameter : not used ******************************************************************************/ fun cbFillUserAuth (element, param) = let element -> [login a] in let if a == 1 then readBMP else if a == 2 then writeBMP else if a == 3 then readwriteBMP else nil -> bmp in _ADDcompList listAuth 0 [login bmp] ;; /***************************************************************************** refresh auth list when chossing a new folder cl -> CompList : complist of folder param -> parameter : not used pos -> I : clicked item position ******************************************************************************/ fun cbChangeDirectoryAuthList (cl, param, pos) = let _GETcompListClicked listAdminFolder -> [_ [folder _]] in let search_in_list allServerFolder @cbSearchFolder folder -> f in if f == nil then nil else ( _RSTcompList listAuth; apply_on_list f.sauthUser @cbFillUserAuth nil; if f.sauthUser == nil then _SETcompCheckState authList 0 else _SETcompCheckState authList 1 ); _PAINTcontainer Iadmin ;; /**************************************************************************** remove a folder roll -> RollOver : the makefolder rollover param -> parameter : not used x, y, bt, mask -> I I I I : position and button *****************************************************************************/ fun cbremoveFolder (roll, param, x, y, bt, mask) = let _GETcompListClicked listAdminFolder -> [_ [folder _]] in let search_in_list allServerFolder @cbSearchFolder folder -> f in if f == nil then nil else _DMSsend this SremoveFolder [f.spath (hd currentFolder)] ;; /***************************************************************************** add a new folder roll -> RollOver : the makefolder rollover param -> parameter : not used x, y, bt, mask -> I I I I : position and button ******************************************************************************/ fun cbmakeFolder (roll, param, x, y, bt, mask) = let _GETcompText newFolder -> name in if !strcmpi name "" then nil else ( _SETcompText newFolder "" myFont [0 0 0 0] 1; _DMSsend this SmakeFolder [name (hd currentFolder)] ) ;; /****************************************************************************** resize and create admin pannel obcont -> ObjContainer : The admin panel adminIMG -> alphabitmap : picture of admin window state -> I : state of the container w h -> I I : new size *******************************************************************************/ fun cbcontAdminResize (obcont, adminIMG, state)= /* name of the new folder */ set newFolder = _CRcompText _channel Iadmin nil [125 5] OBJ_ENABLE|CT_EDITLINE 0 101 20 "" myFont [0 0 0 0] [0 50] nil nil; /* title */ set shareLB = _CRcompText _channel Iadmin nil [10 25] OBJ_ENABLE|CT_LABEL 0 200 30 (_loc this "SHAREF" nil) myFont [0 0 0 0] [0 0] nil nil; set authLB = _CRcompText _channel Iadmin nil [233 25] OBJ_ENABLE|CT_LABEL|CT_CENTER 0 48 20 (_loc this "AUTHLB" nil) myFont [0 0 0 0] [0 0] nil nil; set loginLB = _CRcompText _channel Iadmin nil [282 25] OBJ_ENABLE|CT_LABEL|CT_CENTER 0 160 20 (_loc this "LOGINLB" nil) myFont [0 0 0 0] [0 0] nil nil; /* current list in the current folder */ set currentListFolder = _CRcompText _channel Iadmin nil [6 40] OBJ_ENABLE|CT_LABEL 0 200 20 (hd currentFolder) myFont [0 0 0 0] [0 0] nil nil; set listLB = _CRcompText _channel Iadmin nil [254 342] OBJ_ENABLE|CT_LABEL 0 75 20 (_loc this "LISTER" nil) myFont [0 0 0 0] [0 0] nil nil; set followLB = _CRcompText _channel Iadmin nil [254 327] OBJ_ENABLE|CT_LABEL 0 200 20 (_loc this "FOLLOW" nil) myFont [0 0 0 0] [0 0] nil nil; /* line to add a new login */ set newLogin = _CRcompText _channel Iadmin nil [304 5] OBJ_ENABLE|CT_EDITLINE 0 150 20 "" myFont [0 0 0 0] [0 50] nil nil; /* load alphabitmap */ let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"images/picto_retour.png"::nil)) -> buttonFolderIMG in let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"images/picto_corbeille.png"::nil)) -> removeFolderIMG in let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"images/picto_fichier.png"::nil)) -> makeFolderIMG in let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"images/lift298.png"::nil)) -> vlift298 in let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"images/lift263.png"::nil)) -> vlift263 in let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"images/check_box.png"::nil)) -> check_boxIMG in let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"images/picto_oeil.png"::nil)) -> picto_oeil in let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"images/picto_crayon.png"::nil)) -> picto_crayon in let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"images/picto_rlogin.png"::nil)) -> picto_rlogin in let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"images/picto_alogin.png"::nil)) -> picto_alogin in ( /* button to change folder */ set buttonFolder = _CBcompRollOverClick (_CRcompRollOver _channel Iadmin nil [6 0] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE 0 buttonFolderIMG) @cbdownFolder nil; /* button to remove a folder */ set removeFolder = _CBcompRollOverClick (_CRcompRollOver _channel Iadmin nil [39 0] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE 0 removeFolderIMG) @cbremoveFolder nil; /* bouton to make a new folder */ set makeFolder = _CBcompRollOverClick (_CRcompRollOver _channel Iadmin nil [72 0] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE 0 makeFolderIMG) @cbmakeFolder nil; /* list of share folder */ set listAdminFolder = _CRcompList _channel Iadmin nil [6 58] OBJ_ENABLE|OBJ_VISIBLE|LST_HIGHLIGHT_CLICKED|LST_LEFT OBJ_CONTAINER_DBLCLICK (223-25) 298 (298/16) LST_VERTICAL myFont 20 [0 0 0 0] [0 50] [[223-16 0] OBJ_MW_FLEX|OBJ_MH_FLEX|OBJ_RH_FLEX|OBJ_LH_FLEX|SLB_MASK|SLB_ROLLOVER vlift298 [17 283 298]]; /*list of auth */ set listAuth = _CRcompList _channel Iadmin nil [234 60] OBJ_ENABLE|OBJ_VISIBLE|LST_HIGHLIGHT_CLICKED|LST_LEFT OBJ_CONTAINER_DBLCLICK (223-25) 263 (263/16) LST_VERTICAL myFont 55 [0 0 0 0] [0 50] [[221-16 0] OBJ_MW_FLEX|OBJ_MH_FLEX|OBJ_RH_FLEX|OBJ_LH_FLEX|SLB_MASK|SLB_ROLLOVER vlift263 [17 248 263]]; /*button of auth */ set authList = _CRcompCheck _channel Iadmin nil [234 342] OBJ_DISABLE|OBJ_VISIBLE|ROL_MASK 0 check_boxIMG; /* check of read auth */ set authRead = _CBcompCheckUnClick _CRcompCheck _channel Iadmin nil [236 41] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE 0 picto_oeil @cbauthRead nil; /* check of write auth */ set authWrite = _CBcompCheckUnClick _CRcompCheck _channel Iadmin nil [258 41] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE 0 picto_crayon @cbauthWrite nil; /* heritage des droits au sous repertoire */ let _GETcompCheckState followAuth -> value in ( _DScompCheck followAuth; set followAuth = _CRcompCheck _channel Iadmin nil [234 327] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK 0 check_boxIMG; _SETcompCheckState followAuth value; ); /* remove button */ set deleteLogin = _CBcompRollOverClick (_CRcompRollOver _channel Iadmin nil [234 0] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE 0 picto_rlogin) @cbDeleteLogin nil; /* add button */ set addLogin = _CBcompRollOverClick (_CRcompRollOver _channel Iadmin nil [266 0] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE 0 picto_alogin) @cbAddLogin nil; _CBcontainerPreDestroy Iadmin @cbContAdminPreDestroy buttonFolderIMG::removeFolderIMG::makeFolderIMG::vlift298::vlift263::check_boxIMG:: picto_oeil::picto_crayon::picto_rlogin::picto_alogin::adminIMG::nil; ); /* tooltips */ CreateToolTip Iadmin (_CONVERTcompRollOverToObjNode buttonFolder) (_loc this "FT_TOOL_FOLDER" nil); CreateToolTip Iadmin (_CONVERTcompRollOverToObjNode removeFolder) (_loc this "FT_TOOL_REMOVE_FOLDER" nil); CreateToolTip Iadmin (_CONVERTcompRollOverToObjNode makeFolder) (_loc this "FT_TOOL_ADD_FOLDER" nil); CreateToolTip Iadmin (_CONVERTcompRollOverToObjNode deleteLogin) (_loc this "FT_TOOL_REMOVE_LOGIN" nil); CreateToolTip Iadmin (_CONVERTcompRollOverToObjNode addLogin) (_loc this "FT_TOOL_ADD_LOGIN" nil); CreateToolTip Iadmin (_CONVERTcompTextToObjNode currentListFolder) (_loc this "FT_TOOL_CURRENT" nil); CreateToolTip Iadmin (_CONVERTcompCheckToObjNode authRead) (_loc this "FT_TOOL_READ" nil); CreateToolTip Iadmin (_CONVERTcompCheckToObjNode authWrite) (_loc this "FT_TOOL_WRITE" nil); _CBcompListDblClick listAdminFolder @cbExplor nil; _CBcompListClick listAdminFolder @cbChangeDirectoryAuthList nil; _CBcompListClick listAuth @cbRefreshAuth nil; /* fill the complist */ apply_on_list allServerFolder @cbfillServerFolder nil; _SETcompListClicked listAdminFolder listAdminSelectedPosition; cbChangeDirectoryAuthList listAdminFolder nil listAdminSelectedPosition; _SETcompListClicked listAuth 0; cbRefreshAuth listAuth nil 0; _PAINTcontainer Iadmin; 0 ;; /********************************************************************* admin interface **********************************************************************/ fun showAdmin()= set listAdminSelectedPosition = 0; let 462 -> w in let 364 -> h in if Iadmin != nil then ( _SETfocusContainer Iadmin; 0 ) else ( set Iadmin = _CRcontainerFromObjWin _channel DMSwin nil nil w h CO_MENU|CO_3DBORDER (make_rgb 255 255 255) "admin"; let _LDalphaBitmap _channel _checkpack strcat modulePath "images/admin.png" ->alphabmp in ( _CRcompBitmap _channel Iadmin nil [0 0] OBJ_ENABLE|OBJ_VISIBLE OBJ_CONTAINER_CLICK alphabmp 0 0 462 362; cbcontAdminResize Iadmin alphabmp nil; ); ); 0 ;; /*------------------------------------------------------------------------------------------------------------------*/ /*------------------------------------------------------------------------------------------------------------------*/ /* ******************************************** user interface ******************************************************/ /*------------------------------------------------------------------------------------------------------------------*/ /*------------------------------------------------------------------------------------------------------------------*/ /******************************************************************************** recherche du nom d'un fichier dans un path path -> S : path of the file <- S : name ********************************************************************************/ fun findName (path) = if path == nil then nil else let strfind "/" path 0 -> result in if result == nil then path else findName substr path (result +1) ((strlen path)-(result +1)) ;; /******************************************************************************** search server folder element -> Tsfile : file of the list param -> S : file to find *********************************************************************************/ fun cbSearchFile (element, param) = !strcmpi element.fname param ;; /******************************************************************************** callback for destroy the user pannel win -> ObjWin : The user panel bitmap -> [alphabitmap r1] : list of alphabitmap to destroy *********************************************************************************/ fun cbWinUserPreDestroy (win, bitmap)= _DScompText Mwindow; _DScompList Mqueue; _DScompText queueLB; _DScompText wayLB; _DScompText stateLB; _DScompText nameLB; _DScompText sizeLB; _DScompText Tsize; _DScompText ScurrentListFolder; _DScompRollOver SbuttonFolder; _DScompList ScomplistFolder; _DScontainer Iuser; _DSwindow Twindow; _DScompRollOver delbutton; _DScompRollOver gobutton; _DScompRollOver stopbutton; set Twindow = nil; set transfertQueue = nil; apply_on_list bitmap @cbDestroyBitmap nil; _DMSeventTag this "hidden" nil nil nil; 0 ;; /****************************************************************************** callback of buttonFolder roll -> CompRollOver : SbuttonFolder param -> S : not used x y btn msk -> I I I I : position and button click *******************************************************************************/ fun cbSdownFolder (roll, param, x, y, btn, msk) = if ScurrentFolder == nil then nil else ( set ScurrentFolder = tl ScurrentFolder; _SETcompText ScurrentListFolder (hd ScurrentFolder) myFont [0 0 0 0] 1; _SETcompText Tsize "" myFont [0 0 0 0] 1; _PAINTcontainer Iuser; _DMSsend this SsendFile [(hd ScurrentFolder)] ) ;; /****************************************************************************** auth was change param -> folder to refresh *******************************************************************************/ fun __refresh (param) = if !strcmpi param (hd ScurrentFolder) then ( _RSTcompList ScomplistFolder; _PAINTcontainer Iuser; _DMSsend this SsendFile [(hd ScurrentFolder)] ) else nil ;; /****************************************************************************** callback to fill complist server element -> element to fill complist -> complist to fill *******************************************************************************/ fun cbfillFile (element, complist) = let if element.file == 1 then closedBMP else nil -> bmp in _ADDcompList complist 0 [element.fname bmp] ;; /******************************************************************************** explore a choose server folder complist -> compList : the list of folder on the client computer param -> S : not used pos -> I : position of the selected item *********************************************************************************/ fun cbSExplor (complist, param, pos) = let _GETcompListValue complist pos -> [name bmp] in if name == nil then nil else let search_in_list SlistFolder @cbSearchFile name -> f in if f ==nil then nil else if f.file == 1 then ( set ScurrentFolder = f.fpath::ScurrentFolder; _SETcompText ScurrentListFolder f.fpath myFont [0 0 0 0] 1; _RSTcompList ScomplistFolder; _SETcompText Tsize "" myFont [0 0 0 0] 1; _PAINTcontainer Iuser; _DMSsend this SsendFile [f.fpath]; 0 ) else ( set transfertQueue = listcat transfertQueue (mkQueue [nil "/" f.fpath 2])::nil; _ADDcompList Mqueue 500 [f.fname downloadBMP]; _PAINTcontainer Iuser; 0 ) ;; /******************************************************************************** a file was selected complist -> compList : the list of folder on the client computer param -> S : not used pos -> I : position of the selected item *********************************************************************************/ fun cbSelectFile (complist, param, pos) = let _GETcompListValue complist pos -> [name bmp] in if name == nil then nil else let search_in_list SlistFolder @cbSearchFile name -> f in if f ==nil then nil else if f.file == 1 then nil else ( _SETcompText Tsize (itoa f.fsize) myFont [0 0 0 0] 1; _PAINTcontainer Iuser ) ;; /****************************************************************************** launch the transfert on the transfert queue roll -> CompRollOver : launch button param -> parameter : not used x, y, btn, mask -> I I I I : cursor coordinates in container *******************************************************************************/ fun cbLauchQueue (roll, param, x, y, btn, mask) = if queue_in_progress != 1 then ( set queue_in_progress = 1; if transfertQueue == nil then ( set queue_in_progress = 0 ) else let (hd transfertQueue) -> first in ( if first.qway == 1 then ( _ADDcompText Mwindow (strcatn (_loc this "USTART" nil)::" "::(findName first.qLpath)::"\n"::nil) myFont [0 0 0 0] 1; _PAINTcontainer Iuser; let (_FILESize _FILEOpen _channel _checkpack first.qLpath) -> size in if size == nil then ( set transfertQueue = (tl transfertQueue); _DELcompList Mqueue 0; _ADDcompText Mwindow (strcat (_loc this "FREMOVE" nil) "\n") myFont [0 0 0 0] 1; _PAINTcontainer Iuser; if queue_in_progress == 0 then nil else ( set queue_in_progress = 0; cbLauchQueue nil nil nil nil nil nil ); 0 ) else _DMSsend this SdownloadFile [first.qSpath 2 size]; 0 ) else ( _ADDcompText Mwindow (strcatn (_loc this "DSTART" nil)::" "::(findName first.qSpath)::"\n"::nil) myFont [0 0 0 0] 1; _PAINTcontainer Iuser; _DMSsend this SdownloadFile [first.qSpath 1 nil]; 0 ); 0 ) ) else nil ;; /****************************************************************************** stop the transfert on the transfert queue roll -> CompRollOver : stop button param -> parameter : not used x, y, btn, mask -> I I I I : cursor coordinates in container *******************************************************************************/ fun cbStopQueue (roll, param, x, y, btn, mask) = if queue_in_progress != 1 then nil else ( /*_ADDcompText Mwindow (_loc this "USTOP" nil) myFont [0 0 0 0] 1;*/ set queue_in_progress = 0; ) ;; /******************************************************************************* error message from the server number -> I : number of the message ********************************************************************************/ fun __error (number) = if number == 1 then (_ADDcompText Mwindow (strcatn (_loc this "ERROR_1" nil)::"\n"::nil) myFont [0 0 0 0] 1;0) else if number == 2 then (_ADDcompText Mwindow (strcatn (_loc this "ERROR_2" nil)::"\n"::nil) myFont [0 0 0 0] 1;0) else if number == 3 then (_ADDcompText Mwindow (strcatn (_loc this "ERROR_3" nil)::"\n"::nil) myFont [0 0 0 0] 1;0) else if number == 4 then (_ADDcompText Mwindow (strcatn (_loc this "ERROR_4" nil)::"\n"::nil) myFont [0 0 0 0] 1;0) else if number == 5 then (_ADDcompText Mwindow (strcatn (_loc this "ERROR_5" nil)::"\n"::nil) myFont [0 0 0 0] 1;0) else if number == 10 then (_DLGMessageBox _channel nil (_loc this "WARNING_TITLE" nil) (_loc this "WARNING_FOLDER" nil) 0;0) else nil; set transfertQueue = (tl transfertQueue); _DELcompList Mqueue 0; _PAINTcontainer Iuser; set queue_in_progress = 0; cbLauchQueue nil nil nil nil nil nil; 0 ;; /****************************************************************************** file arrived from the server *******************************************************************************/ fun cbFileArrived (name) = if name == nil then _ADDcompText Mwindow (strcat (_loc this "EDOWNLOAD" nil) "\n") myFont [0 0 0 0] 1 else _ADDcompText Mwindow (strcat (_loc this "DFINISH" nil) "\n") myFont [0 0 0 0] 1; set transfertQueue = (tl transfertQueue); _DELcompList Mqueue 0; _PAINTcontainer Iuser; if queue_in_progress == 0 then nil else ( set queue_in_progress = 0; cbLauchQueue nil nil nil nil nil nil ); 0 ;; /****************************************************************************** server have register the file path -> S : path of the file on the server way -> I : upload or download *******************************************************************************/ fun __downloadFile (path, way) = if way == 1 then ( let substr (_getlongname path path "#") ((strlen path)+1) 16 -> sign in _RSCdownload this sign (findName path) @cbFileArrived 1; 0 ) else ( let (hd transfertQueue) -> first in _DMSupload this (strcatn first.qSpath::"/"::(findName first.qLpath)::nil) _getpack first.qfile @cbVerify; 0 ) ;; /****************************************************************************** verify if the upload finish verif -> I : 1 if success and else 0 *******************************************************************************/ fun cbVerify (verif) = if verif == 0 then _ADDcompText Mwindow (strcat (_loc this "EUPLOAD" nil) "\n") myFont [0 0 0 0] 1 else _ADDcompText Mwindow (strcat (_loc this "UFINISH" nil) "\n") myFont [0 0 0 0] 1; set transfertQueue = (tl transfertQueue); _DELcompList Mqueue 0; _PAINTcontainer Iuser; _DMSsend this SsendFile [(hd ScurrentFolder)]; if queue_in_progress == 0 then nil else ( set queue_in_progress = 0; cbLauchQueue nil nil nil nil nil nil ); 0 ;; /****************************************************************************** fill the queue complist element -> Tqueue : element of the list param -> parameter : not used *******************************************************************************/ fun cbfillqueue (element, param) = _ADDcompList Mqueue 0 if element.qway == 1 then [element.qSpath uploadBMP] else [element.qLpath downloadBMP] ;; /****************************************************************************** delete a file roll -> comprollover : delete button param -> parameter : not used x y btn mask -> I I I I : click and position *******************************************************************************/ fun cbDelFile (roll, param, x, y, btn, mask) = let _GETcompListClicked ScomplistFolder -> [pos [sfile bmp]] in let search_in_list SlistFolder @cbSearchFile sfile -> f in if (f == nil) || (f.file == 1) then nil else _DMSsend this SdeleteFile [f.fpath] ;; /******************************************************************************** remove an element in the queue complist -> compList : the queue list param -> S : not used pos -> I : position of the selected item *********************************************************************************/ fun cbRemoveQueue (complist, param, pos) = let _GETcompListValue complist pos -> [name bmp] in if name == nil then nil else ( set transfertQueue = remove_nth_from_list transfertQueue pos; _DELcompList Mqueue pos; _PAINTcontainer Iuser ) ;; /****************************************************************************** resize and create user pannel win -> ObjWin : The user panel Twindow -> ObjWindow : for lauch the destroy window callback w h -> I I : new size *******************************************************************************/ fun cbWinUserResize (win, Twindow, w, h)= set Iuser = _CRcontainerFromObjWin _channel Twindow 0 0 (w) (h) CO_3DBORDER|CO_CHILDINSIDE (make_rgb 255 255 255) "user"; let _LDalphaBitmap _channel _checkpack strcat modulePath "images/ftp_user.png" ->ftp_user in let _LDalphaBitmap _channel _checkpack strcat modulePath "images/lift50.png" ->vlift50 in let _LDalphaBitmap _channel _checkpack strcat modulePath "images/lift230.png" ->vlift230 in let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"images/picto_retour.png"::nil)) -> picto_retour in let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"images/lift280.png"::nil)) -> vlift280 in let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"images/picto_ok.png"::nil)) -> picto_ok in let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"images/stop.png"::nil)) -> stopIMG in let (_LDalphaBitmap _channel _checkpack (strcatn modulePath::"images/picto_corbeille.png"::nil)) -> picto_corbeille in ( /*affichage du fond */ _CRcompBitmap _channel Iuser nil [0 0] OBJ_ENABLE|OBJ_VISIBLE OBJ_CONTAINER_CLICK ftp_user 0 0 461 361; /* message window */ set Mwindow = _CRcompText _channel Iuser nil [201 312] OBJ_ENABLE|CT_WORDWRAP 0 239 45 "" myFont [0 0 0 0] [0 50] [[239 0] OBJ_ENABLE|OBJ_VISIBLE|SLB_MASK|SLB_ROLLOVER vlift50 [17 31 46]] nil; /* queue window */ set Mqueue = _CRcompList _channel Iuser nil [200 59] OBJ_ENABLE|OBJ_VISIBLE|LST_HIGHLIGHT_CLICKED|LST_LEFT OBJ_CONTAINER_DBLCLICK 239 215 (215/16) LST_VERTICAL myFont 40 [0 0 0 0] [0 50] [[238 0] OBJ_MW_FLEX|OBJ_MH_FLEX|OBJ_RH_FLEX|OBJ_LH_FLEX|SLB_MASK|SLB_ROLLOVER vlift230 [17 217 233]]; /* button to change server folder */ set SbuttonFolder = _CBcompRollOverClick (_CRcompRollOver _channel Iuser nil [4 0] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE 0 picto_retour) @cbSdownFolder nil; set ScomplistFolder = _CRcompList _channel Iuser nil [4 42] OBJ_ENABLE|OBJ_VISIBLE|LST_HIGHLIGHT_CLICKED|LST_LEFT OBJ_CONTAINER_DBLCLICK 190 280 (280/16) LST_VERTICAL myFont 40 [0 0 0 0] [0 50] [[175 0] OBJ_MW_FLEX|OBJ_MH_FLEX|OBJ_RH_FLEX|OBJ_LH_FLEX|SLB_MASK|SLB_ROLLOVER vlift280 [17 263 279]]; /* button to lauch the queue */ set gobutton = _CBcompRollOverClick ( _CRcompRollOver _channel Iuser nil [70 0] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE 0 picto_ok) @cbLauchQueue nil; /* button to stop the queue */ set stopbutton = _CBcompRollOverClick ( _CRcompRollOver _channel Iuser nil [116 0] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE 0 stopIMG) @cbStopQueue nil; /* button to remove a file */ set delbutton = _CBcompRollOverClick (_CRcompRollOver _channel Iuser nil [37 0] OBJ_ENABLE|OBJ_VISIBLE|ROL_MASK|ROL_DISABLE 0 picto_corbeille) @cbDelFile nil; /*label of the queue window */ set queueLB = _CRcompText _channel Iuser nil [205 25] OBJ_ENABLE|CT_LABEL 0 200 20 (_loc this "MQUEUE" nil) myFont [0 0 0 0] [0 0] nil nil; /*label of the queue window */ set wayLB = _CRcompText _channel Iuser nil [201 42] OBJ_ENABLE|CT_LABEL 0 200 20 (_loc this "MWAY" nil) myFont [0 0 0 0] [0 0] nil nil; /*label of the queue window */ set nameLB = _CRcompText _channel Iuser nil [229 42] OBJ_ENABLE|CT_LABEL 0 200 20 (_loc this "MNAME" nil) myFont [0 0 0 0] [0 0] nil nil; /*label of the message window */ set stateLB = _CRcompText _channel Iuser nil [205 297] OBJ_ENABLE|CT_LABEL 0 200 20 (_loc this "MSTATE" nil) myFont [0 0 0 0] [0 0] nil nil; /*label of the size window */ set sizeLB = _CRcompText _channel Iuser nil [5 323] OBJ_ENABLE|CT_LABEL 0 200 20 (_loc this "MSIZE" nil) myFont [0 0 0 0] [0 0] nil nil; /* text where we write the sive of a selecte file */ set Tsize = _CRcompText _channel Iuser nil [5 343] OBJ_ENABLE|CT_LABEL 0 200 20 "" myFont [0 0 0 0] [0 0] nil nil; /* current folder on the server comptext */ set ScurrentListFolder = _CRcompText _channel Iuser nil [5 23] OBJ_ENABLE|CT_LABEL 0 190 20 (hd ScurrentFolder) myFont [0 0 0 0] [0 0] nil nil; /* tooltips */ CreateToolTip Iuser (_CONVERTcompRollOverToObjNode SbuttonFolder) (_loc this "FT_TOOL_FOLDER" nil); CreateToolTip Iuser (_CONVERTcompRollOverToObjNode delbutton) (_loc this "FT_TOOL_REMOVE_FILE" nil); CreateToolTip Iuser (_CONVERTcompRollOverToObjNode gobutton) (_loc this "FT_TOOL_LAUNCH" nil); CreateToolTip Iuser (_CONVERTcompRollOverToObjNode stopbutton) (_loc this "FT_TOOL_STOP" nil); CreateToolTip Iuser (_CONVERTcompTextToObjNode ScurrentListFolder) (_loc this "FT_TOOL_CURRENT" nil); /* callback */ _CBcompListDblClick ScomplistFolder @cbSExplor nil; _CBcompListClick ScomplistFolder @cbSelectFile nil; _CBcompListDblClick Mqueue @cbRemoveQueue nil; _CBwinDestroy Twindow @cbWinUserPreDestroy ftp_user::vlift50::vlift230::picto_retour::vlift280::picto_ok::stopIMG::picto_corbeille::nil; ); /* fill the complist */ apply_on_list SlistFolder @cbfillFile ScomplistFolder; apply_on_list transfertQueue @cbfillqueue nil; _PAINTcontainer Iuser; 0 ;; /******************************************************************************* when drag and drop win -> ObjWin : Twindow param -> parameter : not used x,y -> I I : position in the window list -> [P r1] : list of file drop ********************************************************************************/ fun cbTwindowDropFile (win, param, x, y, list) = if (list == nil) || (ScurrentFolder == nil) then if (ScurrentFolder == nil) then ( _DLGMessageBox _channel nil (_loc this "UHOME_TITLE" nil) (_loc this "UHOME_BODY" nil) 0; 0 ) else nil else ( let _getpack (hd list) -> open in if open == nil then ( _DLGMessageBox _channel nil (_loc this "FOLDER_TITLE" nil) (_loc this "FOLDER_BODY" nil) 0; 0 ) else ( set transfertQueue = listcat transfertQueue (mkQueue [(hd list) (_PtoScol (hd list)) (hd ScurrentFolder) 1])::nil; _ADDcompList Mqueue 500 [(_PtoScol (hd list)) uploadBMP]; _PAINTcontainer Iuser; 0 ); cbTwindowDropFile win param x y (tl list); 0 ) ;; /******************************************************************************* open the user interface from -> DMI : not used user -> User : the user that run the action action -> S : not used param -> S : not used others -> [User r1] : not used tag -> Tag : not used <- I : nothing special *******************************************************************************/ fun cbShow (from, action, param, others, tag) = let 462 -> w in let 366 -> h in if Twindow != nil then ( _SETfocus Twindow; 0 ) else ( set Twindow = _CRwindow _channel DMSwin nil nil w h WN_MENU+WN_MINBOX|WN_DRAGDROP "Transfert"; _CBwinSize Twindow @cbWinUserResize nil; _CBwinDropFile Twindow @cbTwindowDropFile nil; cbWinUserResize Twindow Twindow (w) (h); _DMSeventTag this "shown" nil nil nil; 0 ); _DMSsend this SsendFile [(hd ScurrentFolder)]; 0 ;; /******************************************************************************* close the user interface from -> DMI : not used user -> User : the user that run the action action -> S : not used param -> S : not used others -> [User r1] : not used tag -> Tag : not used <- I : nothing special *******************************************************************************/ fun cbHide (from, action, param, others, tag) = cbWinUserPreDestroy nil nil; 0 ;; /******************************************************************************* open the admistration interface param -> I : say if an other window is open *******************************************************************************/ fun __Admin (param) = if param == 1 then ( showAdmin; _DMSsend this SsendFolder [(hd currentFolder)] ) else if param == 2 then ( _DLGMessageBox _channel nil (_loc this "WARNING_TITLE" nil) (_loc this "WARNING_BODY" nil) 0; 0 ) else nil; 0 ;; /******************************************************************************* list to auth *******************************************************************************/ fun listToauth (list) = if list == nil then nil else let list -> [first [next q]] in [first (atoi next)]::(listToauth q) ;; /******************************************************************************* list to Tsfolder ********************************************************************************/ fun listToTsflder (list) = if list == nil then nil else let hd list -> first in let first -> [name [path q]] in (mkSfolder [name path (listToauth q)])::(listToTsflder (tl list)) ;; /******************************************************************************* show the list of folder ********************************************************************************/ fun __sendFolder (list) = set allServerFolder = listToTsflder (strextr list); _RSTcompList listAdminFolder; _RSTcompList listAuth; apply_on_list allServerFolder @cbfillServerFolder nil; _SETcompListClicked listAdminFolder listAdminSelectedPosition; cbChangeDirectoryAuthList listAdminFolder nil listAdminSelectedPosition; _SETcompListClicked listAuth 0; cbRefreshAuth listAuth nil 0; _SETcompText currentListFolder (hd currentFolder) myFont [0 0 0 0] 1; _PAINTcontainer Iadmin; 0 ;; /******************************************************************************* fill the slist whit file and folder of the server param -> list in string ********************************************************************************/ fun __sendFile (param) = if !strcmpi param "0" then (set SlistFolder = nil;0) else ( let lineextr param -> [name [path [file [size _]]]] in set SlistFolder = (mkSfile [(findName name) path (atoi file) (atoi size)])::SlistFolder; _RSTcompList ScomplistFolder; apply_on_list SlistFolder @cbfillFile ScomplistFolder; _PAINTcontainer Iuser; 0 ) ;; /******************************************************************************* destroy all alphabitmap before destroy the client *********************************************************************************/ fun __destroy () = _DSalphaBitmap closedBMP; _DSalphaBitmap sclosedBMP; _DSalphaBitmap writeBMP; _DSalphaBitmap readBMP; _DSalphaBitmap readwriteBMP; _DSalphaBitmap uploadBMP; _DSalphaBitmap downloadBMP; 0 ;; /******************************************************************************* Global comments about the SCOL file structure parameter -> S : String sent by the server by calling _DMScreateClientDMI <- I : nothing special *******************************************************************************/ fun IniDMI (parameter) = set modulePath = _DMSgetpath _DMSgetClass this; /*chargement des images */ set closedBMP = _LDalphaBitmap _channel _checkpack strcat modulePath "images/closed.png"; set sclosedBMP = _LDalphaBitmap _channel _checkpack strcat modulePath "images/sclosed.png"; set writeBMP = _LDalphaBitmap _channel _checkpack strcat modulePath "images/write.png"; set readBMP = _LDalphaBitmap _channel _checkpack strcat modulePath "images/read.png"; set readwriteBMP = _LDalphaBitmap _channel _checkpack strcat modulePath "images/readwrite.png"; set uploadBMP = _LDalphaBitmap _channel _checkpack strcat modulePath "images/upload.png"; set downloadBMP = _LDalphaBitmap _channel _checkpack strcat modulePath "images/download.png"; _DMSdefineActions this (["show" @cbShow]):: (["hide" @cbHide]):: nil; set myFont = (_CRfont _channel 14 0 0 "Arial"); 0 ;;