├── .gitignore
├── README.md
├── src
    ├── cls
    │   ├── brianpalmund
    │   │   └── validateSpecial.cls
    │   ├── eduardlebedyuk
    │   │   ├── filenamesInDir.cls
    │   │   ├── changePasswords.cls
    │   │   ├── passQuestionParams.cls
    │   │   └── diffLists.cls
    │   ├── objectscript
    │   │   ├── ZENsync.cls
    │   │   ├── getPropOfThisClass.cls
    │   │   ├── saveFileHTTP.cls
    │   │   ├── findTable.cls
    │   │   ├── sendEmail.cls
    │   │   ├── checkAudit.cls
    │   │   ├── GZIP.cls
    │   │   ├── createClass.cls
    │   │   ├── postXML.cls
    │   │   ├── walkDOM.cls
    │   │   ├── sendEmailWithImage.cls
    │   │   ├── createZenPage.cls
    │   │   └── checkBuild.cls
    │   ├── luziferaza
    │   │   └── RemoveDuplicates.cls
    │   ├── skisser
    │   │   ├── webcamPage.cls
    │   │   └── webcam.cls
    │   ├── benspead
    │   │   └── EnsTablesSchema.cls
    │   ├── zen
    │   │   ├── uploadFile.cls
    │   │   └── downloadStream.cls
    │   ├── timleavitt
    │   │   └── createThumbnail.cls
    │   ├── cartertiernan
    │   │   └── getDayfromDate.cls
    │   ├── blaisezarka
    │   │   └── automateSystemDefault.cls
    │   └── DAiMor
    │   │   └── fetchMessageHeaderData.cls
    ├── csp
    │   └── general
    │   │   ├── upload.csp
    │   │   ├── dynamicGeneratedTable.csp
    │   │   └── streamToDiv.csp
    └── routines
    │   ├── timur
    │       └── getOptionsArgs.mac
    │   └── iainbray
    │       └── indexToBitmap.mac
└── LICENSE


/.gitignore:
--------------------------------------------------------------------------------
1 | .DS*
2 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # code-snippets
2 | Code snippets library on ObjectScript
3 | 


--------------------------------------------------------------------------------
/src/cls/brianpalmund/validateSpecial.cls:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/intersystems-community/code-snippets/master/src/cls/brianpalmund/validateSpecial.cls


--------------------------------------------------------------------------------
/src/cls/eduardlebedyuk/filenamesInDir.cls:
--------------------------------------------------------------------------------
 1 | Class eduardlebedyuk.filenamesInDir Extends %RegisteredObject
 2 | {
 3 | 	classmethod test() {
 4 | 		// replace dir with file path you want
 5 | 		set dir = "D:\directory" 
 6 | 		set dir = ##class(%File).NormalizeDirectory(dir)
 7 | 		set file=$ZSEARCH(dir_"*")
 8 | 		while file'="" {
 9 | 			write !,file
10 | 			set file=$ZSEARCH("")
11 | 		}
12 | 	}
13 | }


--------------------------------------------------------------------------------
/src/cls/objectscript/ZENsync.cls:
--------------------------------------------------------------------------------
1 | Class objectscript.ZENsync Extends %RegisteredObject
2 | {
3 | 	classmethod test() {
4 | 		Write ##class(%ZEN.Component.abstractPage).%ZENVersion()
5 |  
6 | 		; Return Zen Library version.
7 | 		;This is used to make sure that the class library is in sync with the zenutils.js file and any generated js files. This must match the value in the zenutils.js file.
8 | 	}
9 | }


--------------------------------------------------------------------------------
/src/cls/eduardlebedyuk/changePasswords.cls:
--------------------------------------------------------------------------------
 1 | Class eduardlebedyuk.changePasswords Extends %RegisteredObject
 2 | {
 3 | 	ClassMethod test()
 4 | 	{
 5 | 	    zn "%SYS"
 6 | 	    set NewPass = "NewPassString"
 7 | 	    set rs=##Class(%ResultSet).%New("Security.Users:List")
 8 | 	    set st = rs.Execute()
 9 | 	    while rs.Next() { set st=$SYSTEM.Security.ChangePassword(rs.Get("Name"),NewPass)}
10 | 	}
11 | }


--------------------------------------------------------------------------------
/src/cls/luziferaza/RemoveDuplicates.cls:
--------------------------------------------------------------------------------
 1 | Class luziferaza.RemoveDuplicates as %RegisteredObject {
 2 | ClassMethod test() As %String
 3 | {
 4 |  s str="Hello,, world!",str2=""
 5 |  s symb=","
 6 |   
 7 |  f i=1:1:$l(str,symb)
 8 |  {
 9 |   s p=$p(str,symb,i)
10 |   i ($tr(p," ")'="") &; i'=1     {s str2=str2_symb_p}
11 |   elseif ($tr(p," ")'="") &; i=1 {s str2=str2_p}
12 |  }
13 |   
14 | w str2
15 | }
16 | }


--------------------------------------------------------------------------------
/src/cls/objectscript/getPropOfThisClass.cls:
--------------------------------------------------------------------------------
 1 | /// get property value within class by indirection
 2 | Class objectscript.getPropOfThisClass Extends %RegisteredObject
 3 | {
 4 | 	// extra code to help test
 5 | 	Property myProp as %Integer;
 6 | 	
 7 | 	// need to instantiate an object to access property value
 8 | 	method test() {
 9 | 		// extra code to help test
10 | 		set ..myProp = 32
11 | 		
12 | 		// code from the CODE post
13 | 		set property = $PROPERTY($THIS, "myProp")
14 | 		
15 | 		// extra code to help test
16 | 		write property
17 | 	}
18 | }


--------------------------------------------------------------------------------
/src/cls/objectscript/saveFileHTTP.cls:
--------------------------------------------------------------------------------
 1 | Class objectscript.saveFileHTTP Extends %RegisteredObject
 2 | {
 3 | 	classmethod test() {
 4 | 		Set httprequest = ##class(%Net.HttpRequest).%New()
 5 | 		Set httprequest.Server = "docs.intersystems.com"
 6 | 		Do httprequest.Get("documentation/cache/20172/pdfs/GJSON.pdf")
 7 | 		Do $System.OBJ.Dump(httprequest.HttpResponse)
 8 | 		 
 9 | 		Set stream=##class(%FileBinaryStream).%New()
10 | 		Set stream.Filename="c:\test.pdf"
11 | 		Set stream=##class(%FileBinaryStream).%New()
12 | 		Set stream.Filename="c:\test.pdf"
13 | 		Write stream.CopyFrom(httprequest.HttpResponse.Data)
14 | 		Write stream.%Save()
15 | 	}
16 | }
17 | 


--------------------------------------------------------------------------------
/src/cls/eduardlebedyuk/passQuestionParams.cls:
--------------------------------------------------------------------------------
 1 | Class eduardlebedyuk.passQuestionParams
 2 | {
 3 | 	classmethod test(pValue = 50) {
 4 | 		s ns = $Namespace
 5 | 	    zn "samples"
 6 | 	    s tSQL = "SELECT ID, Name FROM Sample.Person WHERE Id > ?"
 7 | 	    s tPR = ##class(%ZEN.Auxiliary.jsonSQLProvider).%New()
 8 | 	    s tPR.sql = tSQL
 9 | 	    s tPR.%Format = "tw"
10 | 	    s tPR.maxRows = 100
11 | 	 
12 | 	    s tParam = ##class(%ZEN.Auxiliary.parameter).%New()
13 | 	    s tParam.value = pValue
14 | 	    d tPR.parameters.SetAt(tParam,1)
15 | 	  
16 | 	    d tPR.%DrawJSON() 
17 | 	    //d ##class(%ZEN.Auxiliary.jsonSQLProvider).%WriteJSONFromSQL(,,,,,tPR)  //same thing
18 | 	    zn ns
19 | 	}
20 | }


--------------------------------------------------------------------------------
/src/cls/objectscript/findTable.cls:
--------------------------------------------------------------------------------
 1 | Class objectscript.findTable Extends %RegisteredObject
 2 | {
 3 | 	classmethod test(name as %String="mytable") {
 4 | 		#dim result as %ResultSet
 5 | 	    #dim tName as %String
 6 | 	    #dim contain as %Integer
 7 | 	     
 8 | 	    Set contain=0
 9 | 	    Set result=##class(%ResultSet).%New("%ClassDefinition.ClassInfo")
10 | 	    Do result.Execute()
11 | 	    For{ 
12 | 	        If (result.Next()=0 ) Quit
13 | 	        Set tName=result.GetDataByName("Name")
14 | 	        &sql(select position (:name in :tName) into :contain)
15 | 	        If (contain '= 0) Write tName, " ... ", name, " (", contain,")", !
16 | 	    }
17 | 	     
18 | 	    Do result.%Close()
19 | 	}
20 | }


--------------------------------------------------------------------------------
/src/cls/objectscript/sendEmail.cls:
--------------------------------------------------------------------------------
 1 | Class objectscript.sendEmail Extends %RegisteredObject
 2 | {
 3 | 	classmethod test() {
 4 | 		set m=##class(%Net.MailMessage).%New()
 5 | 		set m.From="user@company.com"
 6 | 		 
 7 | 		set m.IsHTML=1
 8 | 		 
 9 | 		do m.To.Insert("user@company.com")
10 | 		set m.Subject="Sent by Cache' mail"
11 | 		set m.Charset="iso-8859-1"
12 | 		do m.TextData.Write("<HTML><HEAD><TITLE></TITLE>"_$char(13,10))
13 | 		do m.TextData.Write("<META http-equiv=Content-Type content=""text/html; charset=iso-8859-2""></HEAD>"_$char(13,10))
14 | 		do m.TextData.Write("<BODY><FONT face=Arial size=2>Test <B>Test</B></FONT></BODY></HTML>")
15 | 		set s=##class(%Net.SMTP).%New()
16 | 		set s.smtpserver="mail.company.com"
17 | 		set status=s.Send(m)
18 | 	}
19 | }


--------------------------------------------------------------------------------
/src/cls/objectscript/checkAudit.cls:
--------------------------------------------------------------------------------
 1 | class objectscript.checkAudit Extends %RegisteredObject
 2 | {
 3 | 	classmethod test() {
 4 | 		w "Checking for Auditing...",!
 5 | 		Set SYSOBJ = ##class(Security.System).%OpenId("SYSTEM")
 6 | 		If +SYSOBJ = 0 Set SYSOBJ = ##class(Security.System).%New()
 7 | 		i SYSOBJ.AuditEnabled {
 8 | 			w "Security Auditing is enabled for the following services",!
 9 | 			s rs=##class(%ResultSet).%New("Security.Events:ListAllSystem")
10 | 			s sc=rs.Execute()  If $$$ISERR(sc) Do DisplayError^%apiOBJ(sc) Quit
11 | 			while rs.%Next() {
12 |                 d:rs.Data("Enabled")="Yes" rs.%Print()
13 |             }
14 |             d rs.Close()
15 |          
16 |             s rs=##class(%ResultSet).%New("Security.Events:ListAllUser")
17 |             s sc=rs.Execute()  If $$$ISERR(sc) Do DisplayError^%apiOBJ(sc) Quit
18 |             while rs.%Next() {
19 |                 d:rs.Data("Enabled")="Yes" rs.%Print()
20 |             }
21 |             d rs.Close()
22 |         }
23 |     }
24 | }	


--------------------------------------------------------------------------------
/src/csp/general/upload.csp:
--------------------------------------------------------------------------------
 1 | <html>
 2 | <head></head>
 3 | <body>
 4 | 
 5 | <form enctype="multipart/form-data" method="post" action="wrc719199upload.csp">
 6 | 	Enter a file to upload here: <input type=file size=30 name=FileStream>
 7 | 	<hr />
 8 | 	<ul><input type="submit" value="Upload file"></ul>
 9 | </form>
10 | 
11 | <csp:if condition='($data(%request.MimeData("FileStream",1)))'>
12 | 	<h2>Saving file...</h2>
13 | 	<script language="Cache" runat="server">
14 | 	    Set data=%request.MimeData("FileStream",1)
15 | 	    	    
16 | 	    Set stream=##class(%FileBinaryStream).%New()
17 | 	    Do stream.LinkToFile("C:\"_%request.MimeData("FileStream",1).FileName)
18 | 
19 | 	    While (data.AtEnd'=1) {
20 | 	       Set x=data.Read()
21 | 	       Do stream.Write(x)
22 | 	    }
23 | 
24 | 	    Set Status = stream.SaveStream()
25 | 	    If (Status = 1) {
26 | 	    	Write "<h2>Uploaded!</h2>"
27 | 	    }
28 | 	    Else {
29 | 	    	Write "<h2>Saving vailed!</h2>"
30 | 	    }
31 | 	</script>
32 | </csp:if>
33 | </body>
34 | </html>


--------------------------------------------------------------------------------
/src/cls/skisser/webcamPage.cls:
--------------------------------------------------------------------------------
 1 | Class skisser.webcamPage extends %ZEN.Component.page
 2 | {
 3 | 	Parameter APPLICATION;
 4 | 	 
 5 | 	Parameter PAGENAME;
 6 | 	 
 7 | 	Parameter DOMAIN;
 8 | 	 
 9 | 	XData Style
10 | 	{
11 | 	<style type="text/css">
12 | 	</style>
13 | 	}
14 | 	 
15 | 	XData Contents [ XMLNamespace = "http://www.intersystems.com/zen" ]
16 | 	{
17 | 	<page xmlns="http://www.intersystems.com/zen" title="">
18 | 	<button caption="startCam" onclick="zenPage.startCam()"/>
19 | 	<button caption="Snapshot" onclick="zenPage.snapshot()"/>
20 | 	<camComponent width="600px" height="800px" id="mycam"/>
21 | 	<image id="image_source" src="" hidden="true"/>
22 | 	 
23 | 	</page>
24 | 	}
25 | 	 
26 | 	ClientMethod snapshot() [ Language = javascript ]
27 | 	{
28 | 	    var snap = zenPage.getComponentById('image_source')
29 | 	    zen('mycam').snapshot(snap);
30 | 	    zen('mycam').SaveImageToDB(snap);
31 | 	    snap.refreshContents();
32 | 	}
33 | 	 
34 | 	ClientMethod startCam() [ Language = javascript ]
35 | 	{
36 | 	    zen('mycam').startWebcam();
37 | 	}
38 | }


--------------------------------------------------------------------------------
/src/cls/objectscript/GZIP.cls:
--------------------------------------------------------------------------------
 1 | Class objectscript.GZIP Extends %RegisteredObject
 2 | {
 3 | 	classmethod test() {
 4 | 		//Export Global(s) uncompressed
 5 | 		set filename="C:\Temp\myglobal.xml"
 6 | 		do $System.OBJ.Export("^oddEXTR.gbl",filename)
 7 | 		//Open exported Globals
 8 | 		set uncompressed = ##class(%FileBinaryStream).%New()
 9 | 		set uncompressed.Filename=filename
10 | 		Set compressed = "C:\temp\mycomglobal.xml"
11 | 		//Open File Device over Gzip and Copy Uncompressed information to it
12 | 		Open compressed:("WUNK":::/GZIP=1:/NOXY=1:/OBUFSIZE=32768):0
13 | 		Use compressed
14 | 		do uncompressed.OutputToDevice()
15 | 		close compressed
16 | 		//Create New File  
17 | 		set out = ##class(%FileBinaryStream).%New()
18 | 		set out.Filename= "C:\Temp\decomp.xml"
19 | 		//Open compressed File and save information uncompressed over gzip
20 | 		Set file=##class(%File).%New(compressed)
21 | 		Do file.Open("RUK:::/GZIP=1:/NOXY=1")
22 | 		while ' file.AtEnd
23 | 		{
24 | 		    set line = file.ReadLine()
25 | 		    do out.Write(line)
26 | 		}
27 | 		do out.%Save()
28 | 	}
29 | }


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | MIT License
 2 | 
 3 | Copyright (c) 2018 InterSystems Developer Community
 4 | 
 5 | Permission is hereby granted, free of charge, to any person obtaining a copy
 6 | of this software and associated documentation files (the "Software"), to deal
 7 | in the Software without restriction, including without limitation the rights
 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
 9 | copies of the Software, and to permit persons to whom the Software is
10 | furnished to do so, subject to the following conditions:
11 | 
12 | The above copyright notice and this permission notice shall be included in all
13 | copies or substantial portions of the Software.
14 | 
15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21 | SOFTWARE.
22 | 


--------------------------------------------------------------------------------
/src/cls/eduardlebedyuk/diffLists.cls:
--------------------------------------------------------------------------------
 1 | Class eduardlebedyuk.diffLists Extends %RegisteredObject
 2 | {
 3 | 	/// Finds diff between two lists.<br>
 4 | 	/// <b>old</b> - original list.<br>
 5 | 	/// <b>new</b> - modified list.<br>
 6 | 	/// <b>.added</b> - list with all added elements (present in new list, absent in old list.<br>
 7 | 	/// <b>.deleted</b> - list with all deleted elements (present in old list, absent in new list.<br>
 8 | 	classmethod test(old as %List, new as %List, output added as %List, output deleted as %List) as %Status [ Internal ]
 9 | 	{
10 | 		set st=$$$OK
11 | 	    if ($LISTVALID(old)=0) quit $$$ERROR($$$AttributeValueMustBeList,"old")
12 | 	    if ($LISTVALID(new)=0) quit $$$ERROR($$$AttributeValueMustBeList,"new")
13 | 	    try {
14 | 	        for i=1:1:$LISTLENGTH(old)
15 | 	        {
16 | 	            set match=$LISTFIND(new,$LIST(old,i))
17 | 	            if match'=0
18 | 	            {
19 | 	                set $LIST(old,i)=""
20 | 	                set $LIST(new,match)=""
21 | 	            }
22 | 	        }
23 | 	        set added=new
24 | 	        set deleted=old
25 | 	    } catch ex {
26 | 	        set st=ex.AsStatus()
27 | 	    }
28 | 	    quit st
29 | 	}
30 | }


--------------------------------------------------------------------------------
/src/cls/benspead/EnsTablesSchema.cls:
--------------------------------------------------------------------------------
 1 | Class benspead.EnsTablesSchema
 2 | {
 3 | 	classmethod test() {
 4 | 		If ##class(%Dictionary.CompiledClass).%ExistsId("Ens.Util.LookupTableDocument") {
 5 | 		    // only supported in Ensemble 2012.1+
 6 | 		    Write !,!,"Exporting Ensemble Lookup Tables..."
 7 | 		    Set sc = $$$OK
 8 | 		    Set rs = ##class(%ResultSet).%New("Ens.Util.LookupTableDocument:List")
 9 | 		    Do rs.Execute()
10 | 		    While rs.Next() {
11 | 		        Set item=rs.Data("name")
12 | 		        Write "document found: "_ item,!
13 | 		    }
14 | 		    Do rs.Close()
15 | 		    Set rs=""
16 | 		}
17 | 		If ##class(%Dictionary.CompiledClass).%ExistsId("EnsLib.HL7.SchemaDocument") {
18 | 		    Write !,!,"Exporting Ensemble HL7 Schemas..."
19 | 		    Set sc = $$$OK
20 | 		    Set rs = ##class(%ResultSet).%New("EnsLib.HL7.SchemaDocument:List")
21 | 		    Do rs.Execute()
22 | 		    While rs.Next() {
23 | 		        Set item=rs.Data("name")
24 | 		        Continue:$listfind($lb("2.1.HL7","2.2.HL7","2.3.HL7","2.4.HL7","2.5.HL7","2.6.HL7","2.7.HL7","2.3.1.HL7","2.5.1.HL7","2.7.1.HL7","ITK.HL7")
25 | 		                            ,item)
26 | 		        Write "document found: "_ item,!
27 | 		    }
28 | 		    Do rs.Close()
29 | 		    Set rs=""
30 | 		}
31 | 	}
32 | }


--------------------------------------------------------------------------------
/src/cls/zen/uploadFile.cls:
--------------------------------------------------------------------------------
 1 | /// Created using the page template: Default
 2 | Class zen.uploadFile Extends %ZEN.Component.page
 3 | {
 4 | 
 5 | /// Class name of application this page belongs to.
 6 | Parameter APPLICATION = "";
 7 | 
 8 | /// Displayed name of this page.
 9 | Parameter PAGENAME = "";
10 | 
11 | /// Domain used for localization.
12 | Parameter DOMAIN = "";
13 | 
14 | /// This Style block contains page-specific CSS style definitions.
15 | XData Style
16 | {
17 | <style type="text/css">
18 | </style>
19 | }
20 | XData Contents [XMLNamespace="http://www.intersystems.com/zen"]
21 | {
22 | <page xmlns="http://www.intersystems.com/zen" title="">
23 | <form id="filetestform" name="filetestform" nextPage="" enctype="multipart/form-data" autoValidate="true">
24 | <fileUpload name="filetest" id="filetest" required="true"/>
25 | <submit caption="Hochladen"/>
26 | </form>
27 | </page>
28 | }
29 |   
30 | ClassMethod %OnSubmit(pSubmit As %ZEN.Submit) As %Status
31 | {
32 |     Set NewFile = ##class(%FileBinaryStream).%New()
33 |  
34 |     Set Location = "C:\"
35 |     Set NewFile.Filename = Location_pSubmit.%GetStream("filetest").FileName
36 |     Do NewFile.CopyFrom(pSubmit.%GetStream("filetest"))
37 |     Set status = NewFile.%Save()
38 |  
39 |     Quit status
40 | }
41 | }
42 | 


--------------------------------------------------------------------------------
/src/cls/timleavitt/createThumbnail.cls:
--------------------------------------------------------------------------------
 1 | /// Note: this only works for Linux, although I'm sure there are Windows equivalents.
 2 | Class timleavitt.createThumbnail Extends %RegisteredObject
 3 | {
 4 | 	classmethod test(pSourceFile as %String, output pDestFile as %String = "") as %Status
 5 | 	{
 6 | 		Set tSC = $$$OK
 7 |      
 8 | 		If (pDestFile = "") {
 9 | 	        //Put the file in a /thumbs subdirectory under its current location.
10 | 	        Set pDestFile = pSourceFile
11 | 	        Set $Piece(pDestFile,"/",*-1) = $Piece(pDestFile,"/",*-1)_"/thumbs"
12 | 	     
13 | 	        //Create thumbs directory if it doesn't exist.
14 | 	        Do ##class(%File).CreateDirectoryChain(##class(%File).NormalizeDirectory($Piece(pDestFile,"/",1,*-1)))
15 | 	    }
16 | 	     
17 | 	    //If pDestFile already exists, don't both recreating it.
18 | 	    Quit:##class(%File).Exists(pDestFile) tSC
19 | 	 
20 | 	    //Create the thumbnail
21 | 	    Set tCMD = "convert -size 200x200 "_##class(%File).NormalizeFilenameWithSpaces(pSourceFile)_" -resize 200x200 +profile '*' "_##class(%File).NormalizeFilenameWithSpaces(pDestFile)
22 | 	    Do $zf(-100,tCMD)
23 | 	     
24 | 	    If '##class(%File).Exists(pDestFile) {
25 | 	        Set tSC = $$$ERROR($$$GeneralError,"Thumbnail could not be created.")
26 | 	    }
27 | 	     
28 | 	    Quit tSC
29 | 	}
30 | }


--------------------------------------------------------------------------------
/src/cls/objectscript/createClass.cls:
--------------------------------------------------------------------------------
 1 | class objectscript.createClass Extends %RegisteredObject
 2 | {
 3 | ClassMethod test() As %Status
 4 | {
 5 | 	set sc = $$$OK
 6 | 	
 7 | 	// Create a class
 8 | 	set class = ##class(%ClassDefinition).%New("MyClass")
 9 | 	set class.Description = "This is my test class"_$c(13,10)_"testing %ClassDefinition"
10 | 	set class.Super = "%Persistent"
11 | 
12 | 	// Create a property and add it
13 | 	set property = ##class(%PropertyDefinition).%New("MyClass.MyProperty")
14 | 	set property.Type = "%String"
15 | 	set property.Description="This is a property"
16 | 	set sc1 = class.Properties.Insert(property)
17 | 	do:$$$ISERR(sc1) $system.Status.DisplayError(sc1)
18 | 	set sc = $$$ADDSC(sc, sc1)
19 | 	
20 | 	// Create a method and add it
21 | 	set method = ##class(%MethodDefinition).%New("MyClass.MyMethod")
22 | 	set method.ReturnType = "%Integer"
23 | 	set method.FormalSpec = "x:%Integer,y:%Integer=10"
24 | 	set method.Description = "Return product of x and y"
25 | 	set method.CodeMode = "code"
26 | 	set method.Code = " new result"_$c(13,10)_" set result=x*y"_$c(13,10)_" quit result"
27 | 	set sc2 = class.Methods.Insert(method)
28 | 	do:$$$ISERR(sc2) $system.Status.DisplayError(sc2)
29 | 	set sc = $$$ADDSC(sc, sc2)
30 | 	
31 | 	// Save the class definition
32 | 	set sc3 = class.%Save()
33 | 	do:$$$ISERR(sc3) $system.Status.DisplayError(sc3)
34 | 	set sc = $$$ADDSC(sc, sc3)
35 | 	
36 | 	return sc
37 | }
38 | }
39 | 


--------------------------------------------------------------------------------
/src/cls/objectscript/postXML.cls:
--------------------------------------------------------------------------------
 1 | Class objectscript.postXML
 2 | {
 3 | 	classmethod test() {
 4 | 		Set HTTPRequest = ##class(%Net.HttpRequest).%New()
 5 | 	    Set HTTPRequest.ContentType = "text/xml"
 6 | 	    Set HTTPRequest.NoDefaultContentCharset = 1
 7 | 	    Set HTTPRequest.Location = "ITOMCZ"
 8 | 	    Set HTTPRequest.Server = "wph.foactive.com"
 9 | 	    Do HTTPRequest.RemoveHeader("User-Agent")  
10 | 	    Do HTTPRequest.RemoveHeader("Accept-Encoding") 
11 | 	    Do HTTPRequest.RemoveHeader("Connection")
12 | 	    Do HTTPRequest.SetHeader("Expect","100-continue")
13 | 	 
14 | 	    Set RequestXML = ##class(%Library.File).%New("c:\test.xml")
15 | 	    Do RequestXML.Open("RS")
16 | 	    Do HTTPRequest.EntityBody.CopyFrom(RequestXML)
17 | 	    Do RequestXML.%Close()
18 | 	 
19 | 	    Do HTTPRequest.Post(HTTPRequest.Location)
20 | 	 
21 | 	    Do $System.OBJ.Dump(HTTPRequest)
22 | 	    Do $System.OBJ.Dump(HTTPRequest.HttpResponse)
23 | 	 
24 | 	    Write HTTPRequest.HttpResponse.Data.Size
25 | 	    Write HTTPRequest.ContentLength
26 | 	 
27 | 	    Set ResponseStream = ##class(%Stream.FileBinary).%New()
28 | 	    // Second part is typically the file extension, i.e.: application/pdf -> pdf
29 | 	    Set FileType = $Piece(HTTPRequest.HttpResponse.GetHeader("CONTENT-TYPE"),"/",2)
30 | 	    Set ResponseStream.Filename = "C:\test."_FileType
31 | 	 
32 | 	    Write ResponseStream.CopyFrom(HTTPRequest.HttpResponse.Data)
33 | 	 
34 | 	    Write ResponseStream.%Save()
35 | 	    Do ResponseStream.%Close()
36 | 	}
37 | }


--------------------------------------------------------------------------------
/src/cls/cartertiernan/getDayfromDate.cls:
--------------------------------------------------------------------------------
 1 | Class cartertiernan.getDayfromDate Extends %RegisteredObject
 2 | {
 3 | 	classmethod test(date) as %Integer {
 4 | 		//Set date = $ZDATE(date) //  Looks like: mm/dd/yyyy
 5 |      
 6 | 	    Set monthList = $LISTBUILD(0,3,3,6,1,4,6,2,5,0,3,5) // (Jan,Feb,Mar,Apr,...)
 7 | 	    Set centuryList = $LISTBUILD(6,4,2,0) // first two digits divisiable by 4, then subsequent centuries. EX (2000, 2100, 2200, 2300)
 8 | 	    Set dayList = $LISTBUILD("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday") // Index goes from 0-6
 9 | 	     
10 | 	    Set day = $PIECE(date,"/",2) // get the day 
11 | 	    Set monthVal = $LIST(monthList,($PIECE( date,"/",1 ))) // get the month value
12 | 	    Set first2DigsYear = $PIECE( date,"/",3 ) \ 100 // get the last 2 digits of the year
13 | 	    Set last2DigsYear = $PIECE( date,"/",3 ) # 100 // get the first 2 digits of the year
14 | 	     
15 | 	    // Used for DEBUG perpouses
16 | 	    /*write !,"day: ",day
17 | 	    write !,"Month: ",monthVal
18 | 	    write !,"last2: ",last2DigsYear
19 | 	    write !,"first2: ",first2DigsYear
20 | 	    write !,"cen Val: ",$LIST(centuryList,(first2DigsYear # 4) + 1),!!*/
21 | 	     
22 | 	    // Look here for formula explination (its the "Basic method for mental calculation")
23 | 	    // http://en.wikipedia.org/wiki/Determination_of_the_day_of_the_week
24 | 	    Set dayOfWeekVal = ( day + monthVal + last2DigsYear + (last2DigsYear\4) + $LIST(centuryList,(first2DigsYear # 4) + 1 ) ) # 7
25 | 	 
26 | 	    Quit dayOfWeekVal
27 | 	}
28 | }


--------------------------------------------------------------------------------
/src/csp/general/dynamicGeneratedTable.csp:
--------------------------------------------------------------------------------
 1 | <!--Demo of (re-)loading a table dynamically in a page-->
 2 | <HTML>
 3 | <HEAD>
 4 | <TITLE>   Cache Server Page To Demo Table Re-Render</TITLE>
 5 | </HEAD>
 6 | <BODY>
 7 | <TABLE ID=TEST border="1">
 8 |   <tr>
 9 |     <td>SSN</td><td>Name</td>
10 |   </tr>
11 | </TABLE>
12 | <hr>
13 | <input type="Button" name="render" value="Create Table"
14 |     OnClick="#server(..renderTable())#;">
15 |  
16 | <script language = Cache method = renderTable arguments = "">
17 |  
18 |     // Get everyone's SSN and Name from the sample database
19 |     &sql(declare TEST cursor for select SSN,Name from Sample.Person)
20 |     &sql(open TEST)
21 |  
22 |     // Output the javascript that will delete all except the first row from the table
23 |     write "var rLen = TEST.rows.length;",!
24 |     write "for (i=1; i<rLen; i++)",!
25 |     write "{",!
26 |     write " TEST.deleteRow(1);",!
27 |     write "}",!
28 |  
29 |     // Now insert each row
30 |     for i=1:1 {
31 |         &sql(fetch TEST into :ssn,:name)
32 |         if SQLCODE'=0 quit
33 |         write "var x = TEST.insertRow();",!
34 |         // Now insert each cell into this row
35 |         write "var y = x.insertCell();",!
36 |         // We are using simple 'innerText' whereas more sophisticated techniques
37 |         //   would use similar 'innerHTML'
38 |         // For example: 'innerHTML="<input type=Text name=SSN value=",ssn,">"'
39 |         write "y.innerText=",..QuoteJS(ssn),";",!
40 |         write "var y = x.insertCell();",!
41 |         write "y.innerText=",..QuoteJS(name),";",!
42 |     }
43 |     &sql(close TEST)
44 | </script>
45 |          
46 | </BODY>
47 | </HTML>


--------------------------------------------------------------------------------
/src/cls/zen/downloadStream.cls:
--------------------------------------------------------------------------------
 1 | /// We assume that you have stored your data within this schema:
 2 | /// MyApp.Model.Storage: Filename,FileSize,Content,ContentType
 3 | Class zen.downloadStream Extends (%ZEN.Component.page,%CSP.StreamServer)
 4 | {
 5 |  
 6 | 	/// Wrapper to get the id of the download, we assume that the id is passed to this zen page
 7 | 	/// as a URI parameter, i.e.: MyApp.Downloads.cls?OID=1234
 8 | 	ClassMethod GetId()
 9 | 	{
10 | 	    Quit $Get(%request.Data("OID",1))
11 | 	}
12 | 	 
13 | 	/// Set the appropriate header for the file.
14 | 	ClassMethod OnPreHTTP() As %Boolean
15 | 	{
16 | 	    Set tId = ..GetId()
17 | 	 
18 | 	    If ##Class(MyApp.Model.Storage).%ExistsId(tId) {
19 | 	        Set tStream = ##Class(MyApp.Model.Storage).%OpenId(tId)
20 | 	        // You could "guess" the content type by its file extension
21 | 	        // or you can store it (before) in the database separately (like in this example).
22 | 	        // Set Extension = $Piece(tStream.Filename,".",$Length(tStream.Filename,"."))
23 | 	        // Set ContentType = ..FileClassify(Extension)
24 | 	 
25 | 	        Set %response.ContentType = tStream.ContentType
26 | 	        Do %response.SetHeader("content-disposition","attachment; filename="_tStream.Filename)
27 | 	        Do %response.SetHeader("Content-Length",tStream.FileSize)
28 | 	    }
29 | 	    Else {
30 | 	        Set %response.Status="404 File Not Found"
31 | 	        Quit 0
32 | 	    }
33 | 	    Quit $$$OK
34 | 	}
35 | 	 
36 | 	ClassMethod OnPage() As %Status
37 | 	{
38 | 	    Set Download = ##Class(MyApp.Model.Storage).%OpenId(..GetId())
39 | 	    Do Download.Content.OutputToDevice()
40 | 	    Quit $$$OK
41 | 	}
42 |  
43 | }
44 | 


--------------------------------------------------------------------------------
/src/csp/general/streamToDiv.csp:
--------------------------------------------------------------------------------
 1 | <html>
 2 | <head>
 3 |  
 4 | <!-- Put your page Title here -->
 5 | <title>   Cache Server Page </title>
 6 | </head>
 7 |  
 8 | <body>
 9 | <script language="cache" runat="server">
10 | s gc=##class(%GlobalCharacterStream).%New()
11 | d gc.Write("<p>")
12 |     for t=1:1:32000 {
13 |         d gc.Write("a")
14 |     }
15 |     d gc.Write("b")
16 |     d gc.Write("</p>")
17 |     d gc.SetAttribute("ContentType","text/html")
18 |     d gc.SetAttribute("Expires",600)
19 |     d gc.%Save()
20 | s sid=gc.%Oid()
21 | s link=##class(%CSP.Page).Link("%25CSP.StreamServer.cls?STREAMOID="_##class(%CSP.Page).Encrypt(sid))
22 | </script>
23 | <script type="text/javascript">
24 | function ahah(url, target) {
25 |   document.getElementById(target).innerHTML = ' Fetching data...';
26 |   if (window.XMLHttpRequest) {
27 |     req = new XMLHttpRequest();
28 |   } else if (window.ActiveXObject) {
29 |     req = new ActiveXObject("Microsoft.XMLHTTP");
30 |   }
31 |   if (req != undefined) {
32 |     req.onreadystatechange = function() {ahahDone(url, target);};
33 |     req.open("GET", url, true);
34 |     req.send("");
35 |   }
36 | }  
37 |  
38 | function ahahDone(url, target) {
39 |   if (req.readyState == 4) { // only if req is "loaded"
40 |     if (req.status == 200) { // only if "OK"
41 |       document.getElementById(target).innerHTML = req.responseText;
42 |     } else {
43 |       document.getElementById(target).innerHTML=" AHAH Error:\n"+ req.status + "\n" +req.statusText;
44 |     }
45 |   }
46 | }
47 |  
48 | function load(name, div) {
49 |     ahah(name,div);
50 |     return false;
51 | }
52 | </script>
53 |  
54 | <input type="button" value="load" onClick="load('#(link)#','text');">
55 | <p></p>
56 |  
57 | <div id="text">
58 | <p>this is old content</p>
59 | </div>
60 |  
61 | </body>
62 | </html>


--------------------------------------------------------------------------------
/src/cls/skisser/webcam.cls:
--------------------------------------------------------------------------------
 1 | Class skisser.camComponent Extends %ZEN.Component.component
 2 | 	{
 3 | 	 
 4 | 	Parameter NAMESPACE = "http://www.intersystems.com/zen";
 5 | 	 
 6 | 	XData Style
 7 | 	{
 8 | 	<style type="text/css">
 9 | 	</style>
10 | 	}
11 | 	 
12 | 	Method %DrawHTML()
13 | 	{
14 | 	    &html<
15 | 	<video id="video" width="640" height="480" autoplay="true"></video>
16 | 	<canvas id="canvas" width="640" height="480" style="display:none;"></canvas>    >}
17 | 	 
18 | 	ClientMethod snapshot(imgcontainer) [ Language = javascript ]
19 | 	{
20 | 	    var video = document.querySelector('video');
21 | 	    var canvas = document.querySelector('canvas');
22 | 	    var ctx = canvas.getContext('2d');
23 | 	    var localMediaStream = null;
24 | 	    ctx.drawImage(video, 0, 0, 640, 480);
25 | 	    imgcontainer.src = canvas.toDataURL('image/png');
26 | 	}
27 | 	 
28 | 	ClientMethod startWebcam() [ Language = javascript ]
29 | 	{
30 | 	    var video = this
31 | 	    navigator.getUserMedia = navigator.getUserMedia || navigator.webkitGetUserMedia || navigator.mozGetUserMedia || navigator.msGetUserMedia || navigator.oGetUserMedia;
32 | 	    if (navigator.getUserMedia) 
33 | 	    {      
34 | 	        navigator.getUserMedia({video: true}, video.handleVideo,video.camError);
35 | 	    }
36 | 	}
37 | 	 
38 | 	ClientMethod handleVideo(stream) [ Language = javascript ]
39 | 	{
40 | 	    video.src = window.URL.createObjectURL(stream);
41 | 	}
42 | 	 
43 | 	ClientMethod camError(err) [ Language = javascript ]
44 | 	{
45 | 	     alert("The following error occurred:"+err.name);
46 | 	}
47 | 	 
48 | 	ClassMethod SaveImageToDB(snap As %ZEN.Component.component) [ ZenMethod ]
49 | 	{
50 | 	    Try {
51 | 	        set img = snap
52 | 	        set file = ##class(%FileBinaryStream).%New()
53 | 	        set file.Filename="C:\Temp\00001snapshot.png"
54 | 	        set photo=$P(img.src,",",2)
55 | 	        do file.Write($System.Encryption.Base64Decode(photo))
56 | 	        do file.%Save()
57 | 	    }
58 | 	    Catch(ex) {
59 | 	        &js<alert('Error in Server method:\n#($ZCVT(ex.DisplayString(),"O","JS"))#');>    }
60 | 	    Quit
61 | 	}
62 | }
63 | 


--------------------------------------------------------------------------------
/src/cls/objectscript/walkDOM.cls:
--------------------------------------------------------------------------------
 1 | Class objectscript.walkDOM Extends %Persistent
 2 | {
 3 | 	ClassMethod dfs(node As %XML.Node)
 4 | 	{
 5 | 	    s entrynode=node.NodeId
 6 | 	    do {
 7 | 	    //element nodes with one whitespacetyped child are the ones we want to change
 8 | 	    if (node.NodeType=$$$xmlELEMENTNODE){
 9 | 	        s snode=node.NodeId     
10 | 	        if (node.MoveToFirstChild())            
11 | 	            {
12 | 	                i ('node.MoveToNextSibling()){
13 | 	                    i (node.NodeType=$$$xmlWHITESPACENODE){
14 | 	                        s node.NodeType=$$$xmlTEXTNODE
15 | 	                        s node.NodeId=snode
16 | 	                    }
17 | 	                }
18 | 	        }
19 | 	        s node.NodeId=snode     
20 | 	    }   
21 | 	    if (node.HasChildNodes()){
22 | 	        d node.MoveToFirstChild()
23 | 	        d ..dfs(node)
24 | 	    }
25 | 	    } while (node.NodeType'="" && node.MoveToNextSibling())
26 | 	    s node.NodeId=entrynode
27 | 	     
28 | 	}
29 | 	 
30 | 	ClassMethod test()
31 | 	{
32 | 	  set xml = "<root><value1>abcdefg</value1><value2><![CDATA[   ]]></value2></root>"
33 | 	 
34 | 	  s reader=##class(%XML.Reader).%New()
35 | 	  do reader.OpenString(xml)  
36 | 	  set writer = ##class(%XML.Writer).%New()
37 | 	  //do some magic
38 | 	  d ..dfs(reader.Document)
39 | 	   
40 | 	  w !,"with indent=1:",!
41 | 	  set writer.Indent = 1
42 | 	  do writer.OutputToString()
43 | 	  do writer.Document(reader.Document)
44 | 	  w writer.GetXMLString()
45 | 	  set writer.Indent = 0
46 | 	  w !,"with indent=0:",!
47 | 	  do writer.OutputToString()
48 | 	  do writer.Document(reader.Document)
49 | 	  w writer.GetXMLString()
50 | 	}
51 | Storage Default
52 | {
53 | <Data name="walkDOMDefaultData">
54 | <Value name="1">
55 | <Value>%%CLASSNAME</Value>
56 | </Value>
57 | </Data>
58 | <DataLocation>^objectscript.walkDOMD</DataLocation>
59 | <DefaultData>walkDOMDefaultData</DefaultData>
60 | <IdLocation>^objectscript.walkDOMD</IdLocation>
61 | <IndexLocation>^objectscript.walkDOMI</IndexLocation>
62 | <StreamLocation>^objectscript.walkDOMS</StreamLocation>
63 | <Type>%Storage.Persistent</Type>
64 | }
65 | 
66 | }


--------------------------------------------------------------------------------
/src/cls/blaisezarka/automateSystemDefault.cls:
--------------------------------------------------------------------------------
 1 | Class blaisezarka.MigrateSettingsToDefault [ Abstract ]
 2 | {
 3 |  
 4 | /// Migrate all items settings from production <b>productionClassName</b> to system default settings
 5 | ClassMethod test(productionClassName As %String) As %Status
 6 | {
 7 |     set production = ##class(Ens.Config.Production).%OpenId(productionClassName)
 8 |     set items = production.Items
 9 |     set key = items.Next()
10 |     set tSC = $$$OK
11 |      
12 |     While ((key '= "") && $$$ISOK(tSC)) {
13 |         set item = items.GetAt(key)
14 |         set tSC = ##class(blaisezarka.MigrateSettingsToDefault).CreateDefaultSettings(productionClassName, item)
15 |         set key = items.Next(key)
16 |     }
17 |      
18 |     Quit tSC
19 | }
20 |  
21 | ClassMethod CreateDefaultSettings(productionClassName As %String, item As Ens.Config.Item) As %Status [ Internal ]
22 | {
23 |     Quit:'($IsObject(item)) $$$ERROR("item parameter is not an object")
24 |      
25 |     set settings = item.Settings
26 |     set itemName = item.Name
27 |     set itemClassName = item.ClassName
28 |     set key = settings.Next()
29 |     set tSC = $$$OK
30 |      
31 |     While ((key '= "") && $$$ISOK(tSC)) {
32 |         set setting = settings.GetAt(key)
33 |         set tSC = ##class(blaisezarka.MigrateSettingsToDefault).CreateDefaultSetting(productionClassName, itemClassName, itemName, setting)
34 |         set key = settings.Next(key)
35 |     }
36 |      
37 |     Quit tSC
38 | }
39 |  
40 | ClassMethod CreateDefaultSetting(productionName As %String, itemClassName As %String, itemName As %String, setting As Ens.Config.Setting) As %Status [ Internal ]
41 | {
42 |     Quit:'($IsObject(setting)) $$$ERROR("setting parameter is not an object")
43 |      
44 |     set tSC = $$$OK
45 |      
46 |     if ('(##class(Ens.Config.DefaultSettings).%ExistsId(productionName_"||"_itemName_"||"_itemClassName_"||"_setting.Name)))
47 |     {
48 |         set dsetting = ##class(Ens.Config.DefaultSettings).%New()
49 |         set dsetting.Deployable = 1
50 |         set dsetting.ProductionName = productionName
51 |         set dsetting.HostClassName = itemClassName
52 |         set dsetting.ItemName = itemName
53 |         set dsetting.SettingName = setting.Name
54 |         set dsetting.SettingValue = setting.Value
55 |         set tSC = dsetting.%Save()
56 |     }
57 |      
58 |     Quit tSC
59 | }
60 |  
61 | }


--------------------------------------------------------------------------------
/src/routines/timur/getOptionsArgs.mac:
--------------------------------------------------------------------------------
 1 | ROUTINE timur.getOptionsArgs
 2 | /// Let assume we want to parse options saved in args array in the form
 3 | ///   args=5
 4 | ///   args(1)="/o"
 5 | ///   args(2)="all"
 6 | ///   args(3)="/verbose"
 7 | ///   args(4)="the"
 8 | ///   args(5)="rest"
 9 | /// we want to get handled boolean options /o and /v (or -o and -v in unix-style)
10 | ///    set option = 0, verbose = 0
11 | /// we call GetOptions function this way:
12 | ///    GetOptions(.args,"-o",.option,"/verbose|/v",.verbose,"/include:",.include)
13 | /// NB! This example is handling only boolean options
14 | #define OptionBoolean 1
15 | #define OptionString 2
16 | /// f.k.a. "getOptions"
17 | test(&args,&fmtDest...) public {
18 |     #dim known ; known options
19 |  
20 |     // 1. scan options
21 |     for i=1:2:$get(fmtDest) {
22 |         #dim opts As %String = $get(fmtDest(i))
23 |         continue:opts=""
24 |         for j=1:1:$length(opts,"|") {
25 |             #dim opt As %String = $zstrip($piece(opts,"|",j), "<>", "-/")
26 |             #dim lastC As %String = $e(opt,*)
27 |             #dim optType As %Integer = $case(lastC, ":":$$$OptionString, :$$$OptionBoolean)
28 |             set opt = $zstrip(opt,"<>",":")
29 |              
30 |             set known(opt) = $lb(optType, i + 1) ; remember option type and destination argument pointer
31 |         }
32 |     }
33 |      
34 |     #dim argsN = "" ; new args without processed known options
35 |     // 2. process passed args while creating new modified args (without known /options)
36 |     for i=1:1:$get(args) {
37 |         #dim arg As %String = $get(args(i))
38 |         #dim isOption As %Boolean = $case($extract(arg,1),"/":1, "-":1, :0)
39 |  
40 |         if isOption {
41 |             #dim optInfo = $get(known($zstrip(arg, "<>", "-/:")))
42 |  
43 |             if $length(optInfo)>0 {
44 |                 #dim type As %Integer = $li(optInfo,1)
45 |                 #dim index As %Integer = $li(optInfo,2)
46 |                 if type=$$$OptionBoolean {
47 |                     set fmtDest(index) = 1
48 |                 } else {
49 |                     set fmtDest(index) = $get(args($i(i)))
50 |                 }
51 |             } else {
52 |                 return i ; unknown /option - bails out
53 |             }
54 |         } else {
55 |             set argsN($i(argsN)) = arg
56 |         }
57 |     }
58 |     // 3. save not consumed arguments back to args array
59 |     if $get(argsN)<$get(args) {
60 |         kill args merge args = argsN
61 |     }
62 |     quit 0
63 | }
64 | 
65 | 


--------------------------------------------------------------------------------
/src/cls/objectscript/sendEmailWithImage.cls:
--------------------------------------------------------------------------------
 1 | Class objectscript.sendEmailWithImage Extends %RegisteredObject
 2 | {
 3 | 	classmethod test() {
 4 | 		S SmtpServer = ""
 5 | 		S SmtpUserName = ""
 6 | 		S SmtpPassword = ""
 7 |   
 8 | 		S imgPath="C:\test.jpg"
 9 | 		 
10 | 		set s=##class(%Net.SMTP).%New()
11 | 		set s.smtpserver=SmtpServer
12 | 		set auth=##class(%Net.Authenticator).%New() ; use default authentication list
13 | 		set auth.UserName=SmtpUserName
14 | 		set auth.Password=SmtpPassword
15 | 		set s.authenticator=auth
16 | 		Set objMail=##class(%Net.MailMessage).%New()
17 | 		Set objMail.From="sender@testhost.com"
18 | 		Do objMail.To.Insert("reciever@testhost.com")
19 | 		Set objMail.Subject="Test-Email"
20 | 		Set objMail.Charset="iso-8859-1"
21 | 		  
22 | 		Set obj1 =objMail
23 | 		  
24 | 		Set obj1.IsHTML=1
25 | 		Set obj1.IsBinary = 0
26 | 		Set obj1.IsMultiPart = 1
27 | 		Set obj1.MultiPartType ="related"
28 | 		Do obj1.Headers.SetAt("inline","Content-Disposition")
29 | 		 
30 | 		//alternative container for the text-parts
31 | 		#dim textbody as %Net.MailMessagePart
32 | 		s textbody = obj1.AttachNewMessage()
33 | 		s textbody.IsMultiPart=1
34 | 		s textbody.IsHTML=0
35 | 		s textbody.MultiPartType="alternative"
36 | 		  
37 | 		//html part
38 | 		#dim text as %Net.MailMessagePart
39 | 		//text part
40 | 		#dim texttxt as %Net.MailMessagePart
41 | 		 
42 | 		s texttxt = textbody.AttachNewMessage()
43 | 		//s texttxt.ContentType="text/plain"
44 | 		d texttxt.TextData.Write("this is plain text")
45 | 		  
46 | 		s text = textbody.AttachNewMessage()
47 | 		s text.IsHTML=1
48 | 		s text.IsBinary=0
49 | 		s text.IsMultiPart=0
50 | 		  
51 | 		Do text.TextData.Write("<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01 Transitional//EN"">")
52 | 		do text.TextData.Write("<html><head><meta http-equiv=""content-type"" content=""text/html; charset=ISO-8859-1"">")
53 | 		Do text.TextData.Write("</head><body text=""#000000"" bgcolor=""#ffffff"">")
54 | 		Do text.TextData.Write("Das ist ein Test in html")
55 | 		Do text.TextData.Write("<img src=""cid:test.jpg"" />")
56 | 		Do text.TextData.Write("</body></html>")
57 | 		  
58 | 		// Image Message Part
59 | 		#dim obj2 as %Net.MailMessagePart
60 | 		Set obj2 = obj1.AttachNewMessage()
61 | 		Set obj2.IsBinary = 1
62 | 		Set obj2.IsMultiPart = 0
63 | 		Set obj2.FileName="test.jpg"
64 | 		  
65 | 		Do obj2.BinaryData.LinkToFile(imgPath)
66 | 		Do obj2.Headers.SetAt("inline","Content-Disposition")
67 | 		Do obj2.Headers.SetAt("<test.jpg>","Content-ID")
68 | 		set status=s.Send(objMail)
69 | 		  
70 | 		d $system.OBJ.DisplayError(status)
71 | 		w status,!
72 | 	}
73 | }


--------------------------------------------------------------------------------
/src/cls/DAiMor/fetchMessageHeaderData.cls:
--------------------------------------------------------------------------------
 1 | include Ensemble
 2 | Class DAiMor.fetchMessageHeaderData extends %RegisteredObject
 3 | {
 4 |  
 5 | Query Fetch(Namespace As %String) As %Query(ROWSPEC = "Namespace:%String,ID:%Integer,Type:Ens.DataType.MessageType,Priority:Ens.DataType.MessagePriority,Invocation:Ens.DataType.MessageInvocation,TimeCreated:Ens.DataType.UTC,TimeProcessed:Ens.DataType.UTC,Status:Ens.DataType.MessageStatus,IsError:%Boolean,ErrorStatus:%Status,CorrespondingMessageId:%Integer,SessionId:%Integer,SourceConfigName:%String,TargetConfigName:%String,SourceBusinessType:Ens.DataType.MessageBusinessType,TargetBusinessType:Ens.DataType.MessageBusinessType,BusinessProcessId:%Integer,TargetQueueName:%String,ReturnQueueName:%String,MessageBodyClassName:%String,MessageBodyId:%String,Description:%String,SuperSession:%String,Resent:%String") [ SqlProc ]
 6 | {
 7 | }
 8 |  
 9 | ClassMethod FetchExecute(ByRef qHandle As %Binary, Namespace As %String = "") As %Status
10 | {
11 |   set namespaces=""
12 |   if Namespace'="" {
13 |     set list=$lfs(Namespace,",")
14 |     for i=1:1:$ll(list) {
15 |       set ns=$zcvt($lg(list,i),"U")
16 |       continue:'$d(^%SYS("Ensemble","InstalledNamespace",ns))
17 |       set qHandle("list",ns)=""
18 |     }
19 |   }
20 |   set queryDef=##class(%Dictionary.QueryDefinition).%OpenId(..%ClassName(1)_"||Fetch")
21 |   set rowspec=$lfs(queryDef.Parameters.GetAt("ROWSPEC"))
22 |   set qHandle("rowspec")=rowspec
23 |   Quit $$$OK
24 | }
25 |  
26 | ClassMethod FetchClose(ByRef qHandle As %Binary) As %Status [ PlaceAfter = FetchExecute ]
27 | {
28 |   Quit $$$OK
29 | }
30 |  
31 | ClassMethod FetchFetch(ByRef qHandle As %Binary, ByRef Row As %List, ByRef AtEnd As %Integer = 0) As %Status [ PlaceAfter = FetchExecute ]
32 | {
33 |   set ns=$get(qHandle("current"))
34 |   if ns="" do nextNamespace
35 |   set rowspec=qHandle("rowspec")
36 |    
37 |   do queryRow
38 |    
39 |   set qHandle("current")=ns
40 |   Quit $$$OK
41 | queryRow
42 |   quit:ns=""
43 |   new $namespace
44 |   set $namespace=ns
45 |   if '$d(qHandle("query"),query) {
46 |     set st=##class(%SQL.Statement).%New()
47 |     do st.%Prepare("SELECT '"_ns_"' Namespace, * FROM Ens.MessageHeader")
48 |     set query=st.%Execute()
49 |     set qHandle("query")=query
50 |   }
51 |    
52 |   if query.%Next() {
53 |     set Row=$lb()
54 |     for i=1:1:$ll(rowspec) {
55 |       set prop=$p($lg(rowspec,i),":")
56 |       set $li(Row,i)=query.%Get(prop)
57 |     }
58 |   } else {
59 |     do nextNamespace
60 |     do queryRow
61 |   }
62 |    
63 |   quit 
64 | nextNamespace
65 |   kill qHandle("query")
66 |   if $d(qHandle("list")) {
67 |     set ns=$order(qHandle("list",ns))
68 |   } else {
69 |     set ns=$order(^%SYS("Ensemble","InstalledNamespace",ns))
70 |   }
71 |   if ns="" {
72 |     set AtEnd=1
73 |   }
74 |   Quit
75 | }
76 |  
77 | }
78 | 


--------------------------------------------------------------------------------
/src/cls/objectscript/createZenPage.cls:
--------------------------------------------------------------------------------
 1 | Class objectscript.createZenPage
 2 | {
 3 | 	classmethod test() {
 4 | 		// create Application...
 5 | 		set app=##class(%Dictionary.ClassDefinition).%New()
 6 | 		set app.Super="%ZEN.application"
 7 | 		set app.Name="ZenTest.MyZenApplication"
 8 | 		set app.ProcedureBlock=1
 9 | 		 
10 | 		set param=##class(%Dictionary.ParameterDefinition).%New()
11 | 		set param.Name="APPLICATIONNAME"
12 | 		set param.Default="MyZenApplication"
13 | 		set param.parent=app
14 | 		do param.%Save()
15 | 		 
16 | 		set param=##class(%Dictionary.ParameterDefinition).%New()
17 | 		set param.Name="HOMEPAGE"
18 | 		set param.Default=""
19 | 		set param.parent=app
20 | 		do param.%Save()
21 | 		 
22 | 		set ok=app.%Save()
23 | 		if 'ok {
24 | 		        do DecomposeStatus^%apiOBJ(ok,.err)
25 | 		        write "Error creating App class: "_err(1),!
26 | 		        }
27 | 		 
28 | 		// create Page...
29 | 		set page=##class(%Dictionary.ClassDefinition).%New()
30 | 		set page.Name="ZenTest.MyZenPage"
31 | 		set page.ProcedureBlock=1
32 | 		set page.Super="%ZEN.Component.page"
33 | 		 
34 | 		set param=##class(%Dictionary.ParameterDefinition).%New()
35 | 		set param.Name="APPLICATIONNAME"
36 | 		set param.Default="ZenTest.MyZenApplication"
37 | 		set param.parent=page
38 | 		do param.%Save()
39 | 		 
40 | 		set param=##class(%Dictionary.ParameterDefinition).%New()
41 | 		set param.Name="PAGENAME"
42 | 		set param.Default="MyZenPage"
43 | 		set param.parent=page
44 | 		do param.%Save()
45 | 		 
46 | 		set xds=##class(%Dictionary.XDataDefinition).%New()
47 | 		set xds.parent=page
48 | 		set xds.Name="Style"
49 | 		set xds.Data=##class(%Stream.TmpCharacter).%New()
50 | 		do xds.Data.Rewind()
51 | 		do xds.Data.Write(" <style type=""text/css"">"_$c(13,10)_"</style>")
52 | 		do xds.%Save()
53 | 		 
54 | 		set xdc=##class(%Dictionary.XDataDefinition).%New()
55 | 		set xdc.parent=page
56 | 		set xdc.Name="Content"
57 | 		set xdc.XMLNamespace="http://www.intersystems.com/zen"
58 | 		set xdc.Data=##class(%Stream.TmpCharacter).%New()
59 | 		do xdc.Data.Rewind()
60 | 		do xdc.Data.Write(" <page xmlns=""http://www.intersystems.com/zen"" title="""">")
61 | 		do xdc.Data.Write($c(13,10))
62 | 		do xdc.Data.Write(" <text id=""MyText"" value=""this is great!"" />")
63 | 		do xdc.Data.Write($c(13,10))
64 | 		do xdc.Data.Write(" </page>")
65 | 		do xdc.Data.Write($c(13,10))
66 | 		do xdc.%Save()
67 | 		 
68 | 		set method=##class(%Dictionary.MethodDefinition).%New()
69 | 		set method.Name="%OnAfterCreatePage"
70 | 		set method.ReturnType="%Status"
71 | 		set method.parent=page
72 | 		//implementation is a %Stream
73 | 		set code=##class(%Stream.TmpCharacter).%New()
74 | 		do code.Rewind()
75 | 		do code.Write(" Set tBtn = ##class(%ZEN.Component.button).%New()")
76 | 		do code.Write($c(13,10)) // carriage return line feed
77 | 		do code.Write(" Set tBtn.caption = ""Button 2""")
78 | 		do code.Write($c(13,10))
79 | 		do code.Write(" Do %page.%AddChild(tBtn)"_$c(13,10))
80 | 		do code.Write($c(13,10))
81 | 		do code.Write(" quit $$$OK")
82 | 		do code.Write($c(13,10))
83 | 		set method.Implementation=code
84 | 		do method.%Save()
85 | 		 
86 | 		set ok=page.%Save()
87 | 		if 'ok {
88 | 		        do DecomposeStatus^%apiOBJ(ok,.err)
89 | 		        write "Error creating Page class: "_err(1),!
90 | 		        }
91 | 		 
92 | 		do $system.OBJ.Compile("ZenTest.MyZenApplication")     
93 | 		do $system.OBJ.Compile("ZenTest.MyZenPage")    
94 | 		quit
95 | 	}
96 | }


--------------------------------------------------------------------------------
/src/routines/iainbray/indexToBitmap.mac:
--------------------------------------------------------------------------------
  1 | ROUTINE iainbray.indexToBitmap
  2 | /// f.k.a. bitmapIndices
  3 | test(package,logfile) public { // Resets indices to "type = bitmap" where appropriate
  4 |     // Iain Bray - InterSystems Corporation
  5 |     // 
  6 |     // Accepts (optional) arguments of a package and a logfile and changes all the index types to bitmap
  7 |     // where the index is not a system type, is not unique and the class does not have an IDKey based upon properties
  8 |     // (default IDKEY only!)
  9 |     // 
 10 |     // usage: do ^bitmapIndices(myPackage,myLog)
 11 |     // where myPackage = the name of the package (case sensitive)
 12 |     //       myLog is the name of a log file
 13 |     // examples:
 14 |     //       do ^bitmapIndices()
 15 |     //       do ^bitmapIndices("User")
 16 |     //       do ^bitmapIndices("User","c:\bitmaps.txt")
 17 |     //       do ^bitmapIndices(,"c:\bitmaps.txt")
 18 |      
 19 |     set package=$get(package)
 20 |     set logfile=$get(logfile)
 21 |      
 22 |     if logfile'="" close logfile open logfile:"WNS":0 if '$test write !!,"Could not open logfile!" quit
 23 |      
 24 |     set msg = "Change indices to bitmaps"
 25 |     if package'="" {
 26 |         set msg=msg_" for package '"_package_"'"
 27 |     }
 28 |     else {
 29 |         set msg=msg_" for all packages"
 30 |     }
 31 |     set msg=msg_" in namespace '"_$znspace_"'."
 32 |     do log(logfile,msg,1,1)
 33 |      
 34 |     // Resultset for classes
 35 |     set rsClass=##class(%ResultSet).%New("%Dictionary.CompiledClassQuery:Summary")
 36 |     // Resultset for indices
 37 |     set rsIndex=##class(%ResultSet).%New("%Dictionary.CompiledIndexQuery:Summary")
 38 |     if rsClass.Execute() {
 39 |         while rsClass.Next() {
 40 |             // Ignore system and non-persistent classes
 41 |             if (rsClass.Get("System")=0)&&(rsClass.Get("Persistent")=1) {
 42 |                 // Check that we have the correct package - if specified
 43 |                 set className=rsClass.GetData(1)
 44 |                 if (package="")||($piece(className,".",1,$length(package,"."))=package) {
 45 |                     do log(logfile,"Class: "_className,1,1)
 46 |                     if rsIndex.Execute(className) {
 47 |                         set ok = 1
 48 |                         set indices=""
 49 |                         while rsIndex.Next() {
 50 |                             set indexName=rsIndex.GetData(1)
 51 |                             set objIndex = ##class(%Dictionary.CompiledIndex).%OpenId(className_"||"_indexName,0)
 52 |                             // The next check looks for IDKeys with attributes - can't yet do bitmap indices on these
 53 |                             if (objIndex.IdKey=1)&&(objIndex.SystemAssigned=0)&&(objIndex.Properties'="") {
 54 |                                 set ok = 0
 55 |                                 quit
 56 |                             }
 57 |                             // Build up an array of indices that are ok for type = bitmap
 58 |                             if (objIndex.SystemAssigned=0)&&(objIndex.Unique = 0)&&(objIndex.Type'="bitmap") set indices=indices_$listbuild(indexName)
 59 |                             kill objIndex
 60 |                         }
 61 |                     }
 62 |                     do rsIndex.Close()
 63 |                     if 'ok {
 64 |                         do log(logfile,"Skipped due to attributes in IDKey",0,1)
 65 |                     }
 66 |                     else {
 67 |                         if indices'="" {
 68 |                             do log(logfile,"Purging indices",0,1)
 69 |                             do $zobjclassmethod(className,"%PurgeIndices",indices)
 70 |                             do log(logfile,"Compiling class",0,1)
 71 |                             set indexLength = $listlength(indices)
 72 |                             set ok = 1
 73 |                             for index=1:1:indexLength {
 74 |                                 set indexName=$list(indices,index)
 75 |                                 set objIndex = ##class(%Dictionary.IndexDefinition).%OpenId(className_"||"_indexName)
 76 |                                 set objIndex.Type = "bitmap"
 77 |                                 set ok = objIndex.%Save()
 78 |                                 if 'ok quit
 79 |                             }
 80 |                             if 'ok {
 81 |                                 do log(logfile,"FATAL ERROR editing "_indexName,0,1)
 82 |                             }
 83 |                             else {
 84 |                                 set sc = $system.OBJ.Compile(className,"-d")
 85 |                                 if 'sc {
 86 |                                     do log(logfile,"FATAL ERROR compiling "_className,0,1)
 87 |                                 }
 88 |                                 else {
 89 |                                     for index=1:1:indexLength do log(logfile,"Changed Index: "_$list(indices,index),0,1)
 90 |                                     do log(logfile,"Re-Building indices",0,1)
 91 |                                     do $zobjclassmethod(className,"%BuildIndices",indices)
 92 |                                 }
 93 |                             }
 94 |                         }
 95 |                         else {
 96 |                             do log(logfile,"No indices to re-build",0,1)
 97 |                         }
 98 |                     }
 99 |                 }
100 |             }
101 |         }
102 |     }
103 |     do rsClass.Close()
104 |     if logfile'="" close logfile
105 |     quit
106 | }
107 |      
108 | log(logfile,text,time,newline) private {
109 |     use $principal do write(text,time,newline)
110 |     if logfile'="" use logfile do write(text,time,newline)
111 |     use $principal
112 | }
113 | write(text,time,newline) private {
114 |     set time=$get(time,0)
115 |     set newline=$get(newline,0)
116 |     if time set newline=1
117 |     if newline write !
118 |     if time write $zdatetime($horolog,3)
119 |     if newline write ?25
120 |     write text
121 | }


--------------------------------------------------------------------------------
/src/cls/objectscript/checkBuild.cls:
--------------------------------------------------------------------------------
  1 | ///Description
  2 | ///This class enables developers to compare class and INCLUDE routine definitions between software builds.
  3 | ///It navigates through all aspects of a class definition and INCLUDE file code and uses a 32 bit crc on 
  4 | ///each element to produce a checksum for comparison purposes.
  5 | ///The utility can simply return a checksum value, provides details at certain levels and output the 
  6 | ///results to a file for comparison if required.
  7 | ///
  8 | ///The class has three primary methods
  9 | ///
 10 | ///Class (class, details, filename)
 11 | ///This method will provide a checksum for 1 class
 12 | ///
 13 | ///Package (package, details, filename)
 14 | ///This method will checksum information for all classes that are members of a given package
 15 | ///
 16 | ///Namespace (details , filename)
 17 | ///This method will provide a checksum for all non-system classes in a namespace and a checksum for all 
 18 | ///INCLUDE files in that namespace.
 19 | ///This method is recommended as the preferred mechanism for comparing two software definitions in two 
 20 | ///different namespaces.
 21 | ///
 22 | ///The details flag operates with the following values
 23 | ///0 - No details written, total checksum returned
 24 | ///1 - Class total written, total checksum returned
 25 | ///2 - Class total and element total written , total checksum returned
 26 | ///3 - Class total,element total and named element total written , total checksum returned 
 27 | Class objectscript.checkBuild extends (%RegisteredObject, %XML.Adaptor) [ClassType = "", Inheritance = right, ProcedureBlock]
 28 | {
 29 | 	/// Define the crcmode = 7 "A correct 32-bit CRC"
 30 | 	Parameter CRCMODE = 7;
 31 | 	 
 32 | 	/// Provides a checksum for 1 class based on summation of 32 bit CRC checking
 33 | 	/// <br>Details
 34 | 	/// <br>0 - No details written, total checksum returned
 35 | 	/// <br>1 - Class total written, total checksum returned
 36 | 	/// <br>2 - Class total and element total written , total checksum returned
 37 | 	/// <br>3 - Class total,element total and named element total written , total checksum returned
 38 | 	/// 
 39 | 	ClassMethod Class(class As %String, details As %Integer = 0, filename As %String = "") As %Integer
 40 | 	{
 41 | 	    //Open the file if requested
 42 | 	    if filename'="" {
 43 | 	        set file=..FileOpen(filename)
 44 | 	        if file="Error" {
 45 | 	            write "Unable to open file : ",filename
 46 | 	            quit 0
 47 | 	        }
 48 | 	    }
 49 | 	    else {
 50 | 	        set file=""
 51 | 	    }
 52 | 	     
 53 | 	    //Checksum 1 class
 54 | 	    set ccs=..CheckClass(class,details,file)
 55 | 	     
 56 | 	    if file {
 57 | 	        do ..FileClose(file)
 58 | 	    }
 59 | 	    quit ccs
 60 | 	}
 61 | 	 
 62 | 	ClassMethod CheckClass(class As %String, details As %Integer = 0, file = "") As %Integer
 63 | 	{
 64 | 	    //Write out a blank line as a seperator followed by the classname
 65 | 	    if details {
 66 | 	        do ..Write("Class "_class,file)
 67 | 	    }
 68 | 	     
 69 | 	    //Initialize some iteration variables
 70 | 	    set (element,name,node,sub,snode)=""
 71 | 	    set selectivity=""
 72 | 	     
 73 | 	    //Initialize checksum totals
 74 | 	    //class|element|name
 75 | 	    set cst="0|0|0"
 76 | 	     
 77 | 	    //Process Header element checksum
 78 | 	    for  {
 79 | 	        set element=$order(^oddDEF(class,element))
 80 | 	         
 81 | 	        //Completed header information
 82 | 	        if (element="")||(element'?.n) {
 83 | 	            quit
 84 | 	        }
 85 | 	         
 86 | 	        //Eliminate date/timestamp from header - may vary
 87 | 	        if (element'=63)&&(element'=64)&&(element'=69) {
 88 | 	            set cst=..Add(cst,$zcrc(^(element),..#CRCMODE))
 89 | 	        }
 90 | 	    }
 91 | 	     
 92 | 	    //Write out Header checksum details if wanted
 93 | 	    if details>1 {
 94 | 	            do ..Write($char(9)_"Header: "_$piece(cst,"|",2),file)
 95 | 	    }
 96 | 	     
 97 | 	    //Class elements
 98 | 	    set element("a")="Attributes"
 99 | 	    set element("f")="Foreign Keys"
100 | 	    set element("i")="Indexes"
101 | 	    set element("m")="Methods"
102 | 	    set element("p")="Parameters"
103 | 	    set element("q")="Queries"
104 | 	    set element("s")="Storage"
105 | 	    set element("t")="Triggers"
106 | 	     
107 | 	    //Process all other element checksums
108 | 	    set element=""
109 | 	     
110 | 	    //Iterate though the Elements
111 | 	    for  {
112 | 	        //Get next element
113 | 	        set element=$order(element(element)) quit:element=""
114 | 	         
115 | 	        //Reset Element checksum
116 | 	        set $piece(cst,"|",2)=0
117 | 	         
118 | 	        //Iterate through Named Elements
119 | 	        for  {
120 | 	             
121 | 	            //Iterate through named elements
122 | 	            set name=$order(^oddDEF(class,element,name)) quit:name=""
123 | 	 
124 | 	            //Reset Named element Checksum
125 | 	            set $piece(cst,"|",3)=0
126 | 	             
127 | 	            //Iterate through nodes of Named Elements
128 | 	            for  {
129 | 	                set node=$order(^oddDEF(class,element,name,node)) quit:node=""
130 | 	                 
131 | 	                //Add to checksums if data at this level
132 | 	                if ($data(^oddDEF(class,element,name,node))'=10)&&(node'=11) {
133 | 	                    set cst=..Add(cst,$zcrc(^(node),..#CRCMODE))
134 | 	                }
135 | 	                 
136 | 	                //Iterate through sub-nodes of nodes of Named Elememts
137 | 	                for  {
138 | 	                    set sub=$order(^oddDEF(class,element,name,node,sub)) quit:sub=""
139 | 	                     
140 | 	                    //Add to checksums
141 | 	                    if $data(^oddDEF(class,element,name,node,sub))'=10 {
142 | 	                        set cst=..Add(cst,$zcrc(^(sub),..#CRCMODE))
143 | 	                    }
144 | 	                     
145 | 	                    //Iterate through storage nodes
146 | 	                    for  {
147 | 	                        set snode=$order(^oddDEF(class,element,name,node,sub,"V",snode)) quit:snode=""
148 | 	                         
149 | 	                        //Add to checksums
150 | 	                        set cst=..Add(cst,$zcrc(^(snode,21),..#CRCMODE))
151 | 	                         
152 | 	                        //Update selectivity selectivity if selectivity exists in storage definition
153 | 	                        if $data(^oddDEF(class,"s",name,"M")) {
154 | 	                            set selectivity="*"
155 | 	                        }
156 | 	                    }
157 | 	                }
158 | 	            }
159 | 	         
160 | 	            //Write out Named Element checksum details if requested
161 | 	            if details>2 {
162 | 	                do ..Write($char(9)_$char(9)_name_": "_$piece(cst,"|",3),file)
163 | 	            }
164 | 	        }
165 | 	         
166 | 	        //Write out Element checksum details if requested
167 | 	        if details>1 {
168 | 	            do ..Write($char(9)_element(element)_": "_$piece(cst,"|",2)_selectivity,file)
169 | 	             
170 | 	            //Reset selectivity indicator to ""
171 | 	            set selectivity=""
172 | 	        }
173 | 	    }
174 | 	     
175 | 	    //Write out Class checksum details if requested
176 | 	    if details {
177 | 	            do ..Write($char(9)_"Checksum: "_$piece(cst,"|",1),file)
178 | 	    }
179 | 	     
180 | 	    //Return Class checksum
181 | 	    quit $piece(cst,"|",1)
182 | 	}
183 | 	 
184 | 	/// Provides a checksum for a package(s) based on summation of 32 bit CRC checking
185 | 	/// <br>"PackageName" - 1 package
186 | 	/// <br>"" - All packages in a namespace (excludes % - Sydtem classes)
187 | 	/// <br>Details
188 | 	/// <br>0 - No details written, total checksum returned
189 | 	/// <br>1 - Class total written, total checksum returned
190 | 	/// <br>2 - Class total and element total written , total checksum returned
191 | 	/// <br>3 - Class total,element total and named element total written , total checksum returned
192 | 	/// 
193 | 	ClassMethod Package(package As %String = "", details As %Integer = 0, filename As %String = "") As %Integer
194 | 	{
195 | 	    //Open the file if requested
196 | 	    if filename'="" {
197 | 	        set file=..FileOpen(filename)
198 | 	        if file="Error" {
199 | 	            write "Unable to open file : ",filename
200 | 	            quit 0
201 | 	        }
202 | 	    }
203 | 	    else {
204 | 	        set file=""
205 | 	    }
206 | 	     
207 | 	    //Checksum Package(s)
208 | 	    set pcs=..CheckPackage(package,details,file)
209 | 	     
210 | 	    //Close the file
211 | 	    if file {
212 | 	        do ..FileClose(file)
213 | 	    }
214 | 	     
215 | 	    //Return package checksum
216 | 	    quit pcs
217 | 	}
218 | 	 
219 | 	ClassMethod CheckPackage(package As %String = "", details As %Integer = 0, file As %File = "") As %Integer
220 | 	{
221 | 	 
222 | 	    //Initiate package anc total checksum
223 | 	    set (tcs,pcs)=0
224 | 	     
225 | 	    //Eliminate "%" system classes and checksum all packages if package=""
226 | 	    if package="" {
227 | 	        set package="@"
228 | 	        set cpackage=$piece($order(^oddDEF(package)),".",1)
229 | 	    }
230 | 	     
231 | 	    //Iterate through a package/packages(s) sending classes off to CheckClass
232 | 	    set class=package
233 | 	    for  {
234 | 	        set class=$order(^oddDEF(class))
235 | 	        if (class="")&&(package="@") {
236 | 	            if details {
237 | 	                do ..Write(cpackage_": "_pcs,file)
238 | 	                do ..Write("",file)
239 | 	            }
240 | 	            quit
241 | 	        }
242 | 	        elseif (package'="@")&&($piece(class,".",1)'=package) {
243 | 	            if details {
244 | 	                do ..Write(package_": "_pcs,file)
245 | 	                do ..Write("",file)
246 | 	            }
247 | 	            quit
248 | 	        }
249 | 	        elseif (package="@")&&($piece(class,".",1)'=cpackage) {
250 | 	            if details {
251 | 	                do ..Write(cpackage_": "_pcs,file)
252 | 	                do ..Write("",file)
253 | 	            }
254 | 	            set pcs=0
255 | 	            set cpackage=$piece(class,".",1)
256 | 	        }
257 | 	        else {
258 | 	            set ccs=..CheckClass(class,details,file)
259 | 	            set tcs=tcs+ccs
260 | 	            set pcs=pcs+ccs
261 | 	        }
262 | 	    }
263 | 	     
264 | 	    //Write the package total checksum
265 | 	    if details {
266 | 	        do ..Write("Checksum: "_tcs,file)
267 | 	    }
268 | 	     
269 | 	    quit tcs
270 | 	}
271 | 	 
272 | 	/// Provides a checksum for a Namespace based on summation of 32 bit CRC checking
273 | 	/// <br> This includes all INCLUDE files for code generation
274 | 	/// <br>"" - All packages in a namespace (excludes % - Sydtem classes)
275 | 	/// <br>Details
276 | 	/// <br>0 - No details written, total checksum returned
277 | 	/// <br>1 - Class total written, total checksum returned
278 | 	/// <br>2 - Class total and element total written , total checksum returned
279 | 	/// <br>3 - Class total,element total and named element total written , total checksum returned
280 | 	/// 
281 | 	ClassMethod Namespace(details As %Integer = 0, filename As %String = "") As %Integer
282 | 	{
283 | 	     
284 | 	    //Open the file if requested
285 | 	    if filename'="" {
286 | 	        set file=..FileOpen(filename)
287 | 	        if file="Error" {
288 | 	            write "Unable to open file : ",filename
289 | 	            quit 0
290 | 	        }
291 | 	    }
292 | 	    else {
293 | 	        set file=""
294 | 	    }
295 | 	     
296 | 	    //Go through the class packages first
297 | 	    set ncs=..CheckPackage("",details,file)
298 | 	     
299 | 	    //Calculate the INCLUDE files
300 | 	    if details {
301 | 	        do ..Write("",file)
302 | 	        do ..Write("Include Files",file)
303 | 	    }
304 | 	     
305 | 	    //Initialize INCLUDE files checksum
306 | 	    set ics=0
307 | 	     
308 | 	    set routine="@",line=""
309 | 	     
310 | 	    for  {
311 | 	        set routine=$order(^rINC(routine)) quit:routine=""
312 | 	         
313 | 	        //Initialize INCLUDE ROUTINE checksum
314 | 	        set rcs=0
315 | 	         
316 | 	        //Iterate through the include file routines
317 | 	        for  {
318 | 	            set line=$order(^rINC(routine,0,line)) quit:line=""
319 | 	            set rcs=rcs+$zcrc(^(line),..#CRCMODE)
320 | 	            set ics=ics+$zcrc(^(line),..#CRCMODE)
321 | 	            set ncs=ncs+$zcrc(^(line),..#CRCMODE)
322 | 	        }
323 | 	         
324 | 	        if details>1 {
325 | 	            do ..Write($char(9)_routine_": "_rcs,file)
326 | 	        }
327 | 	    }
328 | 	     
329 | 	    //Write out the INCLUDE files checksum
330 | 	    if details {
331 | 	            do ..Write("Checksum: "_ics,file)
332 | 	    }
333 | 	     
334 | 	    //Write out the Namespace checksum
335 | 	    if details {
336 | 	            do ..Write("",file)
337 | 	            do ..Write("Namespace: "_ncs,file)
338 | 	    }
339 | 	     
340 | 	    //Close the file
341 | 	    if file {
342 | 	        do ..FileClose(file)
343 | 	    }
344 | 	     
345 | 	    //Return the namespace checksum
346 | 	    quit ncs
347 | 	}
348 | 	 
349 | 	ClassMethod FileOpen(filename As %String) As %File
350 | 	{
351 | 	    set file=##class(%File).%New(filename)
352 | 	    set ok=file.Open("WNS")
353 | 	    if 'ok {
354 | 	        do $system.OBJ.DisplayError(ok)
355 | 	        quit "Error"
356 | 	    }
357 | 	    else {
358 | 	        quit file
359 | 	    }
360 | 	}
361 | 	 
362 | 	ClassMethod FileClose(file As %File)
363 | 	{
364 | 	    do file.Close()
365 | 	    quit
366 | 	}
367 | 	 
368 | 	ClassMethod Write(string As %String, file As %File)
369 | 	{
370 | 	    if file {
371 | 	        do file.WriteLine(string)
372 | 	    }
373 | 	    write !,string
374 | 	    quit
375 | 	}
376 | 	 
377 | 	ClassMethod Add(cst As %String, crc As %Integer) As %String
378 | 	{
379 | 	    set $piece(cst,"|",1)=$piece(cst,"|",1)+crc
380 | 	    set $piece(cst,"|",2)=$piece(cst,"|",2)+crc
381 | 	    set $piece(cst,"|",3)=$piece(cst,"|",3)+crc
382 | 	    quit cst
383 | 	}
384 | }


--------------------------------------------------------------------------------