/******************************************* Module DBdisplay Server Version: 1.0 Authors: Thierry LEFORT, Michel Paillet Last update: 05/28/2001 *******************************************/ var EDITFLAG=0;; var DBFLAG=1;; typeof db=SqlDB;; defcom SAffichePush=AffichePush I;; typeof attribute=S;; typeof over=I;; typeof numberpack=I;; typeof products=[[S r1] r1];; typeof list_attributs =S;; typeof alias = S;; typeof login = S;; typeof password = S;; typeof table = S;; typeof AttrListe = S;; typeof AttrEvent = S;; typeof ListeName = [S r1];; typeof ListeAtributs = [S r1];; typeof QueryReq = S;; typeof List_Admin = [CLIENT r1];; typeof Precision =[[S r1] r1];; defcom SErrorDB = ErrorDB S;;/*Send an error message to client*/ defcom SreponseFill = reponseFill S I I;; defcom SreponseAfficheUpdate = reponseAfficheUpdate I S;; defcom SreponseAfficheDelete = reponseAfficheDelete I S;; defcom Srefresh = refreshfromDB;; defcom SsetAttributes = setAttributes S S;; defcom SshowAdmin = showAdmin ;; defcom SshowUser = showUser ;; var CELL=0;; var SHELVE=1;; var PRODUCTSHELVE=2;; var PRODUCT=3;; var DIMENSION=4;; var TEXTURE=5;; var DIMENSIONSELECT=6;; var TEXTURESELECT=7;; var UPDATESHELVE=8;; var AFFICHEDIRECT=0;; var AFFICHEINSERT=1;; var AFFICHEUPDATE=2;; var AFFICHEDELETE=3;; var NO_AFFICHE=4;; var RAZ=0;; var NO_RAZ=1;; var raz=0;; var COMMITOFF=0;; var COMMITON=1;; var NO_ERREURDB=0;; var ERREURDB=1;; var erreurSql=0;; var NUM="0";; var CHAR="1";; var LONGVARCHAR="2";; typeof listEnvoie=[[S r1] r1];; var length=0;; typeof alreadyshown= I;; /*****************************************************************/ fun is_in_list (l, x)= if l==nil then 0 else let l->[a nxt] in (a==x)||is_in_list nxt x;; fun listlength(l)= if l==nil then 0 else let l->[_ n] in 1+listlength n;; /*********************************************************************************************/ /********** DATA CREATION FOR PRODUCTS *******************/ /*********************************************************************************************/ fun testString(string)= if !strcmp string nil then "" else string ;; fun Connexion() = set db = SqlCreate _channel testString alias testString login testString password ;; /*********************************************************************************************/ /********** DB REQUEST TOOLS *******************/ /*********************************************************************************************/ /*This function is used to send the result of a request in several packages*/ /*the flag raz enable to remove all elements from a complist or a combo*/ fun _EnvoieDB(db,param,ligne)= let param -> [Type Affichage MyClient] in if Affichage == AFFICHEINSERT then _DMSsend this MyClient SreponseFill [strbuild ligne::nil Type raz] else if Affichage == AFFICHEDIRECT then let length + strlen linebuild ligne -> l in if (l > 3000) then (_DMSsend this MyClient SreponseFill [strbuild listEnvoie Type raz]; set raz = NO_RAZ; set listEnvoie = ligne::nil; 0) else (set listEnvoie = ligne::listEnvoie; 0) else nil ;; /*Function which treat the list of paramater of a query and retype them*/ fun SqlList(listIndex,listType)= if listIndex == nil then nil else if !strcmp (hd hd listType) NUM then (SQL_NUMERIC hd hd listIndex)::SqlList tl listIndex tl listType else if !strcmp (hd hd listType) LONGVARCHAR then (SQL_LONGVARCHAR hd hd listIndex)::SqlList tl listIndex tl listType else (SQL_CHAR hd hd listIndex)::SqlList tl listIndex tl listType ;; /*Function which prepare the request and treat the result*/ fun Query(Request,Type,ListIndex,ListType,Affichage,Com, MyClient)= if erreurSql == ERREURDB then if Com == COMMITOFF then nil else set erreurSql = NO_ERREURDB else ( if Affichage==AFFICHEDIRECT then set raz=RAZ else set raz=NO_RAZ; set listEnvoie = nil; SqlFetch db @_EnvoieDB [Type Affichage MyClient]; SqlRequest db Request SqlList strextr ListIndex strextr ListType; if (SqlCod db) == SQL_ERROR then ( let SqlDescErr db -> [etat native message lignes] in _DMSsend this MyClient SErrorDB [message]; SqlRollback db; set erreurSql = ERREURDB ) else (if Com == COMMITON then SqlCommit db else nil; if Affichage == AFFICHEUPDATE then _DMSsend this MyClient SreponseAfficheUpdate[Type ListIndex] else if Affichage == AFFICHEDELETE then _DMSsend this MyClient SreponseAfficheDelete[Type ListIndex] else if listEnvoie != nil then _DMSsend this MyClient SreponseFill [strbuild listEnvoie Type raz] else if (listEnvoie == nil)&&(raz==RAZ) then _DMSsend this MyClient SreponseFill [nil Type raz] else nil) ) ;; fun __queryProduct()= Query QueryReq PRODUCT nil nil AFFICHEDIRECT COMMITON DMSsender ;; /*********************************************************************************************/ /********** COMMUNICATION *******************/ /*********************************************************************************************/ fun Find_index (liste, elem) = if liste ==nil then 0 else if !strcmp elem hd liste then 0 else 1 + (Find_index tl liste elem) ;; fun PrePrec (liste, list_prec)= if list_prec ==nil then nil else let hd list_prec -> tete in let hd tete -> table in let hd tl tete -> prec in let Find_index lineextr list_attributs table -> index in if index == 0 then nil else ((nth_list liste index)::(prec)::nil)::(PrePrec liste tl list_prec) ;; fun activate(from,cli,action,param,rep)= /* recoit tous les messages actions (définis par registerDMI)*/ if !strcmp action "start" then ( _DMScreateClientDMI this cli strbuild (PrePrec ListeName Precision); _DMSsend this cli SsetAttributes [linebuild ListeName AttrEvent] ) else if !strcmp action "refreshfromDB" then ( _DMSsend this cli Srefresh []; 0 ) else if !strcmp action "show.user" then ( set List_Admin = remove_from_list List_Admin cli; _DMSsend this cli SshowUser []; 0 ) else if !strcmp action "show.admin" then ( set List_Admin = listcat cli::nil remove_from_list List_Admin cli; _DMSsend this cli SshowAdmin []; 0 ) else 1 ;; fun logout(cli)= set List_Admin = remove_from_list List_Admin cli; _DMSevent this cli "destroy" nil nil;; /*********************************************************************************************/ /********** INIT MODULE INSTANCE SERVER *******************/ /*********************************************************************************************/ /*************************************************************************** Renvoie le login ou le password d'une base de donnees, on specifie l'alias dans odbcAlias, l'info que l'on souhaite reccueillir dans info ("login" ou "password") les valeurs sont recuperees dans usmress.ini format : odbc.odbcAlias.login odbc.odbcAlias.password attention : odbcAlias, infos ne doivent pas contenir les caracteres suivants : ".*?" ****************************************************************************/ fun GetODBCInfos(odbcAlias,info)= hd switchstr strextr _loadressini strcatn "odbc."::odbcAlias::"."::info::nil ;; fun IniDMI2(file)= let strextr _getpack _checkpack file ->param in ( set alias = (getInfo param "alias"); set login= GetODBCInfos alias "login"; set password = GetODBCInfos alias "password"; set table = (getInfo param "table"); set AttrListe = (getInfo param "AttrListe"); set AttrEvent = (getInfo param "AttrEvent"); set ListeName = lineextr (getInfo param "ListeName"); set list_attributs = (getInfo param "ListeCombo"); set Precision = strextr (getInfo param "listePrec"); set QueryReq = strcatn (getInfo param "SQLlabel")::" "::(getInfo param "SQLfin")::nil ); Connexion; _DMSregisterDMI this @activate @logout nil nil ;; fun pro () = let BigToAsc BigInvn BigFromAsc _getpack _checkpack "dms/db/dbdisplay/dbdisplay.conf" BigFromAsc "db06414e70b5249d" -> s in let if (strlen s)!=9 then nil else [htoi substr s 1 4 htoi substr s 5 4] -> [datedebut periode] in if periode==nil then (_adderror strcatn (_loc this "PRO_MODULE" nil)::" "::(_DMSgetName this)::" : "::(_loc this "PRO_INVALID_MSG" nil)::nil;0) else if periode==0 then 1 else let ((time>>1)&0x3fffffff)/43200-datedebut -> x in if x<0 then (_adderror strcatn (_loc this "PRO_MODULE" nil)::" "::(_DMSgetName this)::" : "::(_loc this "PRO_INVALID_MSG" nil)::nil;0) else if x<=periode then (_addwarning strcatn (_loc this "PRO_MODULE" nil)::" "::(_DMSgetName this)::" : "::(_loc this "PRO_LIMITED_MSG" (itoa (periode-x))::nil)::nil;1) else (_adderror strcatn (_loc this "PRO_MODULE" nil)::" "::(_DMSgetName this)::" : "::(_loc this "PRO_ENDLIMITED_MSG" nil)::nil;0) ;; /* Server initialisation */ fun IniDMI (f) = if pro then IniDMI2 f else nil ;; fun __pushClickOnProductInList (param) = if is_in_list List_Admin DMSsender then _DMSeventTag this CtoU DMSsender "pushClickOnProductInList" param nil nil else nil ;; fun __pushDblclickOnProductInList (param) = if is_in_list List_Admin DMSsender then _DMSeventTag this CtoU DMSsender "pushDblclickOnProductInList" param nil nil else nil ;;