Caché 2009.1 - NEWSCYCLE Solutions: DTI Lighting 7.7.x: Get image size CSP methods.

getimagesize()

<script language="cache" method="getimagesize" arguments='stream:%Stream' returntype="%List" procedureblock="1">
	
	/**
	 * Get image size.
	 * 
	 * @param      stream
	 * @return     string
	 */
	
	; Code by Alexander Riemer
	; http://snipurl.com/v6isu
	; Slightly modified by Micky Hulse
	; http://snipurl.com/v5jdn
	
	set return = ""
	
	if ($isobject($get(stream))) {
		
		#define READ(%chars) stream.Read(%chars)
		#define READCHAR $ascii(stream.Read(1))
		
		set type = "???"
		set (width, height, n, a1, a2, readto) = 0
		set (data, a, test) = ""
		
		do stream.Rewind()
		
		set data = $$$READ(4) // Read header.
	
		if ($extract(data, 1, 3) = "GIF") {
			// GIF
			set type = "GIF"
			do $$$READ(2)
			set width = ..bin2Dez($reverse($$$READ(2)))
			set height = ..bin2Dez($reverse($$$READ(2)))
		} elseif ($extract(data, 1, 2) = "BM") {
			// BMP
			set type = "BMP"
			do $$$READ(10)
			set n = ..bin2Dez($reverse($$$READ(4)))
			if (n = 12) {
				set a = $$$READ(4)
				set width = ..bin2Dez($reverse($extract(a, 1, 2)))
				set height = ..bin2Dez($reverse($extract(a, 3, 4)))
			}
			if (n > 12) {
				set a = $$$READ(8)
				set width = ..bin2Dez($reverse($extract(a, 1, 4)))
				set height = ..bin2Dez($reverse($extract(a, 5, 8)))
			}
		} elseif ($extract(data, 1, 2) = $char(255, 216)) {
			// JPEG
			set type = "JPEG"
			set a1 = $ascii(data, 3)
			set a2 = $ascii(data, 4)
			for {
				quit:(a1 '= 255) //'
				if (a2 > 190) {
					quit:($find("192,193,194,195,197,198,199,201,202,203,205,206,207", a2))
				}
				set readto = ..bin2Dez($$$READ(2)) - 2
				do $$$READ(readto)
				set a1 = $$$READCHAR
				set a2 = $$$READCHAR
			}
			do $$$READ(3)
			set height = ..bin2Dez($$$READ(2))
			set width = ..bin2Dez($$$READ(2))
		} elseif ($extract(data, 1, 4) = $char(137, 80, 78, 71)) {
			// PNG
			set type = "PNG"
			set n = 0
			for {
				do $$$READ(n + 4)
				set n = 0
				for i=1:1:4 {
					set n = n * 256 + $$$READCHAR
				}
				set test = $$$READ(4)
				quit:(test = "IHDR")
			}
			set width = 0
			for i=1:1:4 {
				set width = width * 256 + $$$READCHAR
			}
			set height = 0
			for i=1:1:4 {
				set height = height * 256 + $$$READCHAR
			}
		} elseif (($extract(data) = $char(10)) && ($char(0, 2, 3, 5)[$extract(data, 2))) {
			// PCX
			set type = "PCX"
			do $$$READ(4)
			set width = ..bin2Dez($reverse($$$READ(2))) + 1
			set height = ..bin2Dez($reverse($$$READ(2))) + 1
		}
		
		set return = $listbuild(type, width, height)
		
	}
	
	quit return
		
</script>

gistfile1.txt

<script language="cache" method="bin2Dez" arguments='bin:%Binary' returntype="%Integer" procedureblock="1">
	
	/**
	 * Returns binary number "bin" in decimal format.
	 * 
	 * @param      binary
	 * @return     integer
	 */
	
	; Code by Alexander Riemer
	; http://snipurl.com/v6isu
	; Slightly modified by Micky Hulse
	; http://snipurl.com/v5jdn
	
	set dez = 0
	set len = $length(bin)
	for i=1:1:len {
		set dez = dez + $ascii(bin, i) * (256 ** (len - i))
	}
	quit dez
	
</script>