serial KeyCodesCNTs Default %Library.TMFormClass %Library.String %Library.String 30 %Library.Integer 0 %Library.String 1 %Library.Integer 25 %Library.TMForm %Library.String %Library.String %Library.String %TMPanel %Library.String 1 %TMSpeedButton %TMSpeedButton %TMSpeedButton %TMSpeedButton %TMSpeedButton %TMCheckBox %TMMenuItem %TMMenuItem %TMMenuItem %TMLabel %TMLabel %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMenuItem %TMMemo %TMMemo %TMPopupMenu %TMPopupMenu %TMPanel %TMSaveDialog %TMSplitter initvalue:%String 0 %Status Value:%Integer 0 %Library.Status Args:%String 0 0 ' ; Anchors = [akTop, akRight] ; Color = 10079436 ; Caption = '&Execute' ; Font.Charset = DEFAULT_CHARSET ; Font.Color = clRed ; Font.Height = -11 ; Font.Name = 'MS Sans Serif' ; Font.Style = [fsBold] ; ParentFont = False ; ParentShowHint = False ; ShowHint = True ; OnClick = btnExecDynamicSQLClick ; end ; object btnPrevDynQuery: CSpeedButton ; Left = 677 ; Top = 35 ; Width = 63 ; Height = 22 ; Anchors = [akTop, akRight] ; Color = 14342838 ; Caption = '&Previous' ; Enabled = False ; Font.Charset = DEFAULT_CHARSET ; Font.Color = clBlue ; Font.Height = -11 ; Font.Name = 'MS Sans Serif' ; Font.Style = [fsBold] ; ParentFont = False ; ParentShowHint = False ; ShowHint = True ; OnClick = btnPrevDynQueryClick ; end ; object btnNextDynQuery: CSpeedButton ; Left = 677 ; Top = 57 ; Width = 63 ; Height = 22 ; Anchors = [akTop, akRight] ; Color = 14342838 ; Caption = '&Next' ; Enabled = False ; Font.Charset = DEFAULT_CHARSET ; Font.Color = clBlue ; Font.Height = -11 ; Font.Name = 'MS Sans Serif' ; Font.Style = [fsBold] ; ParentFont = False ; ParentShowHint = False ; ShowHint = True ; OnClick = btnNextDynQueryClick ; end ; object lblCurrent: CLabel ; Left = 677 ; Top = 84 ; Width = 63 ; Height = 13 ; Alignment = taCenter ; Anchors = [akTop, akRight] ; AutoSize = False ; Font.Charset = ANSI_CHARSET ; Font.Color = clBlue ; Font.Height = -11 ; Font.Name = 'Tahoma' ; Font.Style = [fsBold] ; ParentFont = False ; end ; object btnClearDynQueries: CSpeedButton ; Left = 677 ; Top = 106 ; Width = 63 ; Height = 22 ; Anchors = [akRight, akBottom] ; Color = 14342838 ; Caption = '&Clear' ; Font.Charset = DEFAULT_CHARSET ; Font.Color = clBlue ; Font.Height = -11 ; Font.Name = 'MS Sans Serif' ; Font.Style = [fsBold] ; ParentFont = False ; ParentShowHint = False ; ShowHint = True ; OnClick = btnClearDynQueriesClick ; end ; object mmoDynamicQuery: CMemo ; Left = 0 ; Top = 0 ; Width = 673 ; Height = 130 ; Align = alLeft ; Anchors = [akLeft, akTop, akRight, akBottom] ; Color = 13487516 ; Font.Charset = ANSI_CHARSET ; Font.Color = clNavy ; Font.Height = -11 ; Font.Name = 'Courier New' ; Font.Style = [fsBold] ; ParentFont = False ; TabOrder = 0 ; WordWrap = False ; OnKeyDown = mmoDynamicQueryKeyDown ; end ; end ; object pmQueries: CPopupMenu ; Left = 9 ; Top = 45 ; end ; object pmUtils: CPopupMenu ; OnPopup = pmUtilsPopup ; Left = 7 ; Top = 91 ; object hmiFetchCount: TMenuItem ; Caption = 'Fetch count...' ; object miFC25: TMenuItem ; Tag = 25 ; Caption = '25' ; Checked = True ; RadioItem = True ; OnClick = miFetchCountClick ; end ; object miFC100: TMenuItem ; Tag = 100 ; Caption = '100' ; RadioItem = True ; OnClick = miFetchCountClick ; end ; object miFC200: TMenuItem ; Tag = 200 ; Caption = '200' ; RadioItem = True ; OnClick = miFetchCountClick ; end ; object miFC300: TMenuItem ; Tag = 300 ; Caption = '300' ; RadioItem = True ; OnClick = miFetchCountClick ; end ; object miFC400: TMenuItem ; Tag = 400 ; Caption = '400' ; RadioItem = True ; OnClick = miFetchCountClick ; end ; object miFC500: TMenuItem ; Tag = 500 ; Caption = '500' ; RadioItem = True ; OnClick = miFetchCountClick ; end ; object miSep1: TMenuItem ; Caption = '-' ; end ; object miFCUserDefined: TMenuItem ; Caption = 'User defined...' ; RadioItem = True ; OnClick = miFetchCountClick ; end ; end ; object hmiColWidth: TMenuItem ; Caption = 'Column width...' ; object miCW10: TMenuItem ; Tag = 10 ; Caption = '10' ; RadioItem = True ; OnClick = miColWidthClick ; end ; object miCW20: TMenuItem ; Tag = 20 ; Caption = '20' ; RadioItem = True ; OnClick = miColWidthClick ; end ; object miCW30: TMenuItem ; Tag = 30 ; Caption = '30' ; Checked = True ; RadioItem = True ; OnClick = miColWidthClick ; end ; object miCW40: TMenuItem ; Tag = 40 ; Caption = '40' ; RadioItem = True ; OnClick = miColWidthClick ; end ; object miCW50: TMenuItem ; Tag = 50 ; Caption = '50' ; RadioItem = True ; OnClick = miColWidthClick ; end ; object miSep2: TMenuItem ; Caption = '-' ; end ; object miCWUserDefined: TMenuItem ; Caption = 'User defined...' ; RadioItem = True ; OnClick = miColWidthClick ; end ; end ; object hmiOutput: TMenuItem ; Caption = 'Output...' ; object miColumns: TMenuItem ; Caption = 'Columns' ; Checked = True ; RadioItem = True ; ShortCut = 112 ; OnClick = miOutputClick ; end ; object miCSV: TMenuItem ; Caption = 'Comma seperated' ; RadioItem = True ; ShortCut = 113 ; OnClick = miOutputClick ; end ; end ; object miSep3: TMenuItem ; Caption = '-' ; end ; object miCopyRSCode: TMenuItem ; Caption = 'Copy ResultSet code' ; OnClick = miCopyRSCodeClick ; end ; object miShowSQL: TMenuItem ; Caption = 'Copy SQL' ; OnClick = miShowSQLClick ; end ; object miSep6: TMenuItem ; Caption = '-' ; end ; object miSaveResults: TMenuItem ; Caption = 'Save results...' ; ShortCut = 16467 ; OnClick = miSaveResultsClick ; end ; end ; object sdResults: CSaveDialog ; DefaultExt = '.txt' ; Filter = 'Text File (*.txt)|*.txt' ; Left = 7 ; Top = 130 ; end ;end ]]> Args:%String 0 0 Args:%String 0 varname:type=default .. Set ParaDefault=$P(Para,"=",2) ;- DEFAULT .. Set Para=$P(Para,"=",1) ;PARA -> varname:type .. Set ParaType=$P(Para,":",2) ;- TYPE .. Set ParaName=$P(Para,":",1) ;- PARAMNAME .. Set InputPara="" .. If $L(ParaDefault) Do ... Set InputPara=ParaDefault .. Else If "%STRING/%LIBRARY.STRING"[$ZCVT(ParaType,"U") Do ... Set InputPara="""""" .. Set:($$InputBox^vhVisual(QueryName_ " parameters ("_ParamLoop_"/"_AantalParams_")",ParaName_$S($L(ParaType):": "_ParaType,1:""),.InputPara)=$$$mrCancel) EarlyQuit=1 .. Set InputParams=InputParams_$S(ParamLoop=1:"",1:",")_InputPara ;--------------------------------------------- New ErrStr,tmpStatus Set ErrStr=$$iXecute^vhLib("Set tmpStatus=RS.Execute("_InputParams_")") If ErrStr'="" Do Quit . Set ..LastInputParams="" . Do MApplication.MessageBox(ErrStr) . Do RS.%Close() New NoRowsAffected Set NoRowsAffected=($$ParseStatus^vhLib(tmpStatus)["SQLCODE = 100") If $$$ISERR(tmpStatus) && ('NoRowsAffected) Do Quit //SQLCODE = 100 is geen fout . Set ..LastInputParams="" . Do MApplication.MessageBox($$ParseStatus^vhLib(tmpStatus)) . Do RS.%Close() Set ..LastInputParams=InputParams If '..QueryIsSELECT(..LastSQLCode) Do Quit . Do AddLine("Done"_$S(NoRowsAffected:" (no rows affected).",1:".")) . Do RS.%Close() Set MApplication.ScreenCursor=$$$crHourGlass Do:(..FetchCount>25) ..mmoResults.Lines.BeginUpdate() ;Columnheader en seperator lines New Loop,ColLine,ColCount,ColWidth,SepLine Kill ..aCols Set ColWidth=..ColWidth Set ColCount=RS.GetColumnCount() Set (ColLine,SepLine)="" For Loop=1:1:ColCount Do . Set ..aCols(Loop)=RS.GetColumnHeader(Loop) . If ..miColumns.Checked="True" Do .. Set ColLine=ColLine_$$AddSpaces(..aCols(Loop),ColWidth)_" " .. Set SepLine=SepLine_$$AddLines(..aCols(Loop),ColWidth)_" " . Else Do .. Set ColLine=ColLine_","_..aCols(Loop) If ..miColumns.Checked="True" Do . Do AddLine(ColLine) . Do AddLine(SepLine) Else Do . Do AddLine($E(ColLine,2,99999)) ;Eerste ',' eraf strippen ;Resultdata New DataLine,RowCnt Set RowCnt=0 For Quit:((RowCnt=..FetchCount) || ('RS.Next())) Do . Set DataLine="" . For Loop=1:1:ColCount Do .. If ..miColumns.Checked="True" Do ... Set DataLine=DataLine_$$AddSpaces(RS.Get(..aCols(Loop)),ColWidth)_" " .. Else Do ... Set DataLine=DataLine_","_RS.Get(..aCols(Loop)) . If ..miColumns.Checked="True" Do .. Do AddLine(DataLine) . Else Do .. Do AddLine($E(DataLine,2,99999)) ;Eerste ',' eraf strippen . Set RowCnt=RowCnt+1 Do AddLine("") If RS.Next() Do . Do AddLine(RowCnt_" row(s) affected (fetch ceiling reached).") Else Do . Do AddLine(RowCnt_" row(s) affected.") Do RS.%Close() Set MApplication.ScreenCursor=$$$crDefault Do:(..FetchCount>25) ..mmoResults.Lines.EndUpdate() ;End of user code s Args=$lb(Sender) q //----------------------------------------------------------------------------- AddLine(Line) If ..FetchCount<26 Do . Do ..mmoResults.Lines.Add(Line) Else Do . If ..mmoResults.Lines.Count=0 Do .. Set ..mmoResults.Text=Line . Else Do .. Set ..mmoResults.Text=..mmoResults.Text_$C(13,10)_Line Quit //----------------------------------------------------------------------------- AddSpaces(Txt,Width) Quit:($L(Txt)>(Width-2)) $E(Txt,1,Width-3)_"..." New tmpTxt Set tmpTxt=Txt_$J("",Width-$L(Txt)) Quit tmpTxt AddLines(Txt,Width) New tmpTxt ;Set $P(tmpTxt,"-",$L(Txt)+1)=$J("",Width-$L(Txt)) Set $P(tmpTxt,"-",Width+1)="" Quit tmpTxt ]]> initvalue:%String 0 MApplication ",$lb("akTop","akRight"),10079436,"&Execute","False","False","True",$lb(%this,"btnExecDynamicSQLClick"))) d %this.btnExecDynamicSQL.Font.SetMultiProperty($lb("Charset","Color","Height","Name","Style"),$lb($$$DEFAULTCHARSET,$$$clRed,-11,"MS Sans Serif",$lb("fsBold"))) d %this.btnPrevDynQuery.SetMultiProperty($lb("Left","Top","Width","Height","Anchors","Color","Caption","Enabled","ParentFont","ParentShowHint","ShowHint","OnClick"),$lb(677,35,63,22,$lb("akTop","akRight"),14342838,"&Previous","False","False","False","True",$lb(%this,"btnPrevDynQueryClick"))) d %this.btnPrevDynQuery.Font.SetMultiProperty($lb("Charset","Color","Height","Name","Style"),$lb($$$DEFAULTCHARSET,$$$clBlue,-11,"MS Sans Serif",$lb("fsBold"))) d %this.btnNextDynQuery.SetMultiProperty($lb("Left","Top","Width","Height","Anchors","Color","Caption","Enabled","ParentFont","ParentShowHint","ShowHint","OnClick"),$lb(677,57,63,22,$lb("akTop","akRight"),14342838,"&Next","False","False","False","True",$lb(%this,"btnNextDynQueryClick"))) d %this.btnNextDynQuery.Font.SetMultiProperty($lb("Charset","Color","Height","Name","Style"),$lb($$$DEFAULTCHARSET,$$$clBlue,-11,"MS Sans Serif",$lb("fsBold"))) d %this.lblCurrent.SetMultiProperty($lb("Left","Top","Width","Height","Alignment","Anchors","AutoSize","ParentFont"),$lb(677,84,63,13,"taCenter",$lb("akTop","akRight"),"False","False")) d %this.lblCurrent.Font.SetMultiProperty($lb("Charset","Color","Height","Name","Style"),$lb($$$ANSICHARSET,$$$clBlue,-11,"Tahoma",$lb("fsBold"))) d %this.btnClearDynQueries.SetMultiProperty($lb("Left","Top","Width","Height","Anchors","Color","Caption","ParentFont","ParentShowHint","ShowHint","OnClick"),$lb(677,106,63,22,$lb("akRight","akBottom"),14342838,"&Clear","False","False","True",$lb(%this,"btnClearDynQueriesClick"))) d %this.btnClearDynQueries.Font.SetMultiProperty($lb("Charset","Color","Height","Name","Style"),$lb($$$DEFAULTCHARSET,$$$clBlue,-11,"MS Sans Serif",$lb("fsBold"))) d %this.mmoDynamicQuery.SetMultiProperty($lb("Left","Top","Width","Height","Align","Anchors","Color","ParentFont","TabOrder","WordWrap","OnKeyDown"),$lb(0,0,673,130,"alLeft",$lb("akLeft","akTop","akRight","akBottom"),13487516,"False",0,"False",$lb(%this,"mmoDynamicQueryKeyDown"))) d %this.mmoDynamicQuery.Font.SetMultiProperty($lb("Charset","Color","Height","Name","Style"),$lb($$$ANSICHARSET,$$$clNavy,-11,"Courier New",$lb("fsBold"))) d %this.pmUtils.SetMultiProperty($lb("OnPopup"),$lb($lb(%this,"pmUtilsPopup"))) d %this.hmiFetchCount.SetMultiProperty($lb("Caption"),$lb("Fetch count...")) d %this.miFC25.SetMultiProperty($lb("Tag","Caption","Checked","RadioItem","OnClick"),$lb(25,"25","True","True",$lb(%this,"miFetchCountClick"))) d %this.miFC100.SetMultiProperty($lb("Tag","Caption","RadioItem","OnClick"),$lb(100,"100","True",$lb(%this,"miFetchCountClick"))) d %this.miFC200.SetMultiProperty($lb("Tag","Caption","RadioItem","OnClick"),$lb(200,"200","True",$lb(%this,"miFetchCountClick"))) d %this.miFC300.SetMultiProperty($lb("Tag","Caption","RadioItem","OnClick"),$lb(300,"300","True",$lb(%this,"miFetchCountClick"))) d %this.miFC400.SetMultiProperty($lb("Tag","Caption","RadioItem","OnClick"),$lb(400,"400","True",$lb(%this,"miFetchCountClick"))) d %this.miFC500.SetMultiProperty($lb("Tag","Caption","RadioItem","OnClick"),$lb(500,"500","True",$lb(%this,"miFetchCountClick"))) d %this.miSep1.SetMultiProperty($lb("Caption"),$lb("-")) d %this.miFCUserDefined.SetMultiProperty($lb("Caption","RadioItem","OnClick"),$lb("User defined...","True",$lb(%this,"miFetchCountClick"))) d %this.hmiColWidth.SetMultiProperty($lb("Caption"),$lb("Column width...")) d %this.miCW10.SetMultiProperty($lb("Tag","Caption","RadioItem","OnClick"),$lb(10,"10","True",$lb(%this,"miColWidthClick"))) d %this.miCW20.SetMultiProperty($lb("Tag","Caption","RadioItem","OnClick"),$lb(20,"20","True",$lb(%this,"miColWidthClick"))) d %this.miCW30.SetMultiProperty($lb("Tag","Caption","Checked","RadioItem","OnClick"),$lb(30,"30","True","True",$lb(%this,"miColWidthClick"))) d %this.miCW40.SetMultiProperty($lb("Tag","Caption","RadioItem","OnClick"),$lb(40,"40","True",$lb(%this,"miColWidthClick"))) d %this.miCW50.SetMultiProperty($lb("Tag","Caption","RadioItem","OnClick"),$lb(50,"50","True",$lb(%this,"miColWidthClick"))) d %this.miSep2.SetMultiProperty($lb("Caption"),$lb("-")) d %this.miCWUserDefined.SetMultiProperty($lb("Caption","RadioItem","OnClick"),$lb("User defined...","True",$lb(%this,"miColWidthClick"))) d %this.hmiOutput.SetMultiProperty($lb("Caption"),$lb("Output...")) d %this.miColumns.SetMultiProperty($lb("Caption","Checked","RadioItem","ShortCut","OnClick"),$lb("Columns","True","True",112,$lb(%this,"miOutputClick"))) d %this.miCSV.SetMultiProperty($lb("Caption","RadioItem","ShortCut","OnClick"),$lb("Comma seperated","True",113,$lb(%this,"miOutputClick"))) d %this.miSep3.SetMultiProperty($lb("Caption"),$lb("-")) d %this.miCopyRSCode.SetMultiProperty($lb("Caption","OnClick"),$lb("Copy ResultSet code",$lb(%this,"miCopyRSCodeClick"))) d %this.miShowSQL.SetMultiProperty($lb("Caption","OnClick"),$lb("Copy SQL",$lb(%this,"miShowSQLClick"))) d %this.miSep6.SetMultiProperty($lb("Caption"),$lb("-")) d %this.miSaveResults.SetMultiProperty($lb("Caption","ShortCut","OnClick"),$lb("Save results...",16467,$lb(%this,"miSaveResultsClick"))) d %this.sdResults.SetMultiProperty($lb("DefaultExt","Filter"),$lb(".txt","Text File (*.txt)|*.txt")) s MApplication.ClientState="Wait" q ]]> Value:%String 0 %Library.Status ORef:%Integer 0 %Library.Boolean initvalue:%String 0 %Library.Status SQLCode:%String 0 %Library.Boolean Query:%String 0 %Library.Boolean Args:%String 0 Args:%String 0 (Width-2)) $E(Txt,1,Width-3)_"..." New tmpTxt Set tmpTxt=Txt_$J("",Width-$L(Txt)) Quit tmpTxt AddLines(Txt,Width) New tmpTxt ;Set $P(tmpTxt,"-",$L(Txt)+1)=$J("",Width-$L(Txt)) Set $P(tmpTxt,"-",Width+1)="" Quit tmpTxt ;End of user code s Args=$lb(Sender) q ]]> Args:%String 0 Args:%String 0 0 0 0) Do . Set tmpItem=##class(%TMMenuItem).%New($lb(..pmQueries.Address,0)) . Set tmpItem.Caption="-" . Do ..pmQueries.Items.Add(tmpItem) Set tmpItem=##class(%TMMenuItem).%New($lb(..pmQueries.Address,0)) Set tmpItem.Caption="Refresh list..." Set tmpItem.ShortCut=$$$keyF5 Set tmpItem.OnClick=$LB(%this,"DCOMPREFRESHpmQueries") Do ..pmQueries.Items.Add(tmpItem) Set tmpItem=##class(%TMMenuItem).%New($lb(..pmQueries.Address,0)) Set tmpItem.Caption="Dynamic SQL Screen" Set tmpItem.Checked="False" Set tmpItem.OnClick=$LB(%this,"miDynSQLSCreenClick") Do ..pmQueries.Items.Add(tmpItem) Quit //----------------------------------------------------------------------------- AddQueries(ClassName,ShowInherited) Quit:($D(HandledClasses(ClassName))) Set HandledClasses(ClassName)=1 New CDef,Super,Count,Loop,QueryName,Params,ResultType,Private,ExtraTxt,tmpItem,SQLQuery Set CDef=##class(%ClassDefinition).%OpenId(ClassName) Set Super=CDef.Super Set Count=CDef.Queries.Count() If (..pmQueries.Items.Count()>0) && (Count>0) Do . Set tmpItem=##class(%TMMenuItem).%New($lb(..pmQueries.Address,0)) . Set tmpItem.Caption="-" . Do ..pmQueries.Items.Add(tmpItem) For Loop=1:1:Count Do . Set QueryName=CDef.Queries.GetAt(Loop).Name . Set Params=CDef.Queries.GetAt(Loop).FormalSpec . Set SQLQuery=CDef.Queries.GetAt(Loop).SQLQuery . Set tmpItem=##class(%TMMenuItem).%New($lb(..pmQueries.Address,0)) . Set tmpItem.Caption=QueryName . Set tmpItem.Tag=$LB(Params,SQLQuery) . Set tmpItem.OnClick=$LB(%this,"ExecuteQuery") . Do ..pmQueries.Items.Add(tmpItem) Do CDef.%Close() If ShowInherited Do . Quit:(Super="") . New Loop,SuperClassName . For Loop=1:1:$L(Super,",") Do .. Set SuperClassName=$ZSTRIP($P(Super,",",Loop),"<>W") .. Do AddQueries(SuperClassName,ShowInherited) Quit ]]> Args:%String cache 0 document literal Args:%String 0 250 Do .. Set CW=250 . Set ..ColWidth=CW . Set Sender.Checked="True" . Set Sender.Caption="User defined ("_CW_")" Else Do . Set ..ColWidth=Sender.Tag . Set Sender.Checked="True" ;End of user code s Args=$lb(Sender) q ]]> Args:%String 0 Args:%String 0 Args:%String 0 1000 Do .. Set FC=1000 . Set ..FetchCount=FC . Set Sender.Checked="True" . Set Sender.Caption="User defined ("_FC_")" Else Do . Set ..FetchCount=Sender.Tag . Set Sender.Checked="True" ;End of user code s Args=$lb(Sender) q ]]> Args:%String 0 Args:%String 0 Args:%String 0 Args:%String 0 Args:%String 0 %Library.CacheSerialState "%Library.TMFormClass" Address Form Label1 Panel1 SpeedButton1 btnQueries reResults lblClassName pmQueries ClassName chkLoadInherited mmoResults ColWidth MenuItem1 miFC100 miFC200 miFC300 miFC400 miFC500 miFCUserDefined miSep1 pmUtils FetchCount hmiColWidth hmiFetchCount miCW10 miCW20 miCW30 miCW40 miCW50 miCWUserDefined miSep2 LastQueryName miCopyRSCode miSep3 LastInputParams miSep4 miShowSQL LastSQLCode miRefreshResults miSep5 hmiOutput miCSV miColumns mmoDynamicQuery Splitter1 Panel2 btnExecDynamicSQL IsDynamicQuery miFC25 pnlDynQuery splDynQuery miSaveResults miSep6 sdResults SpeedButton2 CurrentDynQuery btnNextDynQuery btnPrevDynQuery lblCurrent btnClearDynQueries