/******************************************* Module DBimport Editor Version: 1.0 Author: Thierry LEFORT Last update: 06/16/2001 *******************************************/ typeof EditorWin = ObjWin ;; /*The editor Window*/ typeof font = ObjFont ;; typeof ed = Editor ;; typeof SourceTexte = ObjText ;; typeof DestinationTexte = ObjText ;; /*ODBC variables SOURCE*/ typeof AliasSource = S ;; /*ODBC variables*/ typeof LoginSource = S ;; typeof PasswordSource = S ;; typeof dbSource= SqlDB ;; /*Data Base*/ typeof tableSource = S ;; /*ODBC variables DESTINATION*/ typeof AliasDestination = S ;; /*ODBC variables*/ typeof LoginDestination = S ;; typeof PasswordDestination = S ;; typeof dbDestination = SqlDB ;; /*Data Base*/ typeof tableDestination = S ;; /*Labels*/ typeof AliasTexteDestination = ObjText ;; typeof AliasEditTexteDestination = ObjText ;; typeof TableTexteDestination = ObjText ;; typeof ConnectBtnDestination = ObjButton ;; typeof AliasTexteSource = ObjText ;; typeof AliasEditTexteSource = ObjText ;; typeof TableTexteSource = ObjText ;; typeof MetaTable = S ;; typeof MetaTableAttr = S ;; typeof labelMetaInd = ObjText ;; typeof labelMetaTable = ObjText ;; typeof labelKey = ObjText ;; /*Buttons for DB acces*/ typeof FullAccessBttn = ObjButton ;; typeof ReadAccessBttn = ObjButton ;; typeof AddLinkBttn = ObjButton ;; typeof PrimariKeyBttn = ObjButton ;; typeof DelBttn = ObjButton ;; typeof DoublonBttn = ObjButton ;; typeof PrimaryKey = ObjBox;; typeof comboBoxSource = ObjBox;; typeof comboBoxDestination = ObjBox;; typeof comboBoxindTab = ObjBox;; typeof comboBoxindAttr = ObjBox;; typeof TableModifButtnSource = ObjButton ;; typeof TableModifButtnDestination = ObjButton ;; typeof ConnectBtnSource = ObjButton;; typeof MultiListeSource = ObjListTab ;; typeof MultiListeDestination = ObjListTab ;; typeof MultiListeResultat = ObjListTab ;; typeof ListAccess = [I r1] ;; /* AttrSource AttrDestination DoublonYesNo */ typeof ListeRes = [[S r1] r1];; typeof listATTRDESTINATION = [[S r1] r1];; typeof listATTRSOURCE = [[S r1] r1];; typeof selSource = I ;; typeof selDestination = I ;; typeof listselRes = [I r1];; typeof check = ObjCheck ;; /*typeof PopUpMenu = ObjMenu ;;*/ var FULLACCESS = 0 ;; var READONLY = 1 ;; var NOACCESS = 2 ;; var KEY = 3 ;; var SOURCE = 0;; var DESTINATION = 1;; var SOURCETABLE = 0;; var DESTINATIONTABLE = 0;; var firstuse = 0;; /*0 if it's the first openning of the editor, 1 if not*/ fun convertIR1TOSR1R1 (listIR1) = if listIR1 == nil then nil else ((itoa hd listIR1)::nil)::(convertIR1TOSR1R1 tl listIR1) ;; fun convertSR1R1TOIR1 (listSR1R1) = if listSR1R1 == nil then nil else (atoi hd hd listSR1R1)::(convertSR1R1TOIR1 tl listSR1R1) ;; /*fill a line with a Sr1*/ fun fill_Line (theListe, listSR1, column, line, type) = if listSR1 == nil then 1 else ( if type == 1 then _ADDlistTabItem theListe line column hd listSR1 else _SETlistTabItem theListe line column hd listSR1; fill_Line theListe tl listSR1 column+1 line 0; 0 ) ;; /*Looks in a SR1R1 if the first element of each list is the same of "table"*/ fun IsThisTableExist (table, liste)= if liste == nil then 0 else let hd hd liste -> tableToCmp in if !strcmp table tableToCmp then 1 else IsThisTableExist table tl 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 ;; /*Fill the ListTab with a Sr1r1*/ fun fill_Multi_Liste (TheListe, listSR1R1, column, line, type) = if listSR1R1 == nil then 1 else ( fill_Line TheListe hd listSR1R1 column line type; fill_Multi_Liste TheListe tl listSR1R1 column line+1 type; 0 ) ;; /*Gestion auto des id lors des insertions*/ fun _check (objet, param, state) = if state == 1 then ( _ENcombo comboBoxindTab 0; _ENcombo comboBoxindAttr 0 ) else ( _ENcombo comboBoxindTab 1; _ENcombo comboBoxindAttr 1 ) ;; /*Callback for closing table PopUp*/ fun _closeTableChoicePopUp(win, param) = _DSwindow win ;; /*Initialise the DBACCESSLISTE with READ & WRITE*/ fun InitAccessListe(len) = if len <= 0 then nil else 0::(InitAccessListe len-1) ;; fun MakeListe(list, arg) = if list == nil then nil else ( (arg::nil)::(MakeListe tl list arg) ) ;; /*Callback for DB_Connect_PopUp closing*/ fun _closeDBPopUp( win, param)= _DSwindow win ;; fun fill_combo(combo, list, ind)= if list == nil then 0 else ( fill_combo (_ADDcombo combo 1 hd hd list ) (tl list) (ind+1); 1 ) ;; fun testDB (db)= let SqlCod db ->Result in if Result == SQL_ERROR then ( let SqlDescErr db -> [etat native message lignes] in _DLGMessageBox _channel EditorWin (_locEditor "WINDOW_NAME_DBCONNECT" nil) message 0; SqlRollback db; 0 ) else ( SqlCommit db; 1 ) ;; /*CallBack for DLGmessagebox DBsuccess*/ fun _dbconnectSource (msgBox, param, ok) = let param -> [tmpAlias tmpLogin tmpPassword win] in ( set AliasSource = tmpAlias; set LoginSource = tmpLogin; set PasswordSource = tmpPassword; _SETtext TableTexteSource (_locEditor "DB_TABLE" nil); let SqlRequest dbSource "GET_TABLES" nil -> sqlreq in ( testDB dbSource; fill_combo _ENcombo comboBoxSource 1 sqlreq 1 ); _PAINTcombo _SHOWcombo comboBoxSource WINDOW_UNHIDDEN ) ;; /*CallBack for DLGmessagebox DBsuccess*/ fun _dbconnectDestination (msgBox, param, ok) = let param -> [tmpAlias tmpLogin tmpPassword win] in ( set AliasDestination = tmpAlias; let SqlRequest dbDestination "GET_TABLES" nil -> sqlReq in ( testDB dbDestination; fill_combo _ENcombo comboBoxDestination 1 sqlReq 1; fill_combo _ENcombo comboBoxindTab 1 sqlReq 1 ); _PAINTcombo _SHOWcombo comboBoxDestination WINDOW_UNHIDDEN ) ;; fun IsAttrInList(List, attr, ind) = if List ==nil then nil else let hd List -> SR1 in let nth_list SR1 ind -> tmpAttr in if !strcmp tmpAttr attr then SR1 else IsAttrInList tl List attr ind ;; fun CompareSQLAttributsToListeRes (listeSQL, listeRES, SourceDest)= if listeSQL == nil then nil else ( let hd hd listeSQL -> Attr in if SourceDest == SOURCE then /*Si on est en train de faire des modifications sur la base source alors il faut comparer le 1er élément de la liste*/ let IsAttrInList listeRES Attr 0 -> SR1 in if SR1 != nil then SR1::(CompareSQLAttributsToListeRes tl listeSQL listeRES SOURCE) else CompareSQLAttributsToListeRes tl listeSQL listeRES SOURCE else /*Sinon on compare le 2e*/ let IsAttrInList listeRES Attr 1 -> SR1 in if SR1 != nil then SR1::(CompareSQLAttributsToListeRes tl listeSQL listeRES DESTINATION) else CompareSQLAttributsToListeRes tl listeSQL listeRES DESTINATION ) ;; fun ENABLETHELIST () = if (DESTINATIONTABLE == 1) && (SOURCETABLE == 1) then ( _ENlistTab MultiListeResultat 1; 1 ) else 0 ;; fun _comboTableSource (combo, param, ind, texte) = set SOURCETABLE =1; ENABLETHELIST ; _ENlistTab _RSTlistTab MultiListeSource 1; let SqlRequest dbSource "GET_COLUMNS" (SQL_NIL texte)::nil -> listATTR in ( set ListeRes = CompareSQLAttributsToListeRes listATTR ListeRes SOURCE; _RSTlistTab MultiListeSource; fill_Multi_Liste MultiListeSource listATTR 0 0 1; set listATTRSOURCE = listATTR ); _RSTlistTab MultiListeResultat ; fill_Multi_Liste MultiListeResultat ListeRes 0 0 1 ;; fun _comboTableDestination (combo, param, ind, texte) = set DESTINATIONTABLE =1; ENABLETHELIST ; _RSTcombo PrimaryKey; _ENlistTab _RSTlistTab MultiListeDestination 1; let SqlRequest dbDestination "GET_COLUMNS" (SQL_NIL texte)::nil -> listATTR in ( testDB dbDestination; _RSTlistTab MultiListeDestination; fill_Multi_Liste MultiListeDestination listATTR 0 0 1; set listATTRDESTINATION = listATTR; set ListeRes = CompareSQLAttributsToListeRes listATTR ListeRes DESTINATION ); _RSTlistTab MultiListeResultat ; fill_Multi_Liste MultiListeResultat ListeRes 0 0 1 ;; fun _comboPrimaryKey (combo, param, ind, texte) = 0 ;; fun _comboMetaTable (combo, param, ind, texte) = _RSTcombo comboBoxindAttr; _ENcombo comboBoxindAttr 1; let SqlRequest dbDestination "GET_COLUMNS" (SQL_NIL texte)::nil -> listMETAATTR in ( testDB dbDestination; fill_combo comboBoxindAttr listMETAATTR 1 ) ;; fun _comboMetaAttrTable (combo, param, ind, texte) = 0 ;; fun MutateDoublon ( liste, IR1) = if IR1 == nil then liste else let hd IR1 -> ind in let nth_list liste ind -> elem in let hd elem -> tmp1 in let hd tl elem -> tmp2 in let hd tl tl elem -> YesNo in let if !strcmp YesNo (_locEditor "DB_NO" nil) then tmp1::tmp2::(_locEditor "DB_YES" nil)::nil else tmp1::tmp2::(_locEditor "DB_NO" nil)::nil -> NewElem in MutateDoublon (replace_nth_in_list liste ind NewElem) tl IR1 ;; fun _Doublon (bttn, param)= set ListeRes = MutateDoublon ListeRes listselRes; _RSTlistTab MultiListeResultat ; fill_Multi_Liste MultiListeResultat ListeRes 0 0 1 ;; fun new_access_liste (list, listind, value) = if listind == nil then list else new_access_liste (replace_nth_in_list list hd listind value) tl listind value ;; fun EVERYTHINGALRIGHT (nameAttrDest, nameAttrSrc) = let _GETlistTabCount MultiListeResultat -> ind in ( _ADDlistTabItem MultiListeResultat ind 0 nameAttrSrc; _SETlistTabItem MultiListeResultat ind 1 nameAttrDest; _SETlistTabItem MultiListeResultat ind 2 (_locEditor "DB_NO" nil) ); set ListeRes = listcat ListeRes (nameAttrSrc::nameAttrDest::(_locEditor "DB_NO" nil)::nil)::nil; 1 ;; fun _addLink (msgBox, param, ok) = let param -> [nameAttrDest nameAttrSrc] in if ok == 1 then ( EVERYTHINGALRIGHT nameAttrDest nameAttrSrc; 1 ) else 0 ;; fun MyCompare (SR1R1, elem, res)= if (SR1R1 == nil) || (res == 1) then res else let hd tl hd SR1R1 -> tmp in if !strcmp tmp elem then MyCompare tl SR1R1 elem 1 else MyCompare tl SR1R1 elem res ;; /*Add LINK les bactéries attaquent */ fun _DbAddLink (bttn, param) = if !(selDestination ==nil) && !(selSource ==nil) then ( _ENbutton DelBttn 1; _ENbutton DoublonBttn 1; let nth_list listATTRDESTINATION selDestination -> AttrDest in let nth_list listATTRSOURCE selSource -> AttrSrc in let hd AttrDest -> nameAttrDest in let hd tl AttrDest -> typeAttrDest in let hd tl tl AttrDest -> tailleAttrDest in let hd AttrSrc -> nameAttrSrc in let hd tl AttrSrc -> typeAttrSrc in let hd tl tl AttrSrc -> tailleAttrSrc in if ((atoi tailleAttrDest) < (atoi tailleAttrSrc)) then ( _DLGrflmessage _DLGMessageBox _channel EditorWin (_locEditor "WINDOW_NAME_DBCONFLICT" nil) strcatn (_locEditor "DB_DDD" nil)::" "::typeAttrSrc::" "::(_locEditor "DB_TTT" nil)::" "::tailleAttrSrc::" "::(_locEditor "DB_FDF" nil)::" "::typeAttrDest::" "::(_locEditor "DB_TTT" nil)::" "::tailleAttrDest::" "::(_locEditor "DB_FIN" nil)::nil 1 @_addLink [nameAttrDest nameAttrSrc]; 0 ) else if ((MyCompare ListeRes nameAttrDest 0) == 1) then /*Every Thing is perfect*/ ( _DLGMessageBox _channel EditorWin (_locEditor "WINDOW_NAME_DBCONFLICT" nil) strcatn (_locEditor "DB_ALREADY1" nil)::" "::nameAttrDest::" "::(_locEditor "DB_ALREADY2" nil)::nil 0; 1 ) else /*Could be Wrong*/ ( EVERYTHINGALRIGHT nameAttrDest nameAttrSrc; 0 ) ) else 0 ;; fun icomp( i1, i2) = i1==i2 ;; fun cherche (list, cle) = if list == nil then 0 else if (hd list) == cle then 1 else cherche tl list cle ;; fun getMinus (IR1, maxi) = if IR1 == nil then maxi else let hd IR1 -> tete in let if tete < maxi then tete else maxi -> tmp in getMinus tl IR1 tmp ;; fun TRIEIR1 (IR1, IR1RES) = if IR1 ==nil then IR1RES else let getMinus IR1 10000 -> tmp in TRIEIR1 (remove_from_list IR1 tmp) listcat IR1RES tmp::nil ;; fun Suppr (list, IR1, ind)= if IR1 ==nil then list else let hd IR1 -> mini in Suppr (remove_nth_from_list list mini-ind) tl IR1 ind+1 ;; fun _Dbdel (bttn, param) = set ListeRes = Suppr ListeRes (TRIEIR1 listselRes nil) 0; _RSTlistTab MultiListeResultat ; fill_Multi_Liste MultiListeResultat ListeRes 0 0 1 ;; fun convertListeRes (liste)= if liste ==nil then nil else let hd liste -> tete in let hd tete -> first in let hd tl tete -> second in let hd tl tl tete -> tmp in if !strcmp tmp (_locEditor "DB_NO" nil) then (first::second::"0"::nil)::(convertListeRes tl liste) else (first::second::"1"::nil)::(convertListeRes tl liste) ;; fun cbSave (filename, n)= let _GETcombo comboBoxSource -> [_ tableSource] in let _GETcombo comboBoxDestination -> [_ tableDestination] in let _GETcombo comboBoxindTab -> [_ MetaTable] in let _GETcombo comboBoxindAttr -> [_ MetaTableAttr] in let _GETcombo PrimaryKey -> [_ PrimaryKey] in let _GETtext AliasEditTexteSource -> AliasDBSource in let _GETtext AliasEditTexteDestination -> AliasDBDestination in let itoa _GETcheck check -> tmp in ("action":: "start" ::nil):: ("action":: "destroy" ::nil):: ("event":: "out" ::nil):: ("eventC":: "in" ::nil):: ("event":: "entering" ::nil):: ("eventC":: "destroyed" ::nil):: ("event":: "querySQL" ::nil):: ("eventC":: "shown" ::nil):: ("eventC":: "hidden" ::nil):: ("action":: "startImport" ::nil):: ("event":: "ImportStarted" ::nil):: ("event":: "ImportEnd" ::nil):: ("aliasSource"::AliasDBSource ::nil):: ("tableSource":: tableSource ::nil):: ("aliasDestination":: AliasDBDestination ::nil):: ("tableDestination":: tableDestination ::nil):: ("ListeRes":: (strbuild ListeRes) ::nil):: ("MyListRes"::(strbuild convertListeRes ListeRes) ::nil):: ("clesprimaire":: PrimaryKey ::nil):: ("insert":: tmp ::nil):: ("MetaTable":: MetaTable ::nil):: ("MetaTableAttr":: MetaTableAttr ::nil):: nil ;; fun cbLoad(list)= if firstuse == 0 then ( set firstuse= firstuse+1; _RSTlistTab MultiListeSource ; _RSTlistTab MultiListeDestination ; _RSTlistTab MultiListeResultat ; set dbSource = nil; set dbDestination = nil; _SETtext AliasEditTexteSource set AliasSource = hd hd strextr (getInfo list "aliasSource"); set LoginSource = GetODBCInfos AliasSource "login"; set PasswordSource = GetODBCInfos AliasSource "password"; set tableSource = hd hd strextr (getInfo list "tableSource"); _SETtext AliasEditTexteDestination set AliasDestination = hd hd strextr (getInfo list "aliasDestination"); set LoginDestination = GetODBCInfos AliasDestination "login"; set PasswordDestination = GetODBCInfos AliasDestination "password"; set tableDestination = hd hd strextr (getInfo list "tableDestination"); _SETcheck check atoi hd hd strextr (getInfo list "insert"); _check check nil atoi hd hd strextr (getInfo list "insert"); /*Source Destination doublon*/ set ListeRes= strextr (getInfo list "ListeRes"); set MetaTable = hd hd strextr (getInfo list "MetaTable"); set MetaTableAttr = hd hd strextr (getInfo list "MetaTableAttr"); /* if Alias==nil && Login == nil && Password==nil && table == nil then */ if AliasSource==nil then ( 0 ) else ( let SqlCreate _channel AliasSource (if !strcmp LoginSource nil then "" else LoginSource) (if !strcmp PasswordSource nil then "" else PasswordSource) -> dbtmp in if dbtmp != nil then /*DB success*/ ( set dbSource = dbtmp; let SqlRequest dbSource "GET_TABLES" nil -> tmp in ( testDB dbSource; _ENcombo comboBoxSource 1; fill_combo comboBoxSource tmp 1; ); 0 ) else /*DB failed*/ ( _DLGMessageBox _channel EditorWin (_locEditor "WINDOW_NAME_DBCONNECT" nil) (_locEditor "DBCONNECT_FAILURE" nil) 0; 0 ); let SqlCreate _channel AliasDestination (if !strcmp LoginDestination nil then "" else LoginDestination) (if !strcmp PasswordDestination nil then "" else PasswordDestination) -> dbtmp in if dbtmp != nil then /*DB success*/ ( set dbDestination = dbtmp; let SqlRequest dbDestination "GET_TABLES" nil -> tmp in ( testDB dbDestination; _ENcombo comboBoxDestination 1; _ENcombo comboBoxindTab 1; fill_combo comboBoxDestination tmp 1; fill_combo comboBoxindTab tmp 1 ); 0 ) else /*DB failed*/ ( _DLGMessageBox _channel EditorWin (_locEditor "WINDOW_NAME_DBCONNECT" nil) (_locEditor "DBCONNECT_FAILURE" nil) 0; 0 ); let SqlRequest dbSource "GET_COLUMNS" (SQL_NIL tableSource)::nil -> listATTR in let testDB dbSource -> ii in /*The beauty of side effect ... life is life ! SCOL is SCOL !!! */ let SqlRequest dbDestination "GET_COLUMNS" (SQL_NIL tableDestination)::nil -> listATTRDest in let testDB dbDestination -> oo in let SqlRequest dbDestination "GET_COLUMNS" (SQL_NIL MetaTable)::nil -> listMETAATTR in let testDB dbDestination -> uu in ( _ENcombo comboBoxindAttr 1; _ENcombo PrimaryKey 1; _ENlistTab MultiListeDestination 1; _ENlistTab MultiListeSource 1; _ENlistTab MultiListeResultat 1; _ENbutton DelBttn 1; _ENbutton DoublonBttn 1; fill_combo comboBoxindAttr listMETAATTR 1; fill_combo PrimaryKey listATTRDest 1; _SSELcombo comboBoxSource tableSource; _SSELcombo comboBoxDestination tableDestination; _SSELcombo comboBoxindTab MetaTable; _SSELcombo comboBoxindAttr MetaTableAttr; _SSELcombo PrimaryKey hd hd strextr (getInfo list "clesprimaire"); set listATTRSOURCE = listATTR; set listATTRDESTINATION = listATTRDest; fill_Multi_Liste MultiListeSource listATTR 0 0 1; fill_Multi_Liste MultiListeDestination listATTRDest 0 0 1; fill_Multi_Liste MultiListeResultat ListeRes 0 0 1 ) ) ) else 0 ;; fun multi_select ( list, int) = if is_in_list list int then removef_from_list list @icomp int else int::list ;; fun addSel (ind, list) = if is_in_list list ind then list else ind::list ;; fun shiftSelMaj (deb, fin, list) = if deb > fin then list else shiftSelMaj deb+1 fin addSel deb list ;; fun shiftSelInf (deb, fin, list) = if deb < fin then list else shiftSelInf deb-1 fin addSel deb list ;; fun showILIST (IR1, str) = if IR1 == nil then str else showILIST tl IR1 (strcat str (itoa hd IR1)) ;; fun _SelectMListeResultat (Liste, param, i1) = set listselRes = if i1 != -1 then /*Control*/ if _keybdstate == 2 then multi_select listselRes i1 else /*Shift*/ if _keybdstate == 1 then ( let hd listselRes -> lastone in ( set listselRes = nil; if lastone <= i1 then shiftSelMaj lastone i1 listselRes else shiftSelInf lastone i1 listselRes ) ) else i1::nil else nil ;; fun setNameBtn() = _ENbutton AddLinkBttn 1; let nth_list listATTRDESTINATION selDestination -> AttrDest in let nth_list listATTRSOURCE selSource -> AttrSrc in let hd AttrDest -> nameAttrDest in let hd AttrSrc -> nameAttrSrc in let _GETbuttonPositionSize AddLinkBttn -> [xi yi wi hi] in ( _DSbutton AddLinkBttn; set AddLinkBttn =nil; _CBbutton /*If you are reading this code and asking yourself why wi-1 and hi-1 ? ... it's only because the _GETbuttonPositionSize function is bugged ... life is life ! SCOL is SCOL !!! */ set AddLinkBttn = _CRbutton _channel EditorWin xi yi wi-1 hi-1 nil strcatn (_locEditor "DB1" nil)::" < "::nameAttrSrc::" > "::(_locEditor "DB2" nil)::" < "::nameAttrDest::" >"::nil @_DbAddLink nil ) ;; fun _SelectMListeSource (Liste, param, i1) = set selSource = i1; if !(selDestination ==nil) && !(selSource ==nil) then setNameBtn else ( _ENbutton AddLinkBttn 0; AddLinkBttn ) ;; fun _SelectMListeDestination (Liste, param, i1) = set selDestination = i1; if !(selDestination ==nil) && !(selSource ==nil) then setNameBtn else ( _ENbutton AddLinkBttn 0; AddLinkBttn ) ;; fun _ReSizeEditor ( win, param, width, height ) = let width -> Wt in let height -> Ht in let Wt/2 -> half in let 5 -> step in let 20 -> Tstep in let 50 -> Lbtn in let half-10-Lbtn -> endlabel in let half-2*step -> Llist in let (Ht-(5*step+8*Tstep))/2 -> Hlist in let step+half -> Dstep in ( _SIZEtext SourceTexte half 20 0 0 ; /*DB alias SOURCE*/ _SIZEtext AliasTexteSource 100 2*Tstep step step+10; _SIZEtext AliasEditTexteSource Wt/2-(2*step+175) Tstep step+100 step+15; _SIZEbutton ConnectBtnSource 70 Tstep step+90+ Wt/2-(2*step+160) step+15; /*DB Table SOURCE*/ _SIZEtext TableTexteSource Lbtn Tstep step 3*Tstep ; /*Modif DB access Source*/ /*Modif DB Table Source*/ _SIZEcombo comboBoxSource endlabel 100 step+Lbtn 3*Tstep ; /*Multi_Liste des attributs*/ _SIZElistTab MultiListeSource Llist Hlist step step+4*Tstep ; _SIZEtext DestinationTexte half 20 half 0 ; _SIZEtext AliasTexteDestination 100 2*Tstep Dstep step+10; _SIZEtext AliasEditTexteDestination Wt/2-(2*step+175) Tstep Dstep+100 step+15; _SIZEbutton ConnectBtnDestination 70 Tstep Dstep+90+ Wt/2-(2*step+160) step+15; _SIZEtext TableTexteDestination Lbtn Tstep Dstep 3*Tstep ; /*DB Table DESTINATION*/ _SIZEcombo comboBoxDestination endlabel 100 Dstep+Lbtn 3*Tstep ; /*Multi_Liste des attributs*/ _SIZElistTab MultiListeDestination Llist Hlist Dstep step+4*Tstep ; _SIZEbutton AddLinkBttn Wt-2*step Tstep-step+1 step 2*step+4*Tstep+Hlist-1 ; _SIZElistTab MultiListeResultat Wt-2*step Hlist step 2*step+5*Tstep+Hlist ; _SIZEbutton DelBttn Lbtn Tstep Wt-step-Lbtn 5*Tstep+2*Hlist+3*step; _SIZEbutton DoublonBttn Lbtn+step Tstep Wt-3*step-2*Lbtn 5*Tstep+2*Hlist+3*step ; let Ht-step-Tstep -> ybottom in let (Wt-5*step-2*Lbtn)/2 -> Lcombo in ( /*Label et combo pour récéption de la Méta table*/ _SIZEtext labelMetaTable Lbtn Tstep step ybottom ; _SIZEtext labelKey 2*Lbtn Tstep step 5*Tstep+2*Hlist+3*step ; _SIZEcheck check 400 Tstep step ybottom-Tstep-step ; _SIZEcombo PrimaryKey Lcombo 100 step+2*Lbtn 5*Tstep+2*Hlist+3*step; _SIZEcombo comboBoxindTab Lcombo 100 2*step+Lbtn ybottom ; /*Label et combo pout récéption de l'attribut Max id*/ _SIZEtext labelMetaInd Lbtn Tstep 3*step+Lbtn+Lcombo ybottom ; _SIZEcombo comboBoxindAttr Lcombo 100 4*step+2*Lbtn+Lcombo ybottom ); ) ;; fun MyCRText (xi, yi, wi, hi, text) = _CRtext _channel EditorWin xi yi wi hi ET_ALIGN_LEFT text ;; fun connectionDB (aliasDB, loginDB, pwdDB, SourceDest)= let if aliasDB ==nil then "" else aliasDB -> al in let if loginDB ==nil then "" else loginDB -> lo in let if pwdDB ==nil then "" else pwdDB -> pwd in let SqlCreate _channel al lo pwd -> dbtmp in if SourceDest == 1 then /*On gère la base SOURCE*/ if dbSource == nil then ( set dbSource = dbtmp; _DLGrflmessage _DLGMessageBox _channel EditorWin (_locEditor "WINDOW_NAME_DBCONNECT" nil) (_locEditor "DBCONNECT_SUCCESS" nil) 0 @_dbconnectSource [al lo pwd EditorWin]; 0 ) else /*Il y a déjà une base SOURCE*/ ( let _GETcombo comboBoxSource -> [_ tableSource] in let SqlRequest dbtmp "GET_TABLES" nil -> sqlreq in if (IsThisTableExist tableSource sqlreq) == 1 then (/*The last table exist in the new DataBase*/ let SqlRequest dbtmp "GET_COLUMNS" (SQL_NIL tableSource)::nil -> listATTR in ( set ListeRes = CompareSQLAttributsToListeRes listATTR ListeRes SOURCE; _RSTlistTab MultiListeSource; fill_Multi_Liste MultiListeSource listATTR 0 0 1; set listATTRSOURCE = listATTR ); _RSTlistTab MultiListeResultat ; fill_Multi_Liste MultiListeResultat ListeRes 0 0 1 ) else (/*The Last Table doesnt exist in the new DataBase*/ set dbSource = dbtmp; _DLGrflmessage _DLGMessageBox _channel EditorWin (_locEditor "WINDOW_NAME_DBCONNECT" nil) (_locEditor "DBCONNECT_SUCCESS" nil) 0 @_dbconnectSource [al lo pwd EditorWin]; 0 ) ) else/*On gère la base destination*/ if dbDestination == nil then ( set dbDestination = dbtmp; _DLGrflmessage _DLGMessageBox _channel EditorWin (_locEditor "WINDOW_NAME_DBCONNECT" nil) (_locEditor "DBCONNECT_SUCCESS" nil) 0 @_dbconnectDestination [al lo pwd EditorWin]; 0 ) else ( let _GETcombo comboBoxDestination -> [_ tableDestination] in let SqlRequest dbtmp "GET_TABLES" nil -> sqlreq in if (IsThisTableExist tableDestination sqlreq) == 1 then (/*The last table exist in the new DataBase*/ let SqlRequest dbtmp "GET_COLUMNS" (SQL_NIL tableDestination)::nil -> listATTR in ( _RSTlistTab MultiListeDestination; fill_Multi_Liste MultiListeDestination listATTR 0 0 1; set listATTRDESTINATION = listATTR; set ListeRes = CompareSQLAttributsToListeRes listATTR ListeRes DESTINATION ); _RSTlistTab MultiListeResultat ; fill_Multi_Liste MultiListeResultat ListeRes 0 0 1 ) else (/*The Last Table doesnt exist in the new DataBase*/ set dbSource = dbtmp; _DLGrflmessage _DLGMessageBox _channel EditorWin (_locEditor "WINDOW_NAME_DBCONNECT" nil) (_locEditor "DBCONNECT_SUCCESS" nil) 0 @_dbconnectDestination [al lo pwd EditorWin]; 0 ) ) ;; fun cbConnectSource (btn, param) = let _GETtext param -> tmpAlias in let GetODBCInfos tmpAlias "login" -> tmpLogin in let GetODBCInfos tmpAlias "password" -> tmpPwd in connectionDB tmpAlias tmpLogin tmpPwd 1 ;; fun _OdbcOkSource(Otext, param, truc)= let _GETtext Otext -> tmpAlias in let GetODBCInfos tmpAlias "login" -> tmpLogin in let GetODBCInfos tmpAlias "password" -> tmpPwd in connectionDB tmpAlias tmpLogin tmpPwd 1 ;; fun cbConnectDestination (btn, param) = let _GETtext param -> tmpAlias in let GetODBCInfos tmpAlias "login" -> tmpLogin in let GetODBCInfos tmpAlias "password" -> tmpPwd in connectionDB tmpAlias tmpLogin tmpPwd 0 ;; fun _OdbcOkDestination (Otext, param, truc)= let _GETtext Otext -> tmpAlias in let GetODBCInfos tmpAlias "login" -> tmpLogin in let GetODBCInfos tmpAlias "password" -> tmpPwd in connectionDB tmpAlias tmpLogin tmpPwd 0 ;; fun cbPro () = 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 (_DLGMessageBox _channel nil _locEditor "PRO_WARNING" nil _locEditor "PRO_INVALID_MSG" nil 0;0) else if periode==0 then 1 else let ((time>>1)&0x3fffffff)/43200-datedebut -> x in if x<0 then (_DLGMessageBox _channel nil _locEditor "PRO_WARNING" nil _locEditor "PRO_INVALID_MSG" nil 0;0) else if x<=periode then (_DLGMessageBox _channel nil _locEditor "PRO_WARNING" nil _locEditor "PRO_LIMITED_MSG" (itoa (periode-x))::nil 0;1) else (_DLGMessageBox _channel nil _locEditor "PRO_WARNING" nil _locEditor "PRO_ENDLIMITED_MSG" nil 0;0) ;; fun CreateApi(filename)= set font = _CRfont _channel 14 0 FF_WEIGHT "Arial"; set ed = _StartEditor _channel nil 0 0 600 400 WN_NORMAL EDITOR_NORMAL @cbLoad @cbSave @cbPro; set EditorWin = getEditWin ed ; let _GETwindowSizePosition EditorWin -> [Wt Ht _ _] in let Wt/2 -> half in let 5 -> step in let 20 -> Tstep in let 50 -> Lbtn in let half-10-Lbtn -> endlabel in let half-2*step -> Llist in let (Ht-(5*step+8*Tstep))/2 -> Hlist in let step+half -> Dstep in ( set SourceTexte = _CRtext _channel EditorWin 0 0 half 20 ET_ALIGN_CENTER (_locEditor "DB_SOURCE" nil); /*DB alias SOURCE*/ set AliasTexteSource = _CRtext _channel EditorWin step step+10 100 2*Tstep ET_ALIGN_LEFT (_locEditor "DB_ALIAS" nil); set AliasEditTexteSource = _CReditLine _channel EditorWin step+100 step+15 Wt/2-(2*step+175) Tstep ET_BORDER|ET_TABFOCUS|ET_AHSCROLL ""; _CBlineOk AliasEditTexteSource @_OdbcOkSource []; set ConnectBtnSource = _CRbutton _channel EditorWin step+90+ Wt/2-(2*step+160) step+15 70 Tstep 0 (_locEditor "DB_CONECTION" nil); _CBbutton ConnectBtnSource @cbConnectSource AliasEditTexteSource; /*DB Table SOURCE*/ set TableTexteSource = MyCRText step 3*Tstep Lbtn Tstep (_locEditor "DB_TABLE" nil); /*Modif DB Table Source*/ _ENcombo set comboBoxSource = _CBcombo _CRcombo _channel EditorWin step+Lbtn 3*Tstep endlabel 100 CB_NOEDIT|CB_AHSCROLL|CB_DOWN "" @_comboTableSource nil 0; /*Multi_Liste des attributs*/ _ENlistTab set MultiListeSource = _CRlistTab _channel EditorWin step step+4*Tstep Llist Hlist LV_BORDER|LV_SINGLESEL 0; _ADDlistTabColumn MultiListeSource 0 100 ET_ALIGN_LEFT (_locEditor "ATTR_NAME" nil); _ADDlistTabColumn MultiListeSource 1 100 ET_ALIGN_LEFT (_locEditor "ATTR_TYPE" nil); _ADDlistTabColumn MultiListeSource 2 100 ET_ALIGN_LEFT (_locEditor "ATTR_WIDTH" nil); _CBlistTabSelect MultiListeSource @_SelectMListeSource nil ; set DestinationTexte = _CRtext _channel EditorWin half 0 half 20 ET_ALIGN_CENTER (_locEditor "DB_DESTINATION" nil); /*DB alias SOURCE*/ set AliasTexteDestination = _CRtext _channel EditorWin Dstep step+10 100 2*Tstep ET_ALIGN_LEFT (_locEditor "DB_ALIAS" nil); set AliasEditTexteDestination = _CReditLine _channel EditorWin Dstep+100 step+15 Wt/2-(2*step+175) Tstep ET_BORDER|ET_TABFOCUS|ET_AHSCROLL ""; _CBlineOk AliasEditTexteDestination @_OdbcOkDestination []; set ConnectBtnDestination = _CRbutton _channel EditorWin Dstep+90+ Wt/2-(2*step+160) step+15 70 Tstep 0 (_locEditor "DB_CONECTION" nil); _CBbutton ConnectBtnDestination @cbConnectDestination AliasEditTexteDestination; set TableTexteDestination = MyCRText Dstep 3*Tstep Lbtn Tstep (_locEditor "DB_TABLE" nil); /*DB Table DESTINATION*/ _ENcombo set comboBoxDestination = _CBcombo _CRcombo _channel EditorWin Dstep+Lbtn 3*Tstep endlabel 100 CB_NOEDIT|CB_AHSCROLL|CB_DOWN "" /*Modif DB Table Source*/ @_comboTableDestination nil 0; /*Multi_Liste des attributs*/ _ENlistTab set MultiListeDestination = _CRlistTab _channel EditorWin Dstep step+4*Tstep Llist Hlist LV_BORDER|LV_SINGLESEL 0; _ADDlistTabColumn MultiListeDestination 0 100 ET_ALIGN_LEFT (_locEditor "ATTR_NAME" nil); _ADDlistTabColumn MultiListeDestination 1 100 ET_ALIGN_LEFT (_locEditor "ATTR_TYPE" nil); _ADDlistTabColumn MultiListeDestination 2 100 ET_ALIGN_LEFT (_locEditor "ATTR_WIDTH" nil); _CBlistTabSelect MultiListeDestination @_SelectMListeDestination nil ; set AddLinkBttn = _ENbutton _CBbutton _CRbutton _channel EditorWin step 2*step+4*Tstep+Hlist-1 Wt-2*step Tstep-step+1 nil (_locEditor "DB_ADD_ACCESS" nil) @_DbAddLink nil 0; _ENlistTab set MultiListeResultat = _CRlistTab _channel EditorWin step 2*step+5*Tstep+Hlist Wt-2*step Hlist LV_BORDER 0; _ADDlistTabColumn MultiListeResultat 0 (Wt-2*step)/3 ET_ALIGN_LEFT (_locEditor "ATTR_NAME_SOURCE" nil); _ADDlistTabColumn MultiListeResultat 1 (Wt-2*step)/3 ET_ALIGN_LEFT (_locEditor "ATTR_NAME_DEST" nil); _ADDlistTabColumn MultiListeResultat 2 (Wt-2*step)/3 ET_ALIGN_LEFT (_locEditor "ATTR_DOUBLON" nil); _CBlistTabSelect MultiListeResultat @_SelectMListeResultat nil ; set DelBttn = _ENbutton _CBbutton _CRbutton _channel EditorWin Wt-step-Lbtn 5*Tstep+2*Hlist+3*step Lbtn Tstep nil (_locEditor "DB_SUPPR" nil) @_Dbdel nil 0; set DoublonBttn = _ENbutton _CBbutton _CRbutton _channel EditorWin Wt-3*step-2*Lbtn 5*Tstep+2*Hlist+3*step Lbtn+step Tstep nil (_locEditor "DB_DBL" nil) @_Doublon nil 0; let Ht-step-Tstep -> ybottom in let (Wt-5*step-2*Lbtn)/2 -> Lcombo in ( /*Label et combo pour récéption de la Méta table*/ set check = _SETcheck _CBcheck _CRcheck _channel EditorWin step ybottom-Tstep-step 400 Tstep 0 (_locEditor "DB_INSERTMETATABLE" nil) @_check nil 1; set labelKey = MyCRText step 5*Tstep+2*Hlist+3*step 2*Lbtn Tstep (_locEditor "DB_KEY" nil); _ENcombo set PrimaryKey = _CBcombo _CRcombo _channel EditorWin step+2*Lbtn 5*Tstep+2*Hlist+3*step Lcombo 100 CB_NOEDIT|CB_AHSCROLL|CB_DOWN "" @_comboPrimaryKey nil 0; set labelMetaTable = MyCRText step ybottom Lbtn Tstep (_locEditor "DB_INDTABLE" nil); _ENcombo set comboBoxindTab = _CBcombo _CRcombo _channel EditorWin 2*step+Lbtn ybottom Lcombo 100 CB_NOEDIT|CB_AHSCROLL|CB_DOWN "" @_comboMetaTable nil 0; /*Label et combo pout récéption de l'attribut Max id*/ set labelMetaInd = MyCRText 3*step+Lbtn+Lcombo ybottom Lbtn Tstep (_locEditor "DB_INDATTR" nil); _ENcombo set comboBoxindAttr = _CBcombo _CRcombo _channel EditorWin 4*step+2*Lbtn+Lcombo ybottom Lcombo 100 CB_NOEDIT|CB_AHSCROLL|CB_DOWN "" @_comboMetaAttrTable nil 0 ); ); _CBwinSize EditorWin @_ReSizeEditor nil; _PAINTwindow _SHOWwindow EditorWin WINDOW_UNHIDDEN ;; fun IniEditor(filename)= CreateApi filename; if filename==nil then nil else openDMI ed; 0;;