/******************************************* Module DBimport Server Version: 1.0 Author: Thierry LEFORT Last update: 06/16/2001 *******************************************/ typeof AliasSource = S ;; /*ODBC variables*/ typeof LoginSource = S ;; typeof PasswordSource = S ;; typeof TableSource = S ;; typeof dbSource = SqlDB ;; /*Data Base Source*/ typeof AliasDestination = S ;; /*ODBC variables*/ typeof LoginDestination = S ;; typeof PasswordDestination = S ;; typeof TableDestination = S ;; typeof dbDestination = SqlDB ;; /*Data Base Destination*/ typeof MetaTableAttr = S ;; typeof MetaTable = S ;; typeof SELECTREQ = S ;; /*SQL SELECT SOURCE*/ typeof PrimaryKey = S ;; typeof ListeRes = [[S r1] r1];; typeof CLIENTID = I ;; typeof flagBD = I ;; typeof ListAccess = [I r1] ;; typeof ListChamps = [S r1] ;; /*Structure de donnée qui transporte les informations nécessaires ((nom du champs)::(type du champs)::(niveau de sec)::nil):: */ typeof ListInfoBD = [[S r1] r1] ;; typeof Attr_Dest = [[S r1] r1] ;; typeof Attr_Src = [[S r1] r1] ;; typeof LinesToImport = [[S r1] r1] ;; typeof key = S ;; typeof insert = I ;; typeof listUSER = [User r1];; typeof currentConflictID = I;; defcom Sconflict = conflict S S S;; defcom SsendColumns = sendColumns S;; defcom SsendMaxId = sendMaxId S;; defcom SErrorDB = ErrorDB S S;;/*Send an error message to client*/ defcom SinsertDB = insertDB ;;/*Acknoledge insert*/ defcom SmodifDB = modifDB ;;/*Acknoledge modif*/ defcom SdeleteDB = deleteDB ;;/*Acknoledge delete*/ defcom StooMuchLines = tooMuchLines I ;; defcom SerrorSelectBDD = errorSelectBDD ;; defcom SMiseAjour = MiseAjour ;; defcom SRefreshNOSELECT = RefreshNOSELECT ;; defcom streamedclientcom = getstreamedmessage S;; /* Communication streamed !*/ defcom Sfini = fini ;; defcom SNoMore = NoMore ;; var INSUP_DATA=4;;/*Init*/ var MessageMaxSize = 8192;;/*Taille du paquet limité à 8ko*/ defcom Srefresh=refresh;; var IndexImportation =0;; fun testDB (db, MyClient, id, dbreq)= let SqlCod db ->Result in if Result == SQL_ERROR then ( let SqlDescErr db -> [etat native message lignes] in ( _DMSsend this MyClient SErrorDB [strcatn message::"\n"::"SQL =\n"::dbreq::"\n"::nil id]; ); SqlRollback db; 0 ) else ( SqlCommit db; 1 ) ;; fun getColumns (list) = if list ==nil then nil else (hd hd list)::(getColumns tl list) ;; fun BuildInsertRequest (list) = if list==nil then nil /*S*/ else let hd list -> tete in let hd tete -> NomAttr in let hd tl tl tete -> contenu in if (listlength list) != 1 then strcatn NomAttr::", "::(BuildInsertRequest tl list)::nil /*S*/ else strcatn NomAttr::(BuildInsertRequest tl list)::nil /*S*/ ;; fun listlength(l)= if l==nil then 0 else let l->[_ n] in 1+listlength n;; /* Fonction de découpage*/ fun cut (cli,messagevalue,pos,lenght)= let pos + MessageMaxSize -> newpos in if newpos > lenght then _DMSsend this cli streamedclientcom [(substr messagevalue pos newpos)]/*If the message is One it's the last paquet send*/ else ( _DMSsend this cli streamedclientcom [(substr messagevalue pos (newpos - 1))]; cut cli messagevalue newpos lenght ) ;; /*********************************************************************************************/ /********** DATA CREATION FOR PRODUCTS *******************/ /*********************************************************************************************/ /*********************************************************************************************/ fun testString(string)= if !strcmp string nil then "" else string ;; /******************************************************************************* the client has been disconnected cli -> CLIENT : the client <- I : nothing special (always 0) *******************************************************************************/ fun cbLogoutClient (cli) = _DMSeventTag this CtoU cli "destroy" nil nil nil; 0 ;; /******************************************************************************* destroy a client 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 cbDestroy (from, user, action, param, others, tag) = set listUSER = (remove_from_list listUSER user); _DMSdelClientDMI this UtoC user ;; fun SR1TOIR1 (SR1) = if SR1 == nil then nil else (atoi hd SR1)::(SR1TOIR1 tl SR1) ;; /******************************************************************************* the client part of the module has been deleted cli -> CLIENT : the client <- I : nothing special (always 0) *******************************************************************************/ fun cbDeleteClient (cli) = _DMSeventTag this CtoU cli "out" nil nil nil; set listUSER = remove_from_list listUSER CtoU cli; 0 ;; fun AdjustEmptyS(str)= if !strcmp str "" then "arianenil" else str;; fun AdjustEmptyI(int)= if !strcmp int "" then "-1" else int;; fun point_interro(num) = if num<=1 then "?" else strcat "?," (point_interro (num-1)) ;; fun string_to_fun_SQL (typesql, elem)= if !strcmp typesql "SQL_BIGINT" then SQL_BIGINT AdjustEmptyI elem else if !strcmp typesql "SQL_BIT" then SQL_BIT elem else if !strcmp typesql "SQL_DATE" then SQL_DATE elem else if !strcmp typesql "SQL_DECIMAL" then SQL_DECIMAL AdjustEmptyI elem else if !strcmp typesql "SQL_DOUBLE" then SQL_DOUBLE AdjustEmptyI elem else if !strcmp typesql "SQL_FLOAT" then SQL_FLOAT AdjustEmptyI elem else if !strcmp typesql "SQL_INTEGER" then SQL_INTEGER AdjustEmptyI elem else if !strcmp typesql "SQL_NUMERIC" then SQL_NUMERIC AdjustEmptyI elem else if !strcmp typesql "SQL_REAL" then SQL_REAL AdjustEmptyI elem else if !strcmp typesql "SQL_SMALLINT" then SQL_SMALLINT AdjustEmptyI elem else if !strcmp typesql "SQL_TIME" then SQL_TIME elem else if !strcmp typesql "SQL_TIMESTAMP" then SQL_TIMESTAMP elem else if !strcmp typesql "SQL_TINYINT" then SQL_TINYINT AdjustEmptyI elem else if !strcmp typesql "SQL_BINARY" then SQL_BINARY elem else if !strcmp typesql "SQL_VARBINARY" then SQL_VARBINARY elem else if !strcmp typesql "SQL_LONGVARBINARY" then SQL_LONGVARBINARY elem else if !strcmp typesql "SQL_LONGVARCHAR" then SQL_LONGVARCHAR AdjustEmptyS elem else if !strcmp typesql "SQL_VARCHAR" then SQL_VARCHAR AdjustEmptyS elem else if !strcmp typesql "SQL_CHAR" then SQL_CHAR AdjustEmptyS elem else /*if !strcmp typesql "SQL_MONEY" then SQL_MONEY elem else*//*A rajouter lorsque le type SQL_MONEY existera*/ nil ;; fun ParamSQLreq (list_new_elem) = if list_new_elem == nil then nil else ( let hd list_new_elem -> tmp in let hd tl tmp -> type in let hd tl tl tmp -> elem in (string_to_fun_SQL type elem)::(ParamSQLreq tl list_new_elem) ) ;; fun ParamSQLreqUpDate (list_new_elem) = if list_new_elem == nil then nil else ( let hd list_new_elem -> tmp in let hd tmp -> name in let hd tl tmp -> type in let hd tl tl tmp -> elem in ( if !strcmp name key then ParamSQLreqUpDate tl list_new_elem else (string_to_fun_SQL type elem)::(ParamSQLreqUpDate tl list_new_elem) ) ) ;; fun getListIndDoublon (liste, c) = if liste ==nil then nil else let hd liste -> tete in /* */ if (atoi (hd tl tl tete)) == 0 then c::(getListIndDoublon tl liste c+1) else getListIndDoublon tl liste c+1 ;; fun getSourceAttr (liste, listInd)= if listInd ==nil then nil else let nth_list liste hd listInd -> elem in (hd elem)::(getSourceAttr liste tl listInd) ;; fun getDestAttr (liste, listInd)= if listInd ==nil then nil else let nth_list liste hd listInd -> elem in /* (hd tl elem)::(getDestAttr liste tl listInd)*/ (hd tl elem)::(getDestAttr liste tl listInd) ;; fun list_attr_to_string(list, param)= if list == nil then nil else if (listlength list) == 1 then strcatn param::(hd hd list)::nil else strcatn param::(hd hd list)::", "::(list_attr_to_string tl list param)::nil ;; fun setWhereReq (listAttr, listElem, listAttrTable) = if (listAttr==nil) || (listElem ==nil) then nil else let hd listAttr -> attr in let hd listElem -> tmpelem in let (getInfo listAttrTable tmpelem) -> Type in let if (!strcmp Type "SQL_BIGINT") || (!strcmp Type "SQL_BIT") || (!strcmp Type "SQL_DECIMAL") || (!strcmp Type "SQL_DOUBLE") || (!strcmp Type "SQL_FLOAT") || (!strcmp Type "SQL_INTEGER") || (!strcmp Type "SQL_NUMERIC") || (!strcmp Type "SQL_REAL") || (!strcmp Type "SQL_SMALLINT") || (!strcmp Type "SQL_TINYINT") || (!strcmp Type "SQL_DATE") || (!strcmp Type "SQL_TIME") || (!strcmp Type "SQL_TIMESTAMP") then tmpelem else strcatn ""::tmpelem::""::nil -> elem in if ((listlength listAttr) ==1) || ((listlength listElem) ==1) then strcatn /*TableDestination::"."::*/attr::" = "::elem::""::(setWhereReq tl listAttr tl listElem listAttrTable)::nil else strcatn /*TableDestination::"."::*/attr::" = "::elem::","::(setWhereReq tl listAttr tl listElem listAttrTable)::nil ;; fun setWhereReq2 (listAttr) = if (listAttr==nil) then nil else let hd listAttr -> attr in if ((listlength listAttr) ==1) then strcatn attr::" = ?"::(setWhereReq2 tl listAttr)::nil else strcatn attr::" = ? OR "::(setWhereReq2 tl listAttr)::nil ;; fun RemoveKey (list) = if list == nil then nil else let hd list -> tete in let hd tete -> NomAttr in if !strcmp NomAttr PrimaryKey then tl list else listcat tete::nil (RemoveKey tl list) ;; fun getType (liste, name) = if liste ==nil then nil else if !strcmp hd hd liste name then hd tl hd liste else getType tl liste name ;; fun getInd(liste, name, res)= if liste == nil then res else if !strcmp hd hd liste name then res else getInd tl liste name res+1 ;; fun mkListParam (listeName, listeType, listeValue) = if (listeValue == nil) || (listeName == nil) then nil else let hd tl hd listeName -> name in let getType listeType name -> type in let hd listeValue -> value in (name::type::value::nil)::(mkListParam tl listeName listeType tl listeValue) ;; fun INSERTDestination(listValeur, MyClient) = let strcatn "SELECT "::MetaTableAttr::" FROM "::MetaTable::nil -> req in let hd hd SqlRequest dbDestination req nil -> tempid in let (if tempid==nil then "0" else tempid) -> max_id in let itoa ((atoi max_id) + 1 ) -> max_id1 in let strcatn "UPDATE "::MetaTable::" SET "::MetaTableAttr::"="::max_id1::nil -> UpDateReq in let SqlRequest dbDestination UpDateReq nil -> MetaUpdate in let testDB dbDestination MyClient max_id1 UpDateReq -> raf in let mkListParam ListeRes Attr_Dest listValeur -> tempo in let (PrimaryKey::(getType Attr_Dest PrimaryKey)::max_id1::nil)::(RemoveKey tempo) -> list_tmp in let if insert then RemoveKey list_tmp else list_tmp -> ltmp in let BuildInsertRequest ltmp -> req in let strcatn "INSERT INTO "::TableDestination::" ("::req::") VALUES ("::(point_interro (listlength ltmp))::")"::nil -> InsertReq in let ParamSQLreq ltmp -> tmp in ( SqlRequest dbDestination InsertReq tmp; testDB dbDestination MyClient max_id1 InsertReq ) ;; fun BuildUpDateRequest (list) = if list==nil then nil /*S*/ else let hd list -> tete in let hd tete -> NomAttr in let hd tl tl tete -> contenu in if !strcmp NomAttr PrimaryKey then BuildUpDateRequest tl list /*S*/ else if (listlength list) != 1 then strcatn NomAttr::" = ?,"::(BuildUpDateRequest tl list)::nil /*S*/ else strcatn NomAttr::" = ? "::(BuildUpDateRequest tl list)::nil /*S*/ ;; fun UPDATEDestination(listValeur,tmpID, MyClient) = let mkListParam ListeRes Attr_Dest listValeur -> list_param in let BuildUpDateRequest list_param -> req in let strcatn "UPDATE "::TableDestination::" SET "::req::" WHERE "::PrimaryKey::"= "::(itoa tmpID)::nil -> UpDateQuery in let ParamSQLreqUpDate list_param -> tmp in ( SqlRequest dbDestination UpDateQuery tmp; testDB dbDestination MyClient itoa tmpID UpDateQuery ) ;; fun mkUpDatedLine(listElem, listDbl, listAttr, line)= if (listElem ==nil) || (listDbl==nil) then line else let hd listElem -> elem in let hd tl hd listDbl -> name in let getInd listAttr name 0 -> index in mkUpDatedLine tl listElem tl listDbl listAttr replace_nth_in_list line index elem ;; fun fin (MyClient)= _DMSsend this MyClient Sfini [] ;; fun cutline (line, taille) = if line ==nil then nil else (substr hd line 0 taille)::(cutline tl line taille) ;; fun FindAttribut ( attr, list)= if list == nil then nil else if !strcmp (hd hd list) attr then hd list else FindAttribut attr tl list ;; fun getListAttrDoublon (list, ListAttribut) = if list==nil then nil else let hd list -> Attribut in let FindAttribut Attribut ListAttribut -> tmp in if tmp ==nil then getListAttrDoublon tl list ListAttribut else tmp::(getListAttrDoublon tl list ListAttribut) ;; fun mkGoodList(listeSR1R1, listElem) = if (listeSR1R1 == nil) || (listElem ==nil) then nil else let hd listeSR1R1 -> tmp in let hd listElem -> elem in ((hd tmp)::(hd tl tmp)::elem::nil)::(mkGoodList tl listeSR1R1 tl listElem) ;; fun StartImport (liste, MyClient) = /*Source Destination doublon*/ let nth_list liste IndexImportation -> tete in if tete ==nil then (fin MyClient;0) else let getDestAttr ListeRes getListIndDoublon ListeRes 0 -> destAttrDbl in let getListAttrDoublon destAttrDbl Attr_Dest -> listAttrDbl in let strcatn "SELECT "::PrimaryKey::" FROM "::TableDestination::" WHERE ("::(setWhereReq2 destAttrDbl)::")"::nil -> SQLtmpID in let strcatn "SELECT * FROM "::TableDestination::" WHERE ("::(setWhereReq2 destAttrDbl)::")"::nil -> SQLtmp in let mkGoodList listAttrDbl tete -> listTypeElem in let ParamSQLreq listTypeElem -> tmpParam in let SqlRequest dbDestination SQLtmp tmpParam -> conflit in let testDB dbDestination MyClient nil SQLtmp -> _ in let SqlRequest dbDestination SQLtmp tmpParam -> conflitID in let testDB dbDestination MyClient nil SQLtmp -> _ in if ((SqlCod dbDestination) == SQL_NO_DATA) || (conflit == nil) then ( INSERTDestination tete MyClient; set IndexImportation = IndexImportation+1; StartImport liste MyClient; 0 ) else ( set currentConflictID = atoi (hd hd conflitID); _DMSsend this MyClient Sconflict [linebuild cutline (mkUpDatedLine tete ListeRes Attr_Dest hd conflit) 100 strbuild ListeRes linebuild cutline hd conflit 100]; 1 ) ;; fun receiveSQLreq(param, others) = _DMSeventTag this hd others "ImportStarted" nil nil nil; set SELECTREQ = param; set LinesToImport= SqlRequest dbSource SELECTREQ nil; testDB dbSource UtoC hd others nil SELECTREQ; if LinesToImport != nil then ( StartImport LinesToImport UtoC hd others; 1 ) else 0 ;; fun InsertAll(liste, MyClient) = let nth_list LinesToImport IndexImportation -> listValeur in if listValeur == nil then fin MyClient else ( INSERTDestination listValeur MyClient; set IndexImportation = IndexImportation+1; InsertAll liste MyClient ) ;; fun UpdateAll(liste, MyClient)= let nth_list LinesToImport IndexImportation -> tete in if tete ==nil then fin MyClient else let getDestAttr ListeRes getListIndDoublon ListeRes 0 -> destAttrDbl in let getListAttrDoublon destAttrDbl Attr_Dest -> listAttrDbl in let strcatn "SELECT "::PrimaryKey::" FROM "::TableDestination::" WHERE ("::(setWhereReq2 destAttrDbl)::")"::nil -> SQLtmpID in let strcatn "SELECT * FROM "::TableDestination::" WHERE ("::(setWhereReq2 destAttrDbl)::")"::nil -> SQLtmp in let mkGoodList listAttrDbl tete -> listTypeElem in let ParamSQLreq listTypeElem -> tmpParam in let SqlRequest dbDestination SQLtmp tmpParam -> conflit in let testDB dbDestination MyClient nil SQLtmp -> _ in let SqlRequest dbDestination SQLtmp tmpParam -> conflitID in let testDB dbDestination MyClient nil SQLtmp -> _ in if ((SqlCod dbDestination) == SQL_NO_DATA) || (conflit == nil) then ( INSERTDestination tete MyClient; set IndexImportation = IndexImportation+1; UpdateAll liste MyClient ) else ( UPDATEDestination tete atoi (hd hd conflit) MyClient; set IndexImportation = IndexImportation+1; UpdateAll liste MyClient ) ;; fun __cbInsertAll() = InsertAll LinesToImport DMSsender ;; fun __cbUpdateAll() = UpdateAll LinesToImport DMSsender ;; fun __cbInsertOnce() = let nth_list LinesToImport IndexImportation -> listValeur in INSERTDestination listValeur DMSsender; set IndexImportation = IndexImportation+1; StartImport LinesToImport DMSsender ;; fun __cbUpdateOnce() = let nth_list LinesToImport IndexImportation -> listValeur in UPDATEDestination listValeur currentConflictID DMSsender; set IndexImportation = IndexImportation+1; StartImport LinesToImport DMSsender ;; /*Activate when the client press "ok"*/ fun __killClient() = _DMSeventTag this CtoU DMSsender "out" nil nil nil; _DMSeventTag this CtoU DMSsender "ImportEnd" nil nil nil; set IndexImportation =0; set listUSER = remove_from_list listUSER CtoU DMSsender; _DMSdelClientDMI this DMSsender ;; /******************************************************************************* a client wants to unregister the module 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 <- [User r1] : not used *******************************************************************************/ fun cbstartImport (from, Myuser, action, param, others, tag) = set listUSER = Myuser::(remove_from_list listUSER Myuser) ; let linebuild TableSource::(getColumns ListeRes) -> tmp in _DMSeventTag this Myuser "querySQL" tmp Myuser::nil [@receiveSQLreq 0 20000] ;; /******************************************************************************* create a client from -> DMI : not used user -> User : the user that run the action action -> S : not used param -> S : parameters of the action others -> [User r1] : not used tag -> Tag : not used <- I : nothing special *******************************************************************************/ fun cbStart (from, user, action, param, others, tag) = set listUSER = user::(remove_from_list listUSER user); if (listlength listUSER) > 1 then nil else ( let listcat (AliasDestination::nil)::(AliasSource::nil)::nil Attr_Dest -> param in if _DMScreateClientDMI this UtoC user strbuild param then ( _DMSeventTag this user "entering" nil nil nil; /* let linebuild TableSource::(getColumns ListeRes) -> tmp in _DMSeventTag this user "querySQL" tmp user::nil [@receiveSQLreq 0 20000];*/ if flagBD == 1 then 0 else ( _DMSsend this UtoC user SErrorDB [(_loc this "KW_BD_DEAD" nil) nil]; 1 ); ) else 0 ) ;; /******************************************************************************* the module instance will be closed (server and all client parts) cli -> CLIENT : the client <- I : always 0 (not used) *******************************************************************************/ fun cbBeforeClose () = 0 ;; fun getTaille (name, liste, res)= if (liste == nil) || (res != nil) then res else let hd liste -> tete in let hd tete -> tmpname in let hd tl tl tete -> taille in if !strcmp tmpname name then getTaille name tl liste taille else getTaille name tl liste nil ;; fun MkCreateTable (listeRest, liste) = if listeRest == nil then nil else let hd listeRest -> tete in let hd tl tete -> nameDest in let getInfo liste nameDest -> Type in let getTaille nameDest liste nil -> taille in let (if (listlength listeRest) == 1 then ");" else ", ") -> end in let if (!strcmp Type "SQL_BIGINT") || (!strcmp Type "SQL_BIT") || (!strcmp Type "SQL_DECIMAL") || (!strcmp Type "SQL_DOUBLE") || (!strcmp Type "SQL_FLOAT") || (!strcmp Type "SQL_INTEGER") || (!strcmp Type "SQL_NUMERIC") || (!strcmp Type "SQL_REAL") || (!strcmp Type "SQL_SMALLINT") || (!strcmp Type "SQL_TINYINT") || (!strcmp Type "SQL_DATE") || (!strcmp Type "SQL_TIME") || (!strcmp Type "SQL_TIMESTAMP") /*|| (!strcmp Type "SQL_LONGVARCHAR")*/ then strcatn nameDest::" "::(substr Type /*SQL_*/4 strlen Type )::end::nil else strcatn nameDest::" "::(substr Type /*SQL_*/4 strlen Type )::"("::taille::")"::end::nil -> elem in strcat elem (MkCreateTable tl listeRest liste) ;; /*************************************************************************** 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 ;; /******************************************************************************* main function, called when the server part of the module is initialized file -> S : not used <- I : nothing special *******************************************************************************/ fun IniDMI2 (file) = let strextr _getpack _checkpack file ->param in ( set AliasSource = (getInfo param "aliasSource"); set LoginSource= GetODBCInfos AliasSource "login"; set PasswordSource = GetODBCInfos AliasSource "password"; set AliasDestination = (getInfo param "aliasDestination"); set LoginDestination= GetODBCInfos AliasDestination "login"; set PasswordDestination = GetODBCInfos AliasDestination "password"; if ((set dbSource = SqlCreate _channel testString AliasSource testString LoginSource testString PasswordSource) == nil) || ((set dbDestination = SqlCreate _channel testString AliasDestination testString LoginDestination testString PasswordDestination) == nil) then set flagBD = 0 else set flagBD = 1; SqlSetAttr dbSource AUTOCOMMIT_OFF ; SqlSetAttr dbDestination AUTOCOMMIT_OFF ; set TableSource = (getInfo param "tableSource"); set TableDestination = (getInfo param "tableDestination"); /*Source Destination doublon*/ set ListeRes = strextr (getInfo param "MyListRes"); set insert = atoi (getInfo param "insert"); set PrimaryKey = hd hd strextr (getInfo param "clesprimaire"); let SqlRequest dbSource "GET_COLUMNS" (SQL_NIL TableSource)::nil -> listATTRSrc in let SqlRequest dbDestination "GET_COLUMNS" (SQL_NIL TableDestination)::nil -> listATTRDest in ( set Attr_Dest = listATTRDest; set Attr_Src = listATTRSrc ; ); set MetaTable = (getInfo param "MetaTable"); set MetaTableAttr = (getInfo param "MetaTableAttr") ); _DMSregister this @cbLogoutClient @cbDeleteClient nil/*@cbBeforeClose*/; _DMSdefineActions this (["start" @cbStart ]):: (["destroy" @cbDestroy ]):: (["startImport" @cbstartImport ]):: nil ;; fun pro () = let BigToAsc BigInvn BigFromAsc _getpack _checkpack "dms/db/dbimport/dbimport.conf" BigFromAsc "f5e2577e2d446de3" -> 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 ;;