serial KeyCodesCNTs,ReportErrorCNTs Default %Library.TMFormClass %Library.Boolean 0 %Library.String %Library.TMForm %TMLabel %TMMenuItem %TMMenuItem %TMPanel %TMSaveDialog %TMButton %TMButton %TMButton %TMButton %TMCheckBox %TMCheckBox %TMCheckListBox %TMCheckListBox %TMLabel %TMLabel %TMLabel %TMLabel %TMLabel %TMLabel %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMPopupMenu %TMEdit %TMEdit %TMEdit initvalue:%String 0 %Status 0 Args:%String 0 0 initvalue:%String 0 MApplication initvalue:%String 0 %Library.Status ClassName:%String 0 %Library.Boolean 2 Do . For Loop=1:1:$L(tmpClass,".")-2 Do .. Set $E(tmpClass,$F(tmpClass,".")-1)="_" If $E(tmpClass,1,4)="User" Do . Set $E(tmpClass,1,4)="SQLUser" */ Set MApplication.ScreenCursor=$$$crHourGlass Do ..clbIDs.Items.BeginUpdate() Do ..clbIDs.Clear() Set result=##class(%ResultSet).%New(..txtClassName.Text_":Extent") ;Set result=##class(%ResultSet).%New("%DynamicQuery:SQL") ;Do result.Prepare("SELECT ID From " _ tmpClass) Do result.Execute() New CurIndex,Cnt Set Cnt=0 For Quit:('result.Next() || ..Canceled) Do . Set CurIndex=..clbIDs.Items.Add(result.Get("ID")) . Do ..clbIDs.SetChecked(CurIndex,"True") . Set Cnt=Cnt+1 . If Cnt=100 Do .. Set Cnt=0 .. Do MApplication.ProcessMessages() Do ..clbIDs.Items.EndUpdate() Set MApplication.ScreenCursor=$$$crDefault Set ..lblIDs.Font.Style=$LB() If ..Canceled Do . Set ..lblMsg.Caption="Aborted preparing (" _ ..clbIDs.Items.Count _ " ID(s) available)." Else Do . Set ..lblMsg.Caption="Finished preparing (" _ ..clbIDs.Items.Count _ " ID(s) available)." Set ..btnReplicate.Visible="False" Set ..btnCancel.Visible="False" Set ..lblLogo.Caption="ID Manipulator" Set ..lblLogoShadow.Caption=..lblLogo.Caption Quit 1 ]]> ORef:%Integer 0 %Library.Boolean 2 Do . For Loop=1:1:$L(tmpClass,".")-2 Do .. Set $E(tmpClass,$F(tmpClass,".")-1)="_" If $E(tmpClass,1,4)="User" Do . Set $E(tmpClass,1,4)="SQLUser" */ Set MApplication.ScreenCursor=$$$crHourGlass Do ..clbIDs.Items.BeginUpdate() Do ..clbIDs.Clear() Set result=##class(%ResultSet).%New(..txtClassName.Text_":Extent") //Set result=##class(%ResultSet).%New("%DynamicQuery:SQL") //Do result.Prepare("SELECT ID From " _ tmpClass) Do result.Execute() New CurIndex,Cnt Set Cnt=0 For Quit:('result.Next() || ..Canceled) Do . If result.Get("ID")'=ORef.%Id() Do .. Set CurIndex=..clbIDs.Items.Add(result.Get("ID")) .. Do ..clbIDs.SetChecked(CurIndex,"True") .. Set Cnt=Cnt+1 .. If Cnt=100 Do ... Set Cnt=0 ... Do MApplication.ProcessMessages() Do result.%Close() Do ..clbIDs.Items.EndUpdate() Set MApplication.ScreenCursor=$$$crDefault Set ..lblIDs.Font.Style=$LB() If ..Canceled Do . Set ..lblMsg.Caption="Aborted preparing (" _ ..clbIDs.Items.Count _ " ID(s) available)."_$C(13,10)_"Source '"_ORef.%Id()_"' not included in list." Else Do . Set ..lblMsg.Caption="Finished preparing (" _ ..clbIDs.Items.Count _ " ID(s) available)."_$C(13,10)_"Source '"_ORef.%Id()_"' not included in list." Set ..btnReplicate.Visible="True" Set ..btnReplicate.Enabled="True" Set ..lblLogo.Caption="Data Replicator" Set ..lblLogoShadow.Caption=..lblLogo.Caption Set ..btnCancel.Visible="False" Quit 1 ]]> ErrorType:%Integer,Msg:%String="",MsgBoxType=0 0 Args:%String 0 Args:%String 0 Args:%String 0 Args:%String 0 Args:%String 0 Args:%String 0 Args:%String 0 Args:%String 0 Args:%String 0 to continue.","Clipboard full",$$$MBICONINFORMATION+$$$MBOKCANCEL) .. Set:(tmpAnswer=$$$mrOk) MApplication.ClipboardText="", CurLen=0 . Quit:(tmpAnswer=$$$mrCancel) . Set MApplication.ClipboardText=MApplication.ClipboardText_OutputStr_$C(13,10) . Set CopCount=CopCount+1 . Set ..lblMsg.Caption="Copying "_CopCount_" ID(s)... "_((CurLen*100)\32000)_"%" Set ..lblMsg.Caption="Copied "_CopCount_" object(s)." ;End of user code s Args=$lb(Sender) q //----------------------------------------------------------------------------- CopyError Set ..lblMsg.Caption="Error during copy" Do MApplication.MessageBox("Er is een fout opgetreden bij het kopiëren.","Data Replicator",$$$MBICONERROR) Set ..lblMsg.Caption=$ZERROR Quit ]]> Args:%String 0 ") For Loop=0:1:..clbIDs.Items.Count-1 Do . Quit:(..clbIDs.GetChecked(Loop)="False") . Set ID=..clbIDs.Items.GetStrings(Loop) . Xecute "Set Exists=##class("_..txtClassName.Text_").%ExistsId(ID)" . Quit:('Exists) . Xecute "Set Obj=##class("_..txtClassName.Text_").%OpenId(ID)" . Quit:(Obj=$$$NULLOREF) . Do XMLStrings.Add(" ") . Set ..clbIDs.ItemIndex=Loop . Set ..lblMsg.Caption=ID_" ("_Loop_")" . Do MApplication.ProcessMessages() . For PropLoop=1:1:$LL(PropList) Do .. Set PropName=$LI(PropList,PropLoop) .. Xecute "Set PropValue=Obj."_PropName .. Do XMLStrings.Add(" <"_PropName_"> "_PropValue_" ") . Set Count=Count+1 . Do XMLStrings.Add(" ") . Do Obj.%Close() Do XMLStrings.Add("") Set ..lblMsg.Caption=Count_" object(s) XML copied." If ..SaveDialog.Execute()="True" Do . Do XMLStrings.SaveToFile(..SaveDialog.FileName) . Do MApplication.Execute("notepad "_..SaveDialog.FileName) Do XMLStrings.%Close() ;End of user code s Args=$lb(Sender) q ]]> Args:%String 0 Args:%String 0 Args:%String 0 Args:%String 0 %Library.CacheSerialState list "%Library.TMFormClass" Address Form Label1 Label2 Panel1 btnPrepare txtClassName txtORef CheckListBox1 CheckListBox2 Label3 Label4 Button1 ProgressBar1 btnReplicate clbIDs clbProperties pbProgress lblIDs lblProperties lblClassName Edit2 lblMsg txtIDFilter btnXtra chkClearPrevious miDelete pmIDs MenuItem1 miCopyIDs miCopyXML chkSelAllProps SaveDialog miCopyExcel lblLogo lblLogoShadow MenuItem3 miCreateNewInstances miCreateCopyMethod btnCancel Canceled miCopyCache CurrentORef